2
/* ppport.h -- Perl/Pollution/Portability Version 2.011
4
* Automatically Created by Devel::PPPort on Sun Jul 4 09:11:52 2004
6
* Do NOT edit this file directly! -- Edit PPPort.pm instead.
8
* Version 2.x, Copyright (C) 2001, Paul Marquess.
9
* Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
10
* This code may be used and distributed under the same license as any
13
* This version of ppport.h is designed to support operation with Perl
14
* installations back to 5.004, and has been tested up to 5.8.1.
16
* If this version of ppport.h is failing during the compilation of this
17
* module, please check if a newer version of Devel::PPPort is available
18
* on CPAN before sending a bug report.
20
* If you are using the latest version of Devel::PPPort and it is failing
21
* during compilation of this module, please send a report to perlbug@perl.com
23
* Include all following information:
25
* 1. The complete output from running "perl -V"
29
* 3. The name & version of the module you were trying to build.
31
* 4. A full log of the build that failed.
33
* 5. Any other information that you think could be relevant.
36
* For the latest version of this code, please retreive the Devel::PPPort
42
* In order for a Perl extension module to be as portable as possible
43
* across differing versions of Perl itself, certain steps need to be taken.
44
* Including this header is the first major one, then using dTHR is all the
45
* appropriate places and using a PL_ prefix to refer to global Perl
46
* variables is the second.
51
/* If you use one of a few functions that were not present in earlier
52
* versions of Perl, please add a define before the inclusion of ppport.h
53
* for a static include, or use the GLOBAL request in a single module to
54
* produce a global definition that can be referenced from the other
57
* Function: Static define: Extern define:
58
* newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
63
/* To verify whether ppport.h is needed for your module, and whether any
64
* special defines should be used, ppport.h can be run through Perl to check
65
* your source code. Simply say:
67
* perl -x ppport.h *.c *.h *.xs foo/bar*.c [etc]
69
* The result will be a list of patches suggesting changes that should at
70
* least be acceptable, if not necessarily the most efficient solution, or a
71
* fix for all possible problems. It won't catch where dTHR is needed, and
72
* doesn't attempt to account for global macro or function definitions,
73
* nested includes, typemaps, etc.
75
* In order to test for the need of dTHR, please try your module under a
76
* recent version of Perl that has threading compiled-in.
83
@ARGV = ("*.xs") if !@ARGV;
84
%badmacros = %funcs = %macros = (); $replace = 0;
86
$funcs{$1} = 1 if /Provide:\s+(\S+)/;
87
$macros{$1} = 1 if /^#\s*define\s+([a-zA-Z0-9_]+)/;
88
$replace = $1 if /Replace:\s+(\d+)/;
89
$badmacros{$2}=$1 if $replace and /^#\s*define\s+([a-zA-Z0-9_]+).*?\s+([a-zA-Z0-9_]+)/;
90
$badmacros{$1}=$2 if /Replace (\S+) with (\S+)/;
92
foreach $filename (map(glob($_),@ARGV)) {
93
unless (open(IN, "<$filename")) {
94
warn "Unable to read from $file: $!\n";
97
print "Scanning $filename...\n";
98
$c = ""; while (<IN>) { $c .= $_; } close(IN);
99
$need_include = 0; %add_func = (); $changes = 0;
100
$has_include = ($c =~ /#.*include.*ppport/m);
102
foreach $func (keys %funcs) {
103
if ($c =~ /#.*define.*\bNEED_$func(_GLOBAL)?\b/m) {
104
if ($c !~ /\b$func\b/m) {
105
print "If $func isn't needed, you don't need to request it.\n" if
106
$changes += ($c =~ s/^.*#.*define.*\bNEED_$func\b.*\n//m);
108
print "Uses $func\n";
112
if ($c =~ /\b$func\b/m) {
113
$add_func{$func} =1 ;
114
print "Uses $func\n";
120
if (not $need_include) {
121
foreach $macro (keys %macros) {
122
if ($c =~ /\b$macro\b/m) {
123
print "Uses $macro\n";
129
foreach $badmacro (keys %badmacros) {
130
if ($c =~ /\b$badmacro\b/m) {
131
$changes += ($c =~ s/\b$badmacro\b/$badmacros{$badmacro}/gm);
132
print "Uses $badmacros{$badmacro} (instead of $badmacro)\n";
137
if (scalar(keys %add_func) or $need_include != $has_include) {
139
$inc = join('',map("#define NEED_$_\n", sort keys %add_func)).
140
"#include \"ppport.h\"\n";
141
$c = "$inc$c" unless $c =~ s/#.*include.*XSUB.*\n/$&$inc/m;
142
} elsif (keys %add_func) {
143
$inc = join('',map("#define NEED_$_\n", sort keys %add_func));
144
$c = "$inc$c" unless $c =~ s/^.*#.*include.*ppport.*$/$inc$&/m;
146
if (!$need_include) {
147
print "Doesn't seem to need ppport.h.\n";
148
$c =~ s/^.*#.*include.*ppport.*\n//m;
154
open(OUT,">/tmp/ppport.h.$$");
157
open(DIFF, "diff -u $filename /tmp/ppport.h.$$|");
158
while (<DIFF>) { s!/tmp/ppport\.h\.$$!$filename.patched!; print STDOUT; }
160
unlink("/tmp/ppport.h.$$");
5
----------------------------------------------------------------------
7
ppport.h -- Perl/Pollution/Portability Version 3.19
9
Automatically created by Devel::PPPort running under perl 5.011002.
11
Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
12
includes in parts/inc/ instead.
14
Use 'perldoc ppport.h' to view the documentation below.
16
----------------------------------------------------------------------
24
ppport.h - Perl/Pollution/Portability version 3.19
28
perl ppport.h [options] [source files]
30
Searches current directory for files if no [source files] are given
32
--help show short help
34
--version show version
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
40
--compat-version=version provide compatibility with Perl version
41
--cplusplus accept C++ comments
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
49
--strip strip all script and doc functionality from
52
--list-provided list provided API
53
--list-unsupported list unsupported API
54
--api-info=name show Perl API portability information
58
This version of F<ppport.h> is designed to support operation with Perl
59
installations back to 5.003, and has been tested up to 5.10.0.
65
Display a brief usage summary.
69
Display the version of F<ppport.h>.
71
=head2 --patch=I<file>
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.
77
=head2 --copy=I<suffix>
79
If this option is given, a copy of each file will be saved with
80
the given suffix that contains the suggested changes. This does
81
not require any external programs. Note that this does not
82
automagially add a dot between the original filename and the
83
suffix. If you want the dot, you have to include it in the option
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.
90
=head2 --diff=I<program>
92
Manually set the diff program and options to use. The default
93
is to use C<Text::Diff>, when installed, and output unified
96
=head2 --compat-version=I<version>
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.
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++
113
Be quiet. Don't print anything except fatal errors.
117
Don't output any diagnostic messages. Only portability
118
alerts will be printed.
122
Don't output any hints. Hints often contain useful portability
123
notes. Warnings will still be displayed.
127
Don't suggest any changes. Only give diagnostic output and hints
128
unless these are also deactivated.
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.
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.
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>
146
=head2 --list-provided
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.
152
=head2 --list-unsupported
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.
158
=head2 --api-info=I<name>
160
Show portability information for API elements matching I<name>.
161
If I<name> is surrounded by slashes, it is interpreted as a regular
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.
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
177
perl ppport.h --list-provided
179
to see which API elements are provided by ppport.h.
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.
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>.
196
These functions or variables will be marked C<explicit> in the list shown
197
by C<--list-provided>.
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
203
For a C<static> function or variable (used only in a single source
206
#define NEED_function
207
#define NEED_variable
209
For a global function or variable (used in multiple source files),
212
#define NEED_function_GLOBAL
213
#define NEED_variable_GLOBAL
215
Note that you mustn't have more than one global request for the
216
same function or variable in your project.
218
Function / Variable Static Request Global Request
219
-----------------------------------------------------------------------------------------
220
PL_parser NEED_PL_parser NEED_PL_parser_GLOBAL
221
PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
222
eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
223
grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
224
grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
225
grok_number() NEED_grok_number NEED_grok_number_GLOBAL
226
grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
227
grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
228
load_module() NEED_load_module NEED_load_module_GLOBAL
229
my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
230
my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
231
my_strlcat() NEED_my_strlcat NEED_my_strlcat_GLOBAL
232
my_strlcpy() NEED_my_strlcpy NEED_my_strlcpy_GLOBAL
233
newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
234
newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
235
newSV_type() NEED_newSV_type NEED_newSV_type_GLOBAL
236
newSVpvn_flags() NEED_newSVpvn_flags NEED_newSVpvn_flags_GLOBAL
237
newSVpvn_share() NEED_newSVpvn_share NEED_newSVpvn_share_GLOBAL
238
pv_display() NEED_pv_display NEED_pv_display_GLOBAL
239
pv_escape() NEED_pv_escape NEED_pv_escape_GLOBAL
240
pv_pretty() NEED_pv_pretty NEED_pv_pretty_GLOBAL
241
sv_2pv_flags() NEED_sv_2pv_flags NEED_sv_2pv_flags_GLOBAL
242
sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
243
sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
244
sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
245
sv_pvn_force_flags() NEED_sv_pvn_force_flags NEED_sv_pvn_force_flags_GLOBAL
246
sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
247
sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
248
vload_module() NEED_vload_module NEED_vload_module_GLOBAL
249
vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
250
warner() NEED_warner NEED_warner_GLOBAL
252
To avoid namespace conflicts, you can change the namespace of the
253
explicitly exported functions / variables using the C<DPPP_NAMESPACE>
254
macro. Just C<#define> the macro before including C<ppport.h>:
256
#define DPPP_NAMESPACE MyOwnNamespace_
259
The default namespace is C<DPPP_>.
263
The good thing is that most of the above can be checked by running
264
F<ppport.h> on your source code. See the next section for
269
To verify whether F<ppport.h> is needed for your module, whether you
270
should make any changes to your code, and whether any special defines
271
should be used, F<ppport.h> can be run as a Perl script to check your
272
source code. Simply say:
276
The result will usually be a list of patches suggesting changes
277
that should at least be acceptable, if not necessarily the most
278
efficient solution, or a fix for all possible problems.
280
If you know that your XS module uses features only available in
281
newer Perl releases, if you're aware that it uses C++ comments,
282
and if you want all suggestions as a single patch file, you could
283
use something like this:
285
perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
287
If you only want your code to be scanned without any suggestions
290
perl ppport.h --nochanges
292
You can specify a different C<diff> program or options, using
293
the C<--diff> option:
295
perl ppport.h --diff='diff -C 10'
297
This would output context diffs with 10 lines of context.
299
If you want to create patched copies of your files instead, use:
301
perl ppport.h --copy=.new
303
To display portability information for the C<newSVpvn> function,
306
perl ppport.h --api-info=newSVpvn
308
Since the argument to C<--api-info> can be a regular expression,
311
perl ppport.h --api-info=/_nomg$/
313
to display portability information for all C<_nomg> functions or
315
perl ppport.h --api-info=/./
317
to display information for all known API elements.
321
If this version of F<ppport.h> is causing failure during
322
the compilation of this module, please check if newer versions
323
of either this module or C<Devel::PPPort> are available on CPAN
324
before sending a bug report.
326
If F<ppport.h> was generated using the latest version of
327
C<Devel::PPPort> and is causing failure of this module, please
328
file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
330
Please include the following information:
336
The complete output from running "perl -V"
344
The name and version of the module you were trying to build.
348
A full log of the build that failed.
352
Any other information that you think could be relevant.
356
For the latest version of this code, please get the C<Devel::PPPort>
361
Version 3.x, Copyright (c) 2004-2009, Marcus Holland-Moritz.
363
Version 2.x, Copyright (C) 2001, Paul Marquess.
365
Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
367
This program is free software; you can redistribute it and/or
368
modify it under the same terms as Perl itself.
372
See L<Devel::PPPort>.
378
# Disable broken TRIE-optimization
379
BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
394
my($ppport) = $0 =~ /([\w.]+)$/;
395
my $LF = '(?:\r\n|[\r\n])'; # line feed
396
my $HS = "[ \t]"; # horizontal whitespace
398
# Never use C comments in this file!
401
my $rccs = quotemeta $ccs;
402
my $rcce = quotemeta $cce;
405
require Getopt::Long;
406
Getopt::Long::GetOptions(\%opt, qw(
407
help quiet diag! filter! hints! changes! cplusplus strip version
408
patch=s copy=s diff=s compat-version=s
409
list-provided list-unsupported api-info=s
413
if ($@ and grep /^-/, @ARGV) {
414
usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
415
die "Getopt::Long not found. Please don't use any options.\n";
419
print "This is $0 $VERSION.\n";
423
usage() if $opt{help};
424
strip() if $opt{strip};
426
if (exists $opt{'compat-version'}) {
427
my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
429
die "Invalid version number format: '$opt{'compat-version'}'\n";
431
die "Only Perl 5 is supported\n" if $r != 5;
432
die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000;
433
$opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
436
$opt{'compat-version'} = 5;
439
my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
441
($2 ? ( base => $2 ) : ()),
442
($3 ? ( todo => $3 ) : ()),
443
(index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
444
(index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
445
(index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
447
: die "invalid spec: $_" } qw(
451
CPERLscope|5.005000||p
454
CopFILEAV|5.006000||p
455
CopFILEGV_set|5.006000||p
456
CopFILEGV|5.006000||p
457
CopFILESV|5.006000||p
458
CopFILE_set|5.006000||p
460
CopSTASHPV_set|5.006000||p
461
CopSTASHPV|5.006000||p
462
CopSTASH_eq|5.006000||p
463
CopSTASH_set|5.006000||p
470
DEFSV_set|5.011000||p
472
END_EXTERN_C|5.005000||p
481
GROK_NUMERIC_RADIX|5.007002||p
498
HeSVKEY_force||5.004000|
499
HeSVKEY_set||5.004000|
503
HvNAMELEN_get|5.009003||p
504
HvNAME_get|5.009003||p
507
IN_LOCALE_COMPILETIME|5.007002||p
508
IN_LOCALE_RUNTIME|5.007002||p
509
IN_LOCALE|5.007002||p
510
IN_PERL_COMPILETIME|5.008001||p
511
IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
512
IS_NUMBER_INFINITY|5.007002||p
513
IS_NUMBER_IN_UV|5.007002||p
514
IS_NUMBER_NAN|5.007003||p
515
IS_NUMBER_NEG|5.007002||p
516
IS_NUMBER_NOT_INT|5.007002||p
524
MY_CXT_CLONE|5.009002||p
525
MY_CXT_INIT|5.007003||p
546
PAD_COMPNAME_FLAGS|||
547
PAD_COMPNAME_GEN_set|||
549
PAD_COMPNAME_OURSTASH|||
555
PAD_SAVE_SETNULLPAD|||
557
PAD_SET_CUR_NOSAVE|||
561
PERLIO_FUNCS_CAST|5.009003||p
562
PERLIO_FUNCS_DECL|5.009003||p
564
PERL_BCDVERSION|5.011000||p
565
PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
566
PERL_HASH|5.004000||p
567
PERL_INT_MAX|5.004000||p
568
PERL_INT_MIN|5.004000||p
569
PERL_LONG_MAX|5.004000||p
570
PERL_LONG_MIN|5.004000||p
571
PERL_MAGIC_arylen|5.007002||p
572
PERL_MAGIC_backref|5.007002||p
573
PERL_MAGIC_bm|5.007002||p
574
PERL_MAGIC_collxfrm|5.007002||p
575
PERL_MAGIC_dbfile|5.007002||p
576
PERL_MAGIC_dbline|5.007002||p
577
PERL_MAGIC_defelem|5.007002||p
578
PERL_MAGIC_envelem|5.007002||p
579
PERL_MAGIC_env|5.007002||p
580
PERL_MAGIC_ext|5.007002||p
581
PERL_MAGIC_fm|5.007002||p
582
PERL_MAGIC_glob|5.011000||p
583
PERL_MAGIC_isaelem|5.007002||p
584
PERL_MAGIC_isa|5.007002||p
585
PERL_MAGIC_mutex|5.011000||p
586
PERL_MAGIC_nkeys|5.007002||p
587
PERL_MAGIC_overload_elem|5.007002||p
588
PERL_MAGIC_overload_table|5.007002||p
589
PERL_MAGIC_overload|5.007002||p
590
PERL_MAGIC_pos|5.007002||p
591
PERL_MAGIC_qr|5.007002||p
592
PERL_MAGIC_regdata|5.007002||p
593
PERL_MAGIC_regdatum|5.007002||p
594
PERL_MAGIC_regex_global|5.007002||p
595
PERL_MAGIC_shared_scalar|5.007003||p
596
PERL_MAGIC_shared|5.007003||p
597
PERL_MAGIC_sigelem|5.007002||p
598
PERL_MAGIC_sig|5.007002||p
599
PERL_MAGIC_substr|5.007002||p
600
PERL_MAGIC_sv|5.007002||p
601
PERL_MAGIC_taint|5.007002||p
602
PERL_MAGIC_tiedelem|5.007002||p
603
PERL_MAGIC_tiedscalar|5.007002||p
604
PERL_MAGIC_tied|5.007002||p
605
PERL_MAGIC_utf8|5.008001||p
606
PERL_MAGIC_uvar_elem|5.007003||p
607
PERL_MAGIC_uvar|5.007002||p
608
PERL_MAGIC_vec|5.007002||p
609
PERL_MAGIC_vstring|5.008001||p
610
PERL_PV_ESCAPE_ALL|5.009004||p
611
PERL_PV_ESCAPE_FIRSTCHAR|5.009004||p
612
PERL_PV_ESCAPE_NOBACKSLASH|5.009004||p
613
PERL_PV_ESCAPE_NOCLEAR|5.009004||p
614
PERL_PV_ESCAPE_QUOTE|5.009004||p
615
PERL_PV_ESCAPE_RE|5.009005||p
616
PERL_PV_ESCAPE_UNI_DETECT|5.009004||p
617
PERL_PV_ESCAPE_UNI|5.009004||p
618
PERL_PV_PRETTY_DUMP|5.009004||p
619
PERL_PV_PRETTY_ELLIPSES|5.010000||p
620
PERL_PV_PRETTY_LTGT|5.009004||p
621
PERL_PV_PRETTY_NOCLEAR|5.010000||p
622
PERL_PV_PRETTY_QUOTE|5.009004||p
623
PERL_PV_PRETTY_REGPROP|5.009004||p
624
PERL_QUAD_MAX|5.004000||p
625
PERL_QUAD_MIN|5.004000||p
626
PERL_REVISION|5.006000||p
627
PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
628
PERL_SCAN_DISALLOW_PREFIX|5.007003||p
629
PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
630
PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
631
PERL_SHORT_MAX|5.004000||p
632
PERL_SHORT_MIN|5.004000||p
633
PERL_SIGNALS_UNSAFE_FLAG|5.008001||p
634
PERL_SUBVERSION|5.006000||p
635
PERL_SYS_INIT3||5.006000|
637
PERL_SYS_TERM||5.011000|
638
PERL_UCHAR_MAX|5.004000||p
639
PERL_UCHAR_MIN|5.004000||p
640
PERL_UINT_MAX|5.004000||p
641
PERL_UINT_MIN|5.004000||p
642
PERL_ULONG_MAX|5.004000||p
643
PERL_ULONG_MIN|5.004000||p
644
PERL_UNUSED_ARG|5.009003||p
645
PERL_UNUSED_CONTEXT|5.009004||p
646
PERL_UNUSED_DECL|5.007002||p
647
PERL_UNUSED_VAR|5.007002||p
648
PERL_UQUAD_MAX|5.004000||p
649
PERL_UQUAD_MIN|5.004000||p
650
PERL_USE_GCC_BRACE_GROUPS|5.009004||p
651
PERL_USHORT_MAX|5.004000||p
652
PERL_USHORT_MIN|5.004000||p
653
PERL_VERSION|5.006000||p
654
PL_DBsignal|5.005000||p
659
PL_bufend|5.011000||p
660
PL_bufptr|5.011000||p
661
PL_compiling|5.004050||p
662
PL_copline|5.011000||p
663
PL_curcop|5.004050||p
664
PL_curstash|5.004050||p
665
PL_debstash|5.004050||p
667
PL_diehook|5.004050||p
671
PL_error_count|5.011000||p
672
PL_expect|5.011000||p
673
PL_hexdigit|5.005000||p
675
PL_in_my_stash|5.011000||p
678
PL_laststatval|5.005000||p
679
PL_lex_state|5.011000||p
680
PL_lex_stuff|5.011000||p
681
PL_linestr|5.011000||p
682
PL_modglobal||5.005000|n
684
PL_no_modify|5.006000||p
686
PL_parser|5.009005||p
687
PL_perl_destruct_level|5.004050||p
688
PL_perldb|5.004050||p
689
PL_ppaddr|5.006000||p
690
PL_rsfp_filters|5.004050||p
693
PL_signals|5.008001||p
694
PL_stack_base|5.004050||p
695
PL_stack_sp|5.004050||p
696
PL_statcache|5.005000||p
697
PL_stdingv|5.004050||p
698
PL_sv_arenaroot|5.004050||p
699
PL_sv_no|5.004050||pn
700
PL_sv_undef|5.004050||pn
701
PL_sv_yes|5.004050||pn
702
PL_tainted|5.004050||p
703
PL_tainting|5.004050||p
704
PL_tokenbuf|5.011000||p
705
POP_MULTICALL||5.011000|
709
POPpbytex||5.007001|n
720
PUSH_MULTICALL||5.011000|
722
PUSHmortal|5.009002||p
728
PerlIO_clearerr||5.007003|
729
PerlIO_close||5.007003|
730
PerlIO_context_layers||5.009004|
731
PerlIO_eof||5.007003|
732
PerlIO_error||5.007003|
733
PerlIO_fileno||5.007003|
734
PerlIO_fill||5.007003|
735
PerlIO_flush||5.007003|
736
PerlIO_get_base||5.007003|
737
PerlIO_get_bufsiz||5.007003|
738
PerlIO_get_cnt||5.007003|
739
PerlIO_get_ptr||5.007003|
740
PerlIO_read||5.007003|
741
PerlIO_seek||5.007003|
742
PerlIO_set_cnt||5.007003|
743
PerlIO_set_ptrcnt||5.007003|
744
PerlIO_setlinebuf||5.007003|
745
PerlIO_stderr||5.007003|
746
PerlIO_stdin||5.007003|
747
PerlIO_stdout||5.007003|
748
PerlIO_tell||5.007003|
749
PerlIO_unread||5.007003|
750
PerlIO_write||5.007003|
751
Perl_signbit||5.009005|n
752
PoisonFree|5.009004||p
753
PoisonNew|5.009004||p
754
PoisonWith|5.009004||p
763
SAVE_DEFSV|5.004050||p
766
START_EXTERN_C|5.005000||p
767
START_MY_CXT|5.007003||p
770
STR_WITH_LEN|5.009003||p
772
SV_CONST_RETURN|5.009003||p
773
SV_COW_DROP_PV|5.008001||p
774
SV_COW_SHARED_HASH_KEYS|5.009005||p
775
SV_GMAGIC|5.007002||p
776
SV_HAS_TRAILING_NUL|5.009004||p
777
SV_IMMEDIATE_UNREF|5.007001||p
778
SV_MUTABLE_RETURN|5.009003||p
779
SV_NOSTEAL|5.009002||p
780
SV_SMAGIC|5.009003||p
781
SV_UTF8_NO_ENCODING|5.008001||p
801
SvGETMAGIC|5.004050||p
804
SvIOK_notUV||5.006000|
806
SvIOK_only_UV||5.006000|
812
SvIV_nomg|5.009001||p
816
SvIsCOW_shared_hash||5.008003|
821
SvMAGIC_set|5.009003||p
835
SvOOK_offset||5.011000|
838
SvPOK_only_UTF8||5.006000|
843
SvPVX_const|5.009003||p
844
SvPVX_mutable|5.009003||p
846
SvPV_const|5.009003||p
847
SvPV_flags_const_nolen|5.009003||p
848
SvPV_flags_const|5.009003||p
849
SvPV_flags_mutable|5.009003||p
850
SvPV_flags|5.007002||p
851
SvPV_force_flags_mutable|5.009003||p
852
SvPV_force_flags_nolen|5.009003||p
853
SvPV_force_flags|5.007002||p
854
SvPV_force_mutable|5.009003||p
855
SvPV_force_nolen|5.009003||p
856
SvPV_force_nomg_nolen|5.009003||p
857
SvPV_force_nomg|5.007002||p
859
SvPV_mutable|5.009003||p
860
SvPV_nolen_const|5.009003||p
861
SvPV_nolen|5.006000||p
862
SvPV_nomg_const_nolen|5.009003||p
863
SvPV_nomg_const|5.009003||p
864
SvPV_nomg|5.007002||p
865
SvPV_renew|5.009003||p
867
SvPVbyte_force||5.009002|
868
SvPVbyte_nolen||5.006000|
869
SvPVbytex_force||5.006000|
872
SvPVutf8_force||5.006000|
873
SvPVutf8_nolen||5.006000|
874
SvPVutf8x_force||5.006000|
880
SvREFCNT_inc_NN|5.009004||p
881
SvREFCNT_inc_simple_NN|5.009004||p
882
SvREFCNT_inc_simple_void_NN|5.009004||p
883
SvREFCNT_inc_simple_void|5.009004||p
884
SvREFCNT_inc_simple|5.009004||p
885
SvREFCNT_inc_void_NN|5.009004||p
886
SvREFCNT_inc_void|5.009004||p
897
SvSHARED_HASH|5.009003||p
899
SvSTASH_set|5.009003||p
901
SvSetMagicSV_nosteal||5.004000|
902
SvSetMagicSV||5.004000|
903
SvSetSV_nosteal||5.004000|
905
SvTAINTED_off||5.004000|
906
SvTAINTED_on||5.004000|
912
SvUOK|5.007001|5.006000|p
914
SvUTF8_off||5.006000|
919
SvUV_nomg|5.009001||p
924
SvVSTRING_mg|5.009004||p
927
UTF8_MAXBYTES|5.009002||p
935
WARN_AMBIGUOUS|5.006000||p
936
WARN_ASSERTIONS|5.011000||p
937
WARN_BAREWORD|5.006000||p
938
WARN_CLOSED|5.006000||p
939
WARN_CLOSURE|5.006000||p
940
WARN_DEBUGGING|5.006000||p
941
WARN_DEPRECATED|5.006000||p
942
WARN_DIGIT|5.006000||p
943
WARN_EXEC|5.006000||p
944
WARN_EXITING|5.006000||p
945
WARN_GLOB|5.006000||p
946
WARN_INPLACE|5.006000||p
947
WARN_INTERNAL|5.006000||p
949
WARN_LAYER|5.008000||p
950
WARN_MALLOC|5.006000||p
951
WARN_MISC|5.006000||p
952
WARN_NEWLINE|5.006000||p
953
WARN_NUMERIC|5.006000||p
954
WARN_ONCE|5.006000||p
955
WARN_OVERFLOW|5.006000||p
956
WARN_PACK|5.006000||p
957
WARN_PARENTHESIS|5.006000||p
958
WARN_PIPE|5.006000||p
959
WARN_PORTABLE|5.006000||p
960
WARN_PRECEDENCE|5.006000||p
961
WARN_PRINTF|5.006000||p
962
WARN_PROTOTYPE|5.006000||p
964
WARN_RECURSION|5.006000||p
965
WARN_REDEFINE|5.006000||p
966
WARN_REGEXP|5.006000||p
967
WARN_RESERVED|5.006000||p
968
WARN_SEMICOLON|5.006000||p
969
WARN_SEVERE|5.006000||p
970
WARN_SIGNAL|5.006000||p
971
WARN_SUBSTR|5.006000||p
972
WARN_SYNTAX|5.006000||p
973
WARN_TAINT|5.006000||p
974
WARN_THREADS|5.008000||p
975
WARN_UNINITIALIZED|5.006000||p
976
WARN_UNOPENED|5.006000||p
977
WARN_UNPACK|5.006000||p
978
WARN_UNTIE|5.006000||p
979
WARN_UTF8|5.006000||p
980
WARN_VOID|5.006000||p
981
XCPT_CATCH|5.009002||p
982
XCPT_RETHROW|5.009002||p
983
XCPT_TRY_END|5.009002||p
984
XCPT_TRY_START|5.009002||p
986
XPUSHmortal|5.009002||p
998
XSRETURN_UV|5.008001||p
1008
XS_VERSION_BOOTCHECK|||
1010
XSprePUSH|5.006000||p
1014
_aMY_CXT|5.007003||p
1015
_pMY_CXT|5.007003||p
1016
aMY_CXT_|5.007003||p
1026
amagic_cmp_locale|||
1036
apply_attrs_string||5.006001|
1039
atfork_lock||5.007003|n
1040
atfork_unlock||5.007003|n
1041
av_arylen_p||5.009003|
1043
av_create_and_push||5.009005|
1044
av_create_and_unshift_one||5.009005|
1045
av_delete||5.006000|
1046
av_exists||5.006000|
1050
av_iter_p||5.011000|
1064
block_gimme||5.004000|
1068
boot_core_UNIVERSAL|||
1070
bytes_from_utf8||5.007001|
1072
bytes_to_utf8||5.006001|
1073
call_argv|5.006000||p
1074
call_atexit||5.006000|
1075
call_list||5.004000|
1076
call_method|5.006000||p
1083
cast_ulong||5.006000|
1085
check_type_and_open|||
1139
clear_placeholders|||
1144
create_eval_scope|||
1145
croak_nocontext|||vn
1146
croak_xs_usage||5.011000|
1148
csighandler||5.009003|n
1150
custom_op_desc||5.007003|
1151
custom_op_name||5.007003|
1154
cv_const_sv||5.004000|
1164
dMULTICALL||5.009003|
1165
dMY_CXT_SV|5.007003||p
1175
dUNDERBAR|5.009002||p
1186
debprofdump||5.005000|
1188
debstackptrs||5.007003|
1190
debug_start_match|||
1193
delete_eval_scope|||
1197
despatch_signals||5.007001|
1208
do_binmode||5.004050|
1217
do_gv_dump||5.006000|
1218
do_gvgv_dump||5.006000|
1219
do_hv_dump||5.006000|
1224
do_magic_dump||5.006000|
1228
do_op_dump||5.006000|
1233
do_pmop_dump||5.006000|
1244
do_sv_dump||5.006000|
1247
do_trans_complex_utf8|||
1249
do_trans_count_utf8|||
1251
do_trans_simple_utf8|||
1262
doing_taint||5.008001|n
1276
dump_eval||5.006000|
1279
dump_form||5.006000|
1280
dump_indent||5.006000|v
1282
dump_packsubs||5.006000|
1285
dump_trie_interim_list|||
1286
dump_trie_interim_table|||
1288
dump_vindent||5.006000|
1296
fbm_compile||5.005000|
1297
fbm_instr||5.005000|
1298
feature_is_enabled|||
1299
fetch_cop_label||5.011000|
1304
find_and_forget_pmops|||
1305
find_array_subscript|||
1308
find_hash_subscript|||
1310
find_runcv||5.008001|
1311
find_rundefsvoffset||5.009002|
1326
fprintf_nocontext|||vn
1327
free_global_struct|||
1328
free_tied_hv_pool|||
1330
gen_constant_list|||
1334
get_context||5.006000|n
1335
get_cvn_flags||5.009005|
1345
get_op_descs||5.005000|
1346
get_op_names||5.005000|
1348
get_ppaddr||5.006000|
1352
getcwd_sv||5.007002|
1360
grok_bin|5.007003||p
1361
grok_hex|5.007003||p
1362
grok_number|5.007002||p
1363
grok_numeric_radix|5.007002||p
1364
grok_oct|5.007003||p
1370
gv_autoload4||5.004000|
1372
gv_const_sv||5.009003|
1374
gv_efullname3||5.004000|
1375
gv_efullname4||5.006001|
1378
gv_fetchfile_flags||5.009005|
1380
gv_fetchmeth_autoload||5.007003|
1381
gv_fetchmethod_autoload||5.004000|
1382
gv_fetchmethod_flags||5.011000|
1385
gv_fetchpvn_flags|5.009002||p
1386
gv_fetchpvs|5.009004||p
1388
gv_fetchsv||5.009002|
1389
gv_fullname3||5.004000|
1390
gv_fullname4||5.006001|
1393
gv_handler||5.007001|
1396
gv_name_set||5.009004|
1397
gv_stashpvn|5.004000||p
1398
gv_stashpvs|5.009003||p
1405
hv_assert||5.011000|
1407
hv_backreferences_p|||
1408
hv_clear_placeholders||5.009001|
1410
hv_common_key_len||5.010000|
1411
hv_common||5.010000|
1413
hv_delayfree_ent||5.004000|
1415
hv_delete_ent||5.004000|
1417
hv_eiter_p||5.009003|
1418
hv_eiter_set||5.009003|
1419
hv_exists_ent||5.004000|
1421
hv_fetch_ent||5.004000|
1422
hv_fetchs|5.009003||p
1424
hv_free_ent||5.004000|
1426
hv_iterkeysv||5.004000|
1428
hv_iternext_flags||5.008000|
1433
hv_ksplit||5.004000|
1436
hv_name_set||5.009003|
1438
hv_placeholders_get||5.009003|
1439
hv_placeholders_p||5.009003|
1440
hv_placeholders_set||5.009003|
1441
hv_riter_p||5.009003|
1442
hv_riter_set||5.009003|
1443
hv_scalar||5.009001|
1444
hv_store_ent||5.004000|
1445
hv_store_flags||5.008000|
1446
hv_stores|5.009004||p
1449
ibcmp_locale||5.004000|
1450
ibcmp_utf8||5.007003|
1453
incpush_if_exists|||
1457
init_argv_symbols|||
1459
init_global_struct|||
1460
init_i18nl10n||5.006000|
1461
init_i18nl14n||5.006000|
1466
init_postdump_symbols|||
1467
init_predump_symbols|||
1468
init_stacks||5.005000|
1476
isALNUMC|5.006000||p
1484
isGV_with_GP|5.009004||p
1487
isPSXSPC|5.006001||p
1491
isXDIGIT|5.006000||p
1494
is_handle_constructor|||n
1495
is_list_assignment|||
1496
is_lvalue_sub||5.007001|
1497
is_uni_alnum_lc||5.006000|
1498
is_uni_alnumc_lc||5.006000|
1499
is_uni_alnumc||5.006000|
1500
is_uni_alnum||5.006000|
1501
is_uni_alpha_lc||5.006000|
1502
is_uni_alpha||5.006000|
1503
is_uni_ascii_lc||5.006000|
1504
is_uni_ascii||5.006000|
1505
is_uni_cntrl_lc||5.006000|
1506
is_uni_cntrl||5.006000|
1507
is_uni_digit_lc||5.006000|
1508
is_uni_digit||5.006000|
1509
is_uni_graph_lc||5.006000|
1510
is_uni_graph||5.006000|
1511
is_uni_idfirst_lc||5.006000|
1512
is_uni_idfirst||5.006000|
1513
is_uni_lower_lc||5.006000|
1514
is_uni_lower||5.006000|
1515
is_uni_print_lc||5.006000|
1516
is_uni_print||5.006000|
1517
is_uni_punct_lc||5.006000|
1518
is_uni_punct||5.006000|
1519
is_uni_space_lc||5.006000|
1520
is_uni_space||5.006000|
1521
is_uni_upper_lc||5.006000|
1522
is_uni_upper||5.006000|
1523
is_uni_xdigit_lc||5.006000|
1524
is_uni_xdigit||5.006000|
1525
is_utf8_alnumc||5.006000|
1526
is_utf8_alnum||5.006000|
1527
is_utf8_alpha||5.006000|
1528
is_utf8_ascii||5.006000|
1529
is_utf8_char_slow|||n
1530
is_utf8_char||5.006000|
1531
is_utf8_cntrl||5.006000|
1533
is_utf8_digit||5.006000|
1534
is_utf8_graph||5.006000|
1535
is_utf8_idcont||5.008000|
1536
is_utf8_idfirst||5.006000|
1537
is_utf8_lower||5.006000|
1538
is_utf8_mark||5.006000|
1539
is_utf8_print||5.006000|
1540
is_utf8_punct||5.006000|
1541
is_utf8_space||5.006000|
1542
is_utf8_string_loclen||5.009003|
1543
is_utf8_string_loc||5.008001|
1544
is_utf8_string||5.006001|
1545
is_utf8_upper||5.006000|
1546
is_utf8_xdigit||5.006000|
1559
load_module_nocontext|||vn
1560
load_module|5.006000||pv
1563
looks_like_number|||
1578
magic_clear_all_env|||
1584
magic_dump||5.006000|
1586
magic_freearylen_p|||
1599
magic_killbackrefs|||
1604
magic_regdata_cnt|||
1605
magic_regdatum_get|||
1606
magic_regdatum_set|||
1608
magic_set_all_env|||
1611
magic_setcollxfrm|||
1632
make_trie_failtable|||
1634
malloc_good_size|||n
1638
matcher_matches_sv|||
1655
mg_length||5.005000|
1660
mini_mktime||5.007002|
1662
mode_from_discipline|||
1668
mro_get_from_name||5.011000|
1669
mro_get_linear_isa_dfs|||
1670
mro_get_linear_isa||5.009005|
1671
mro_get_private_data||5.011000|
1672
mro_isa_changed_in|||
1675
mro_method_changed_in||5.009005|
1676
mro_register||5.011000|
1677
mro_set_mro||5.011000|
1678
mro_set_private_data||5.011000|
1699
my_failure_exit||5.004000|
1700
my_fflush_all||5.006000|
1723
my_memcmp||5.004000|n
1726
my_pclose||5.004000|
1727
my_popen_list||5.007001|
1730
my_snprintf|5.009004||pvn
1731
my_socketpair||5.007003|n
1732
my_sprintf|5.009003||pvn
1734
my_strftime||5.007002|
1735
my_strlcat|5.009004||pn
1736
my_strlcpy|5.009004||pn
1740
my_vsnprintf||5.009004|n
1742
newANONATTRSUB||5.006000|
1747
newATTRSUB||5.006000|
1752
newCONSTSUB|5.004050||p
1757
newGIVENOP||5.009003|
1781
newRV_inc|5.004000||p
1782
newRV_noinc|5.004000||p
1789
newSV_type|5.009005||p
1793
newSVpvf_nocontext|||vn
1794
newSVpvf||5.004000|v
1795
newSVpvn_flags|5.011000||p
1796
newSVpvn_share|5.007001||p
1797
newSVpvn_utf8|5.011000||p
1798
newSVpvn|5.004050||p
1799
newSVpvs_flags|5.011000||p
1800
newSVpvs_share||5.009003|
1801
newSVpvs|5.009003||p
1809
newWHENOP||5.009003|
1810
newWHILEOP||5.009003|
1811
newXS_flags||5.009004|
1812
newXSproto||5.006000|
1814
new_collate||5.006000|
1816
new_ctype||5.006000|
1819
new_numeric||5.006000|
1820
new_stackinfo||5.005000|
1821
new_version||5.009000|
1822
new_warnings_bitfield|||
1827
no_bareword_allowed|||
1831
nothreadhook||5.008000|
1846
op_refcnt_lock||5.009002|
1847
op_refcnt_unlock||5.009002|
1850
pMY_CXT_|5.007003||p
1854
packWARN|5.007003||p
1864
pad_compname_type|||
1867
pad_fixup_inner_anons|||
1880
parse_unicode_opts|||
1883
path_is_absolute|||n
1885
pending_Slabs_to_ro|||
1886
perl_alloc_using|||n
1888
perl_clone_using|||n
1891
perl_destruct||5.007003|n
1893
perl_parse||5.006000|n
1898
pmop_dump||5.006000|
1905
pregfree2||5.011000|
1910
printf_nocontext|||vn
1911
process_special_blocks|||
1912
ptr_table_clear||5.009005|
1913
ptr_table_fetch||5.009005|
1915
ptr_table_free||5.009005|
1916
ptr_table_new||5.009005|
1917
ptr_table_split||5.009005|
1918
ptr_table_store||5.009005|
1921
pv_display|5.006000||p
1922
pv_escape|5.009004||p
1923
pv_pretty|5.009004||p
1924
pv_uni_display||5.007003|
1927
re_compile||5.009005|
1930
re_intuit_start||5.009005|
1931
re_intuit_string||5.006000|
1932
readpipe_override|||
1936
reentrant_retry|||vn
1938
ref_array_or_hash|||
1939
refcounted_he_chain_2hv|||
1940
refcounted_he_fetch|||
1941
refcounted_he_free|||
1942
refcounted_he_new_common|||
1943
refcounted_he_new|||
1944
refcounted_he_value|||
1948
reg_check_named_buff_matched|||
1949
reg_named_buff_all||5.009005|
1950
reg_named_buff_exists||5.009005|
1951
reg_named_buff_fetch||5.009005|
1952
reg_named_buff_firstkey||5.009005|
1953
reg_named_buff_iter|||
1954
reg_named_buff_nextkey||5.009005|
1955
reg_named_buff_scalar||5.009005|
1959
reg_numbered_buff_fetch|||
1960
reg_numbered_buff_length|||
1961
reg_numbered_buff_store|||
1970
regclass_swash||5.009004|
1978
regexec_flags||5.005000|
1979
regfree_internal||5.009005|
1984
reginitcolors||5.006000|
2001
require_pv||5.006000|
2007
rsignal_state||5.004000|
2011
runops_debug||5.005000|
2012
runops_standard||5.005000|
2017
safesyscalloc||5.006000|n
2018
safesysfree||5.006000|n
2019
safesysmalloc||5.006000|n
2020
safesysrealloc||5.006000|n
2025
save_adelete||5.011000|
2026
save_aelem||5.004050|
2027
save_alloc||5.006000|
2030
save_bool||5.008001|
2033
save_destructor_x||5.006000|
2034
save_destructor||5.006000|
2038
save_generic_pvref||5.006001|
2039
save_generic_svref||5.005030|
2043
save_helem_flags||5.011000|
2044
save_helem||5.004050|
2054
save_mortalizesv||5.007001|
2057
save_padsv_and_mortalize||5.011000|
2060
save_pushptri32ptr|||
2062
save_pushptr||5.011000|
2063
save_re_context||5.006000|
2066
save_set_svflags||5.009000|
2067
save_shared_pvref||5.007003|
2070
save_vptr||5.006000|
2074
savesharedpvn||5.009005|
2075
savesharedpv||5.007003|
2076
savestack_grow_cnt||5.008001|
2100
scan_version||5.009001|
2101
scan_vstring||5.009005|
2104
screaminstr||5.005000|
2110
set_context||5.006000|n
2111
set_numeric_local||5.006000|
2112
set_numeric_radix||5.006000|
2113
set_numeric_standard||5.006000|
2116
share_hek||5.004000|
2128
sortsv_flags||5.009003|
2130
space_join_names_mortal|||
2135
start_subparse||5.004000|
2136
stashpv_hvname_match||5.011000|
2145
str_to_version||5.006000|
2158
sv_2iuv_non_preserve|||
2159
sv_2iv_flags||5.009001|
2164
sv_2pv_flags|5.007002||p
2165
sv_2pv_nolen|5.006000||p
2166
sv_2pvbyte_nolen|5.006000||p
2167
sv_2pvbyte|5.006000||p
2168
sv_2pvutf8_nolen||5.006000|
2169
sv_2pvutf8||5.006000|
2171
sv_2uv_flags||5.009001|
2177
sv_cat_decode||5.008001|
2178
sv_catpv_mg|5.004050||p
2179
sv_catpvf_mg_nocontext|||pvn
2180
sv_catpvf_mg|5.006000|5.004000|pv
2181
sv_catpvf_nocontext|||vn
2182
sv_catpvf||5.004000|v
2183
sv_catpvn_flags||5.007002|
2184
sv_catpvn_mg|5.004050||p
2185
sv_catpvn_nomg|5.007002||p
2187
sv_catpvs|5.009003||p
2189
sv_catsv_flags||5.007002|
2190
sv_catsv_mg|5.004050||p
2191
sv_catsv_nomg|5.007002||p
2199
sv_cmp_locale||5.004000|
2202
sv_compile_2op||5.008001|
2203
sv_copypv||5.007003|
2206
sv_derived_from||5.004000|
2207
sv_destroyable||5.010000|
2210
sv_dup_inc_multiple|||
2214
sv_force_normal_flags||5.007001|
2215
sv_force_normal||5.006000|
2223
sv_insert_flags||5.011000|
2229
sv_len_utf8||5.006000|
2231
sv_magic_portable|5.011000|5.004000|p
2232
sv_magicext||5.007003|
2238
sv_nolocking||5.007003|
2239
sv_nosharing||5.007003|
2243
sv_pos_b2u_midway|||
2244
sv_pos_b2u||5.006000|
2245
sv_pos_u2b_cached|||
2246
sv_pos_u2b_forwards|||n
2247
sv_pos_u2b_midway|||n
2248
sv_pos_u2b||5.006000|
2249
sv_pvbyten_force||5.006000|
2250
sv_pvbyten||5.006000|
2251
sv_pvbyte||5.006000|
2252
sv_pvn_force_flags|5.007002||p
2254
sv_pvn_nomg|5.007003|5.005000|p
2256
sv_pvutf8n_force||5.006000|
2257
sv_pvutf8n||5.006000|
2258
sv_pvutf8||5.006000|
2260
sv_recode_to_utf8||5.007003|
2266
sv_rvweaken||5.006000|
2267
sv_setiv_mg|5.004050||p
2269
sv_setnv_mg|5.006000||p
2271
sv_setpv_mg|5.004050||p
2272
sv_setpvf_mg_nocontext|||pvn
2273
sv_setpvf_mg|5.006000|5.004000|pv
2274
sv_setpvf_nocontext|||vn
2275
sv_setpvf||5.004000|v
2276
sv_setpviv_mg||5.008001|
2277
sv_setpviv||5.008001|
2278
sv_setpvn_mg|5.004050||p
2280
sv_setpvs|5.009004||p
2286
sv_setref_uv||5.007001|
2288
sv_setsv_flags||5.007002|
2289
sv_setsv_mg|5.004050||p
2290
sv_setsv_nomg|5.007002||p
2292
sv_setuv_mg|5.004050||p
2293
sv_setuv|5.004000||p
2294
sv_tainted||5.004000|
2298
sv_uni_display||5.007003|
2300
sv_unref_flags||5.007001|
2302
sv_untaint||5.004000|
2304
sv_usepvn_flags||5.009004|
2305
sv_usepvn_mg|5.004050||p
2307
sv_utf8_decode||5.006000|
2308
sv_utf8_downgrade||5.006000|
2309
sv_utf8_encode||5.006000|
2310
sv_utf8_upgrade_flags_grow||5.011000|
2311
sv_utf8_upgrade_flags||5.007002|
2312
sv_utf8_upgrade_nomg||5.007002|
2313
sv_utf8_upgrade||5.007001|
2315
sv_vcatpvf_mg|5.006000|5.004000|p
2316
sv_vcatpvfn||5.004000|
2317
sv_vcatpvf|5.006000|5.004000|p
2318
sv_vsetpvf_mg|5.006000|5.004000|p
2319
sv_vsetpvfn||5.004000|
2320
sv_vsetpvf|5.006000|5.004000|p
2325
swash_fetch||5.007002|
2327
swash_init||5.006000|
2328
sys_init3||5.010000|n
2329
sys_init||5.010000|n
2333
sys_term||5.010000|n
2336
tmps_grow||5.006000|
2340
to_uni_fold||5.007003|
2341
to_uni_lower_lc||5.006000|
2342
to_uni_lower||5.007003|
2343
to_uni_title_lc||5.006000|
2344
to_uni_title||5.007003|
2345
to_uni_upper_lc||5.006000|
2346
to_uni_upper||5.007003|
2347
to_utf8_case||5.007003|
2348
to_utf8_fold||5.007003|
2349
to_utf8_lower||5.007003|
2351
to_utf8_title||5.007003|
2352
to_utf8_upper||5.007003|
2358
too_few_arguments|||
2359
too_many_arguments|||
2363
unpack_str||5.007003|
2364
unpackstring||5.008001|
2365
unshare_hek_or_pvn|||
2367
unsharepvn||5.004000|
2368
unwind_handler_stack|||
2369
update_debugger_info|||
2370
upg_version||5.009005|
2372
utf16_to_utf8_reversed||5.006001|
2373
utf16_to_utf8||5.006001|
2374
utf8_distance||5.006000|
2376
utf8_length||5.007001|
2377
utf8_mg_pos_cache_update|||
2378
utf8_to_bytes||5.006001|
2379
utf8_to_uvchr||5.007001|
2380
utf8_to_uvuni||5.007001|
2382
utf8n_to_uvuni||5.007001|
2384
uvchr_to_utf8_flags||5.007003|
2386
uvuni_to_utf8_flags||5.007003|
2387
uvuni_to_utf8||5.007001|
2394
vdie_croak_common|||
2400
vload_module|5.006000||p
2402
vnewSVpvf|5.006000|5.004000|p
2405
vstringify||5.009000|
2411
warner_nocontext|||vn
2412
warner|5.006000|5.004000|pv
2432
if (exists $opt{'list-unsupported'}) {
2434
for $f (sort { lc $a cmp lc $b } keys %API) {
2435
next unless $API{$f}{todo};
2436
print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2441
# Scan for possible replacement candidates
2443
my(%replace, %need, %hints, %warnings, %depends);
2445
my($hint, $define, $function);
2451
/ (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2452
| "[^"\\]*(?:\\.[^"\\]*)*"
2453
| '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
2454
grep { exists $API{$_} } $code =~ /(\w+)/mg;
2459
my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
2460
if (m{^\s*\*\s(.*?)\s*$}) {
2461
for (@{$hint->[1]}) {
2462
$h->{$_} ||= ''; # suppress warning with older perls
2466
else { undef $hint }
2469
$hint = [$1, [split /,?\s+/, $2]]
2470
if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
2473
if ($define->[1] =~ /\\$/) {
2477
if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
2478
my @n = find_api($define->[1]);
2479
push @{$depends{$define->[0]}}, @n if @n
2485
$define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
2489
if (exists $API{$function->[0]}) {
2490
my @n = find_api($function->[1]);
2491
push @{$depends{$function->[0]}}, @n if @n
2496
$function->[1] .= $_;
2500
$function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
2502
$replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2503
$replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2504
$replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2505
$replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2507
if (m{^\s*$rccs\s+(\w+(\s*,\s*\w+)*)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2508
my @deps = map { s/\s+//g; $_ } split /,/, $3;
2510
for $d (map { s/\s+//g; $_ } split /,/, $1) {
2511
push @{$depends{$d}}, @deps;
2515
$need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2518
for (values %depends) {
2520
$_ = [sort grep !$s{$_}++, @$_];
2523
if (exists $opt{'api-info'}) {
2526
my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2527
for $f (sort { lc $a cmp lc $b } keys %API) {
2528
next unless $f =~ /$match/;
2529
print "\n=== $f ===\n\n";
2531
if ($API{$f}{base} || $API{$f}{todo}) {
2532
my $base = format_version($API{$f}{base} || $API{$f}{todo});
2533
print "Supported at least starting from perl-$base.\n";
2536
if ($API{$f}{provided}) {
2537
my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2538
print "Support by $ppport provided back to perl-$todo.\n";
2539
print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2540
print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2541
print "\n$hints{$f}" if exists $hints{$f};
2542
print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
2545
print "No portability information available.\n" unless $info;
2548
$count or print "Found no API matching '$opt{'api-info'}'.";
2553
if (exists $opt{'list-provided'}) {
2555
for $f (sort { lc $a cmp lc $b } keys %API) {
2556
next unless $API{$f}{provided};
2558
push @flags, 'explicit' if exists $need{$f};
2559
push @flags, 'depend' if exists $depends{$f};
2560
push @flags, 'hint' if exists $hints{$f};
2561
push @flags, 'warning' if exists $warnings{$f};
2562
my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
2569
my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
2570
my $srcext = join '|', map { quotemeta $_ } @srcext;
2577
push @files, $_ unless $seen{$_}++;
2579
else { warn "'$_' is not a file.\n" }
2582
my @new = grep { -f } glob $_
2583
or warn "'$_' does not exist.\n";
2584
push @files, grep { !$seen{$_}++ } @new;
2591
File::Find::find(sub {
2592
$File::Find::name =~ /($srcext)$/i
2593
and push @files, $File::Find::name;
2597
@files = map { glob "*$_" } @srcext;
2601
if (!@ARGV || $opt{filter}) {
2603
my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
2605
my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
2606
push @{ $out ? \@out : \@in }, $_;
2608
if (@ARGV && @out) {
2609
warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
2614
die "No input files given!\n" unless @files;
2616
my(%files, %global, %revreplace);
2617
%revreplace = reverse %replace;
2619
my $patch_opened = 0;
2621
for $filename (@files) {
2622
unless (open IN, "<$filename") {
2623
warn "Unable to read from $filename: $!\n";
2627
info("Scanning $filename ...");
2629
my $c = do { local $/; <IN> };
2632
my %file = (orig => $c, changes => 0);
2634
# Temporarily remove C/XS comments and strings from the code
2638
( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
2639
| ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
2641
| "[^"\\]*(?:\\.[^"\\]*)*"
2642
| '[^'\\]*(?:\\.[^'\\]*)*'
2643
| / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
2644
}{ defined $2 and push @ccom, $2;
2645
defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
2647
$file{ccom} = \@ccom;
2649
$file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
2653
for $func (keys %API) {
2655
$match .= "|$revreplace{$func}" if exists $revreplace{$func};
2656
if ($c =~ /\b(?:Perl_)?($match)\b/) {
2657
$file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
2658
$file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
2659
if (exists $API{$func}{provided}) {
2660
$file{uses_provided}{$func}++;
2661
if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
2662
$file{uses}{$func}++;
2663
my @deps = rec_depend($func);
2665
$file{uses_deps}{$func} = \@deps;
2667
$file{uses}{$_} = 0 unless exists $file{uses}{$_};
2670
for ($func, @deps) {
2671
$file{needs}{$_} = 'static' if exists $need{$_};
2675
if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
2676
if ($c =~ /\b$func\b/) {
2677
$file{uses_todo}{$func}++;
2683
while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
2684
if (exists $need{$2}) {
2685
$file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
2687
else { warning("Possibly wrong #define $1 in $filename") }
2690
for (qw(uses needs uses_todo needed_global needed_static)) {
2691
for $func (keys %{$file{$_}}) {
2692
push @{$global{$_}{$func}}, $filename;
2696
$files{$filename} = \%file;
2699
# Globally resolve NEED_'s
2701
for $need (keys %{$global{needs}}) {
2702
if (@{$global{needs}{$need}} > 1) {
2703
my @targets = @{$global{needs}{$need}};
2704
my @t = grep $files{$_}{needed_global}{$need}, @targets;
2705
@targets = @t if @t;
2706
@t = grep /\.xs$/i, @targets;
2707
@targets = @t if @t;
2708
my $target = shift @targets;
2709
$files{$target}{needs}{$need} = 'global';
2710
for (@{$global{needs}{$need}}) {
2711
$files{$_}{needs}{$need} = 'extern' if $_ ne $target;
2716
for $filename (@files) {
2717
exists $files{$filename} or next;
2719
info("=== Analyzing $filename ===");
2721
my %file = %{$files{$filename}};
2723
my $c = $file{code};
2726
for $func (sort keys %{$file{uses_Perl}}) {
2727
if ($API{$func}{varargs}) {
2728
unless ($API{$func}{nothxarg}) {
2729
my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
2730
{ $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
2732
warning("Doesn't pass interpreter argument aTHX to Perl_$func");
2733
$file{changes} += $changes;
2738
warning("Uses Perl_$func instead of $func");
2739
$file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
2744
for $func (sort keys %{$file{uses_replace}}) {
2745
warning("Uses $func instead of $replace{$func}");
2746
$file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2749
for $func (sort keys %{$file{uses_provided}}) {
2750
if ($file{uses}{$func}) {
2751
if (exists $file{uses_deps}{$func}) {
2752
diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
2758
$warnings += hint($func);
2761
unless ($opt{quiet}) {
2762
for $func (sort keys %{$file{uses_todo}}) {
2763
print "*** WARNING: Uses $func, which may not be portable below perl ",
2764
format_version($API{$func}{todo}), ", even with '$ppport'\n";
2769
for $func (sort keys %{$file{needed_static}}) {
2771
if (not exists $file{uses}{$func}) {
2772
$message = "No need to define NEED_$func if $func is never used";
2774
elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
2775
$message = "No need to define NEED_$func when already needed globally";
2779
$file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
2783
for $func (sort keys %{$file{needed_global}}) {
2785
if (not exists $global{uses}{$func}) {
2786
$message = "No need to define NEED_${func}_GLOBAL if $func is never used";
2788
elsif (exists $file{needs}{$func}) {
2789
if ($file{needs}{$func} eq 'extern') {
2790
$message = "No need to define NEED_${func}_GLOBAL when already needed globally";
2792
elsif ($file{needs}{$func} eq 'static') {
2793
$message = "No need to define NEED_${func}_GLOBAL when only used in this file";
2798
$file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
2802
$file{needs_inc_ppport} = keys %{$file{uses}};
2804
if ($file{needs_inc_ppport}) {
2807
for $func (sort keys %{$file{needs}}) {
2808
my $type = $file{needs}{$func};
2809
next if $type eq 'extern';
2810
my $suffix = $type eq 'global' ? '_GLOBAL' : '';
2811
unless (exists $file{"needed_$type"}{$func}) {
2812
if ($type eq 'global') {
2813
diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
2816
diag("File needs $func, adding static request");
2818
$pp .= "#define NEED_$func$suffix\n";
2822
if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
2827
unless ($file{has_inc_ppport}) {
2828
diag("Needs to include '$ppport'");
2829
$pp .= qq(#include "$ppport"\n)
2833
$file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
2834
|| ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
2835
|| ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
2836
|| ($c =~ s/^/$pp/);
2840
if ($file{has_inc_ppport}) {
2841
diag("No need to include '$ppport'");
2842
$file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
2846
# put back in our C comments
2849
my @ccom = @{$file{ccom}};
2850
for $ix (0 .. $#ccom) {
2851
if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
2853
$file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
2856
$c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
2861
my $s = $cppc != 1 ? 's' : '';
2862
warning("Uses $cppc C++ style comment$s, which is not portable");
2865
my $s = $warnings != 1 ? 's' : '';
2866
my $warn = $warnings ? " ($warnings warning$s)" : '';
2867
info("Analysis completed$warn");
2869
if ($file{changes}) {
2870
if (exists $opt{copy}) {
2871
my $newfile = "$filename$opt{copy}";
2873
error("'$newfile' already exists, refusing to write copy of '$filename'");
2877
if (open F, ">$newfile") {
2878
info("Writing copy of '$filename' with changes to '$newfile'");
2883
error("Cannot open '$newfile' for writing: $!");
2887
elsif (exists $opt{patch} || $opt{changes}) {
2888
if (exists $opt{patch}) {
2889
unless ($patch_opened) {
2890
if (open PATCH, ">$opt{patch}") {
2894
error("Cannot open '$opt{patch}' for writing: $!");
2900
mydiff(\*PATCH, $filename, $c);
2904
info("Suggested changes:");
2905
mydiff(\*STDOUT, $filename, $c);
2909
my $s = $file{changes} == 1 ? '' : 's';
2910
info("$file{changes} potentially required change$s detected");
2918
close PATCH if $patch_opened;
2923
sub try_use { eval "use @_;"; return $@ eq '' }
2928
my($file, $str) = @_;
2931
if (exists $opt{diff}) {
2932
$diff = run_diff($opt{diff}, $file, $str);
2935
if (!defined $diff and try_use('Text::Diff')) {
2936
$diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
2937
$diff = <<HEADER . $diff;
2943
if (!defined $diff) {
2944
$diff = run_diff('diff -u', $file, $str);
2947
if (!defined $diff) {
2948
$diff = run_diff('diff', $file, $str);
2951
if (!defined $diff) {
2952
error("Cannot generate a diff. Please install Text::Diff or use --copy.");
2961
my($prog, $file, $str) = @_;
2962
my $tmp = 'dppptemp';
2967
while (-e "$tmp.$suf") { $suf++ }
2970
if (open F, ">$tmp") {
2974
if (open F, "$prog $file $tmp |") {
2976
s/\Q$tmp\E/$file.patched/;
2987
error("Cannot open '$tmp' for writing: $!");
2995
my($func, $seen) = @_;
2996
return () unless exists $depends{$func};
2997
$seen = {%{$seen||{}}};
2998
return () if $seen->{$func}++;
3000
grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
3007
if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
3008
return ($1, $2, $3);
3010
elsif ($ver !~ /^\d+\.[\d_]+$/) {
3011
die "cannot parse version '$ver'\n";
3015
$ver =~ s/$/000000/;
3017
my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3022
if ($r < 5 || ($r == 5 && $v < 6)) {
3024
die "cannot parse version '$ver'\n";
3028
return ($r, $v, $s);
3035
$ver =~ s/$/000000/;
3036
my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
3041
if ($r < 5 || ($r == 5 && $v < 6)) {
3043
die "invalid version '$ver'\n";
3047
$ver = sprintf "%d.%03d", $r, $v;
3048
$s > 0 and $ver .= sprintf "_%02d", $s;
3053
return sprintf "%d.%d.%d", $r, $v, $s;
3058
$opt{quiet} and return;
3064
$opt{quiet} and return;
3065
$opt{diag} and print @_, "\n";
3070
$opt{quiet} and return;
3071
print "*** ", @_, "\n";
3076
print "*** ERROR: ", @_, "\n";
3083
$opt{quiet} and return;
3086
if (exists $warnings{$func} && !$given_warnings{$func}++) {
3087
my $warn = $warnings{$func};
3088
$warn =~ s!^!*** !mg;
3089
print "*** WARNING: $func\n", $warn;
3092
if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
3093
my $hint = $hints{$func};
3095
print " --- hint for $func ---\n", $hint;
3102
my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3103
my %M = ( 'I' => '*' );
3104
$usage =~ s/^\s*perl\s+\S+/$^X $0/;
3105
$usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3111
See perldoc $0 for details.
3120
my $self = do { local(@ARGV,$/)=($0); <> };
3121
my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
3122
$copy =~ s/^(?=\S+)/ /gms;
3123
$self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
3124
$self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3125
if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3126
eval { require Devel::PPPort };
3127
\$@ and die "Cannot require Devel::PPPort, please install.\\n";
3128
if (eval \$Devel::PPPort::VERSION < $VERSION) {
3129
die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
3130
. "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
3131
. "Please install a newer version, or --unstrip will not work.\\n";
3133
Devel::PPPort::WriteFile(\$0);
3138
Sorry, but this is a stripped version of \$0.
3140
To be able to use its original script and doc functionality,
3141
please try to regenerate this file using:
3147
my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
3149
/ (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
3150
| ( "[^"\\]*(?:\\.[^"\\]*)*"
3151
| '[^'\\]*(?:\\.[^'\\]*)*' )
3152
| ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
3155
$c =~ s!^\s*#\s*!#!mg;
3158
open OUT, ">$0" or die "cannot strip $0: $!\n";
3159
print OUT "$pl$c\n";
168
3167
#ifndef _P_P_PORTABILITY_H_
169
3168
#define _P_P_PORTABILITY_H_
171
#ifndef PERL_REVISION
172
#ifndef __PATCHLEVEL_H_INCLUDED__
173
#define PERL_PATCHLEVEL_H_IMPLICIT
174
#include <patchlevel.h>
176
#if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
177
#include <could_not_find_Perl_patchlevel.h>
179
#ifndef PERL_REVISION
180
#define PERL_REVISION (5)
182
#define PERL_VERSION PATCHLEVEL
183
#define PERL_SUBVERSION SUBVERSION
184
/* Replace PERL_PATCHLEVEL with PERL_VERSION */
189
#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
3170
#ifndef DPPP_NAMESPACE
3171
# define DPPP_NAMESPACE DPPP_
3174
#define DPPP_CAT2(x,y) CAT2(x,y)
3175
#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3177
#ifndef PERL_REVISION
3178
# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3179
# define PERL_PATCHLEVEL_H_IMPLICIT
3180
# include <patchlevel.h>
3182
# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3183
# include <could_not_find_Perl_patchlevel.h>
3185
# ifndef PERL_REVISION
3186
# define PERL_REVISION (5)
3188
# define PERL_VERSION PATCHLEVEL
3189
# define PERL_SUBVERSION SUBVERSION
3190
/* Replace PERL_PATCHLEVEL with PERL_VERSION */
3195
#define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
3196
#define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
191
3198
/* It is very unlikely that anyone will try to use this with Perl 6
192
3199
(or greater), but who knows.
194
3201
#if PERL_REVISION != 5
195
#error ppport.h only works with Perl version 5
196
#endif /* PERL_REVISION != 5 */
199
#define ERRSV perl_get_sv("@",FALSE)
202
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
205
#define PL_compiling compiling
206
#define PL_copline copline
207
#define PL_curcop curcop
208
#define PL_curstash curstash
209
#define PL_defgv defgv
210
#define PL_dirty dirty
211
#define PL_dowarn dowarn
212
#define PL_hints hints
214
#define PL_perldb perldb
215
#define PL_rsfp_filters rsfp_filters
216
#define PL_rsfpv rsfp
217
#define PL_stdingv stdingv
218
#define PL_sv_no sv_no
219
#define PL_sv_undef sv_undef
220
#define PL_sv_yes sv_yes
224
#ifndef PERL_UNUSED_DECL
226
#if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
227
#define PERL_UNUSED_DECL
229
#define PERL_UNUSED_DECL __attribute__((unused))
232
#define PERL_UNUSED_DECL
238
#define dNOOP extern int Perl___notused PERL_UNUSED_DECL
3202
# error ppport.h only works with Perl version 5
3203
#endif /* PERL_REVISION != 5 */
247
#define dTHXa(x) dNOOP
248
#define dTHXoa(x) dNOOP
3212
# define dTHXa(x) dNOOP
259
#define dAX I32 ax = MARK - PL_stack_base + 1
262
#define dITEMS I32 items = SP - MARK
265
/* IV could also be a quad (say, a long long), but Perls
266
* capable of those should have IVSIZE already. */
267
#if !defined(IVSIZE) && defined(LONGSIZE)
268
#define IVSIZE LONGSIZE
271
#define IVSIZE 4 /* A bold guess, but the best we can make. */
3230
#if (PERL_BCDVERSION < 0x5006000)
3233
# define aTHXR_ thr,
3241
# define aTHXR_ aTHX_
3245
# define dTHXoa(x) dTHXa(x)
3249
# include <limits.h>
3252
#ifndef PERL_UCHAR_MIN
3253
# define PERL_UCHAR_MIN ((unsigned char)0)
3256
#ifndef PERL_UCHAR_MAX
3258
# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3261
# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3263
# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3268
#ifndef PERL_USHORT_MIN
3269
# define PERL_USHORT_MIN ((unsigned short)0)
3272
#ifndef PERL_USHORT_MAX
3274
# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3277
# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3280
# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3282
# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3288
#ifndef PERL_SHORT_MAX
3290
# define PERL_SHORT_MAX ((short)SHORT_MAX)
3292
# ifdef MAXSHORT /* Often used in <values.h> */
3293
# define PERL_SHORT_MAX ((short)MAXSHORT)
3296
# define PERL_SHORT_MAX ((short)SHRT_MAX)
3298
# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
3304
#ifndef PERL_SHORT_MIN
3306
# define PERL_SHORT_MIN ((short)SHORT_MIN)
3309
# define PERL_SHORT_MIN ((short)MINSHORT)
3312
# define PERL_SHORT_MIN ((short)SHRT_MIN)
3314
# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
3320
#ifndef PERL_UINT_MAX
3322
# define PERL_UINT_MAX ((unsigned int)UINT_MAX)
3325
# define PERL_UINT_MAX ((unsigned int)MAXUINT)
3327
# define PERL_UINT_MAX (~(unsigned int)0)
3332
#ifndef PERL_UINT_MIN
3333
# define PERL_UINT_MIN ((unsigned int)0)
3336
#ifndef PERL_INT_MAX
3338
# define PERL_INT_MAX ((int)INT_MAX)
3340
# ifdef MAXINT /* Often used in <values.h> */
3341
# define PERL_INT_MAX ((int)MAXINT)
3343
# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
3348
#ifndef PERL_INT_MIN
3350
# define PERL_INT_MIN ((int)INT_MIN)
3353
# define PERL_INT_MIN ((int)MININT)
3355
# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
3360
#ifndef PERL_ULONG_MAX
3362
# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
3365
# define PERL_ULONG_MAX ((unsigned long)MAXULONG)
3367
# define PERL_ULONG_MAX (~(unsigned long)0)
3372
#ifndef PERL_ULONG_MIN
3373
# define PERL_ULONG_MIN ((unsigned long)0L)
3376
#ifndef PERL_LONG_MAX
3378
# define PERL_LONG_MAX ((long)LONG_MAX)
3381
# define PERL_LONG_MAX ((long)MAXLONG)
3383
# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
3388
#ifndef PERL_LONG_MIN
3390
# define PERL_LONG_MIN ((long)LONG_MIN)
3393
# define PERL_LONG_MIN ((long)MINLONG)
3395
# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
3400
#if defined(HAS_QUAD) && (defined(convex) || defined(uts))
3401
# ifndef PERL_UQUAD_MAX
3402
# ifdef ULONGLONG_MAX
3403
# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
3405
# ifdef MAXULONGLONG
3406
# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
3408
# define PERL_UQUAD_MAX (~(unsigned long long)0)
3413
# ifndef PERL_UQUAD_MIN
3414
# define PERL_UQUAD_MIN ((unsigned long long)0L)
3417
# ifndef PERL_QUAD_MAX
3418
# ifdef LONGLONG_MAX
3419
# define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3422
# define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3424
# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3429
# ifndef PERL_QUAD_MIN
3430
# ifdef LONGLONG_MIN
3431
# define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3434
# define PERL_QUAD_MIN ((long long)MINLONGLONG)
3436
# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3442
/* This is based on code from 5.003 perl.h */
3450
# define IV_MIN PERL_INT_MIN
3454
# define IV_MAX PERL_INT_MAX
3458
# define UV_MIN PERL_UINT_MIN
3462
# define UV_MAX PERL_UINT_MAX
3467
# define IVSIZE INTSIZE
3472
# if defined(convex) || defined(uts)
3474
# define IVTYPE long long
3478
# define IV_MIN PERL_QUAD_MIN
3482
# define IV_MAX PERL_QUAD_MAX
3486
# define UV_MIN PERL_UQUAD_MIN
3490
# define UV_MAX PERL_UQUAD_MAX
3493
# ifdef LONGLONGSIZE
3495
# define IVSIZE LONGLONGSIZE
3501
# define IVTYPE long
3505
# define IV_MIN PERL_LONG_MIN
3509
# define IV_MAX PERL_LONG_MAX
3513
# define UV_MIN PERL_ULONG_MIN
3517
# define UV_MAX PERL_ULONG_MAX
3522
# define IVSIZE LONGSIZE
3532
#ifndef PERL_QUAD_MIN
3533
# define PERL_QUAD_MIN IV_MIN
3536
#ifndef PERL_QUAD_MAX
3537
# define PERL_QUAD_MAX IV_MAX
3540
#ifndef PERL_UQUAD_MIN
3541
# define PERL_UQUAD_MIN UV_MIN
3544
#ifndef PERL_UQUAD_MAX
3545
# define PERL_UQUAD_MAX UV_MAX
3550
# define IVTYPE long
3554
# define IV_MIN PERL_LONG_MIN
3558
# define IV_MAX PERL_LONG_MAX
3562
# define UV_MIN PERL_ULONG_MIN
3566
# define UV_MAX PERL_ULONG_MAX
3573
# define IVSIZE LONGSIZE
3575
# define IVSIZE 4 /* A bold guess, but the best we can make. */
3579
# define UVTYPE unsigned IVTYPE
275
#define UVSIZE IVSIZE
3583
# define UVSIZE IVSIZE
3586
# define sv_setuv(sv, uv) \
3589
if (TeMpUv <= IV_MAX) \
3590
sv_setiv(sv, TeMpUv); \
3592
sv_setnv(sv, (double)TeMpUv); \
3596
# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
3599
# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
3603
# define SvUVX(sv) ((UV)SvIVX(sv))
3607
# define SvUVXx(sv) SvUVX(sv)
3611
# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
3615
# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
3619
* Always use the SvUVx() macro instead of sv_uv().
3622
# define sv_uv(sv) SvUVx(sv)
3625
#if !defined(SvUOK) && defined(SvIOK_UV)
3626
# define SvUOK(sv) SvIOK_UV(sv)
3629
# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
3633
# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
3636
# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
3640
# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
3645
# define memNE(s1,s2,l) (memcmp(s1,s2,l))
3649
# define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
3654
# define memNE(s1,s2,l) (bcmp(s1,s2,l))
3658
# define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
3663
# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
3667
# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
3672
# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
3677
# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
3682
# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
3686
# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
3690
# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
3694
# define Poison(d,n,t) PoisonFree(d,n,t)
3697
# define Newx(v,n,t) New(0,v,n,t)
3701
# define Newxc(v,n,t,c) Newc(0,v,n,t,c)
3705
# define Newxz(v,n,t) Newz(0,v,n,t)
3708
#ifndef PERL_UNUSED_DECL
3709
# ifdef HASATTRIBUTE
3710
# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
3711
# define PERL_UNUSED_DECL
3713
# define PERL_UNUSED_DECL __attribute__((unused))
3716
# define PERL_UNUSED_DECL
3720
#ifndef PERL_UNUSED_ARG
3721
# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
3723
# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
3725
# define PERL_UNUSED_ARG(x) ((void)x)
3729
#ifndef PERL_UNUSED_VAR
3730
# define PERL_UNUSED_VAR(x) ((void)x)
3733
#ifndef PERL_UNUSED_CONTEXT
3734
# ifdef USE_ITHREADS
3735
# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
3737
# define PERL_UNUSED_CONTEXT
3741
# define NOOP /*EMPTY*/(void)0
3745
# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
279
#if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
280
#define NVTYPE long double
282
#define NVTYPE double
3749
# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
3750
# define NVTYPE long double
3752
# define NVTYPE double
284
3754
typedef NVTYPE NV;
289
#if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
291
#define INT2PTR(any,d) (any)(d)
293
#if PTRSIZE == LONGSIZE
294
#define PTRV unsigned long
296
#define PTRV unsigned
298
#define INT2PTR(any,d) (any)(PTRV)(d)
300
#define NUM2PTR(any,d) (any)(PTRV)(d)
301
#define PTR2IV(p) INT2PTR(IV,p)
302
#define PTR2UV(p) INT2PTR(UV,p)
303
#define PTR2NV(p) NUM2PTR(NV,p)
304
#if PTRSIZE == LONGSIZE
305
#define PTR2ul(p) (unsigned long)(p)
307
#define PTR2ul(p) INT2PTR(unsigned long,p)
309
#endif /* !INT2PTR */
3758
# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
3760
# define INT2PTR(any,d) (any)(d)
3762
# if PTRSIZE == LONGSIZE
3763
# define PTRV unsigned long
3765
# define PTRV unsigned
3767
# define INT2PTR(any,d) (any)(PTRV)(d)
3772
# if PTRSIZE == LONGSIZE
3773
# define PTR2ul(p) (unsigned long)(p)
3775
# define PTR2ul(p) INT2PTR(unsigned long,p)
3779
# define PTR2nat(p) (PTRV)(p)
3783
# define NUM2PTR(any,d) (any)PTR2nat(d)
3787
# define PTR2IV(p) INT2PTR(IV,p)
3791
# define PTR2UV(p) INT2PTR(UV,p)
3795
# define PTR2NV(p) NUM2PTR(NV,p)
3798
#undef START_EXTERN_C
3802
# define START_EXTERN_C extern "C" {
3803
# define END_EXTERN_C }
3804
# define EXTERN_C extern "C"
3806
# define START_EXTERN_C
3807
# define END_EXTERN_C
3808
# define EXTERN_C extern
3811
#if defined(PERL_GCC_PEDANTIC)
3812
# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
3813
# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
3817
#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
3818
# ifndef PERL_USE_GCC_BRACE_GROUPS
3819
# define PERL_USE_GCC_BRACE_GROUPS
3825
#ifdef PERL_USE_GCC_BRACE_GROUPS
3826
# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
3829
# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
3830
# define STMT_START if (1)
3831
# define STMT_END else (void)0
3833
# define STMT_START do
3834
# define STMT_END while (0)
312
#define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
316
#define gv_stashpvn(str,len,flags) gv_stashpv(str,flags)
320
#define newSVpvn(data,len) ((len) ? newSVpv ((data), (len)) : newSVpv ("", 0))
325
#define newRV_inc(sv) newRV(sv)
3838
# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
329
3841
/* DEFSV appears first in 5.004_56 */
331
#define DEFSV GvSV(PL_defgv)
3843
# define DEFSV GvSV(PL_defgv)
334
3846
#ifndef SAVE_DEFSV
335
#define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
3847
# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
3851
# define DEFSV_set(sv) (DEFSV = (sv))
3854
/* Older perls (<=5.003) lack AvFILLp */
3856
# define AvFILLp AvFILL
3859
# define ERRSV get_sv("@",FALSE)
3862
/* Hint: gv_stashpvn
3863
* This function's backport doesn't support the length parameter, but
3864
* rather ignores it. Portability can only be ensured if the length
3865
* parameter is used for speed reasons, but the length can always be
3866
* correctly computed from the string argument.
3869
# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
3874
# define get_cv perl_get_cv
3878
# define get_sv perl_get_sv
3882
# define get_av perl_get_av
3886
# define get_hv perl_get_hv
3891
# define dUNDERBAR dNOOP
3895
# define UNDERBAR DEFSV
3898
# define dAX I32 ax = MARK - PL_stack_base + 1
3902
# define dITEMS I32 items = SP - MARK
3905
# define dXSTARG SV * targ = sv_newmortal()
3908
# define dAXMARK I32 ax = POPMARK; \
3909
register SV ** const mark = PL_stack_base + ax++
3912
# define XSprePUSH (sp = PL_stack_base + ax - 1)
3915
#if (PERL_BCDVERSION < 0x5005000)
3917
# define XSRETURN(off) \
3919
PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
3924
# define XSPROTO(name) void name(pTHX_ CV* cv)
3928
# define SVfARG(p) ((void*)(p))
3931
# define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
3939
#ifndef UTF8_MAXBYTES
3940
# define UTF8_MAXBYTES UTF8_MAXLEN
3943
# define CPERLscope(x) x
3946
# define PERL_HASH(hash,str,len) \
3948
const char *s_PeRlHaSh = str; \
3949
I32 i_PeRlHaSh = len; \
3950
U32 hash_PeRlHaSh = 0; \
3951
while (i_PeRlHaSh--) \
3952
hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
3953
(hash) = hash_PeRlHaSh; \
3957
#ifndef PERLIO_FUNCS_DECL
3958
# ifdef PERLIO_FUNCS_CONST
3959
# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
3960
# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
3962
# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
3963
# define PERLIO_FUNCS_CAST(funcs) (funcs)
3967
/* provide these typedefs for older perls */
3968
#if (PERL_BCDVERSION < 0x5009003)
3971
typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
3973
typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
3976
typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
3980
# define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
3984
# define isBLANK(c) ((c) == ' ' || (c) == '\t')
3989
# define isALNUMC(c) isalnum(c)
3993
# define isASCII(c) isascii(c)
3997
# define isCNTRL(c) iscntrl(c)
4001
# define isGRAPH(c) isgraph(c)
4005
# define isPRINT(c) isprint(c)
4009
# define isPUNCT(c) ispunct(c)
4013
# define isXDIGIT(c) isxdigit(c)
4017
# if (PERL_BCDVERSION < 0x5010000)
4019
* The implementation in older perl versions includes all of the
4020
* isSPACE() characters, which is wrong. The version provided by
4021
* Devel::PPPort always overrides a present buggy version.
4026
# define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
4030
# define isASCII(c) ((c) <= 127)
4034
# define isCNTRL(c) ((c) < ' ' || (c) == 127)
4038
# define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
4042
# define isPRINT(c) (((c) >= 32 && (c) < 127))
4046
# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
4050
# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
4055
#ifndef PERL_SIGNALS_UNSAFE_FLAG
4057
#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
4059
#if (PERL_BCDVERSION < 0x5008000)
4060
# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
4062
# define D_PPP_PERL_SIGNALS_INIT 0
4065
#if defined(NEED_PL_signals)
4066
static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
4067
#elif defined(NEED_PL_signals_GLOBAL)
4068
U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
4070
extern U32 DPPP_(my_PL_signals);
4072
#define PL_signals DPPP_(my_PL_signals)
4077
* Calling an op via PL_ppaddr requires passing a context argument
4078
* for threaded builds. Since the context argument is different for
4079
* 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
4080
* automatically be defined as the correct argument.
4083
#if (PERL_BCDVERSION <= 0x5005005)
4085
# define PL_ppaddr ppaddr
4086
# define PL_no_modify no_modify
4090
#if (PERL_BCDVERSION <= 0x5004005)
4092
# define PL_DBsignal DBsignal
4093
# define PL_DBsingle DBsingle
4094
# define PL_DBsub DBsub
4095
# define PL_DBtrace DBtrace
4097
# define PL_bufend bufend
4098
# define PL_bufptr bufptr
4099
# define PL_compiling compiling
4100
# define PL_copline copline
4101
# define PL_curcop curcop
4102
# define PL_curstash curstash
4103
# define PL_debstash debstash
4104
# define PL_defgv defgv
4105
# define PL_diehook diehook
4106
# define PL_dirty dirty
4107
# define PL_dowarn dowarn
4108
# define PL_errgv errgv
4109
# define PL_error_count error_count
4110
# define PL_expect expect
4111
# define PL_hexdigit hexdigit
4112
# define PL_hints hints
4113
# define PL_in_my in_my
4114
# define PL_laststatval laststatval
4115
# define PL_lex_state lex_state
4116
# define PL_lex_stuff lex_stuff
4117
# define PL_linestr linestr
4119
# define PL_perl_destruct_level perl_destruct_level
4120
# define PL_perldb perldb
4121
# define PL_rsfp_filters rsfp_filters
4122
# define PL_rsfp rsfp
4123
# define PL_stack_base stack_base
4124
# define PL_stack_sp stack_sp
4125
# define PL_statcache statcache
4126
# define PL_stdingv stdingv
4127
# define PL_sv_arenaroot sv_arenaroot
4128
# define PL_sv_no sv_no
4129
# define PL_sv_undef sv_undef
4130
# define PL_sv_yes sv_yes
4131
# define PL_tainted tainted
4132
# define PL_tainting tainting
4133
# define PL_tokenbuf tokenbuf
4137
/* Warning: PL_parser
4138
* For perl versions earlier than 5.9.5, this is an always
4139
* non-NULL dummy. Also, it cannot be dereferenced. Don't
4140
* use it if you can avoid is and unless you absolutely know
4141
* what you're doing.
4142
* If you always check that PL_parser is non-NULL, you can
4143
* define DPPP_PL_parser_NO_DUMMY to avoid the creation of
4144
* a dummy parser structure.
4147
#if (PERL_BCDVERSION >= 0x5009005)
4148
# ifdef DPPP_PL_parser_NO_DUMMY
4149
# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4150
(croak("panic: PL_parser == NULL in %s:%d", \
4151
__FILE__, __LINE__), (yy_parser *) NULL))->var)
4153
# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
4154
# define D_PPP_parser_dummy_warning(var)
4156
# define D_PPP_parser_dummy_warning(var) \
4157
warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
4159
# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
4160
(D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
4161
#if defined(NEED_PL_parser)
4162
static yy_parser DPPP_(dummy_PL_parser);
4163
#elif defined(NEED_PL_parser_GLOBAL)
4164
yy_parser DPPP_(dummy_PL_parser);
4166
extern yy_parser DPPP_(dummy_PL_parser);
4171
/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
4172
/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
4173
* Do not use this variable unless you know exactly what you're
4174
* doint. It is internal to the perl parser and may change or even
4175
* be removed in the future. As of perl 5.9.5, you have to check
4176
* for (PL_parser != NULL) for this variable to have any effect.
4177
* An always non-NULL PL_parser dummy is provided for earlier
4179
* If PL_parser is NULL when you try to access this variable, a
4180
* dummy is being accessed instead and a warning is issued unless
4181
* you define DPPP_PL_parser_NO_DUMMY_WARNING.
4182
* If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
4183
* this variable will croak with a panic message.
4186
# define PL_expect D_PPP_my_PL_parser_var(expect)
4187
# define PL_copline D_PPP_my_PL_parser_var(copline)
4188
# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
4189
# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
4190
# define PL_linestr D_PPP_my_PL_parser_var(linestr)
4191
# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
4192
# define PL_bufend D_PPP_my_PL_parser_var(bufend)
4193
# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
4194
# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
4195
# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
4196
# define PL_in_my D_PPP_my_PL_parser_var(in_my)
4197
# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
4198
# define PL_error_count D_PPP_my_PL_parser_var(error_count)
4203
/* ensure that PL_parser != NULL and cannot be dereferenced */
4204
# define PL_parser ((void *) 1)
4208
# define mPUSHs(s) PUSHs(sv_2mortal(s))
4212
# define PUSHmortal PUSHs(sv_newmortal())
4216
# define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
4220
# define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
4224
# define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
4228
# define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
4231
# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
4235
# define XPUSHmortal XPUSHs(sv_newmortal())
4239
# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
4243
# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
4247
# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
4251
# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
4256
# define call_sv perl_call_sv
4260
# define call_pv perl_call_pv
4264
# define call_argv perl_call_argv
4268
# define call_method perl_call_method
4271
# define eval_sv perl_eval_sv
4275
#ifndef PERL_LOADMOD_DENY
4276
# define PERL_LOADMOD_DENY 0x1
4279
#ifndef PERL_LOADMOD_NOIMPORT
4280
# define PERL_LOADMOD_NOIMPORT 0x2
4283
#ifndef PERL_LOADMOD_IMPORT_OPS
4284
# define PERL_LOADMOD_IMPORT_OPS 0x4
4288
# define G_METHOD 64
4292
# if (PERL_BCDVERSION < 0x5006000)
4293
# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
4294
(flags) & ~G_METHOD) : perl_call_sv(sv, flags))
4296
# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
4297
(flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
4301
/* Replace perl_eval_pv with eval_pv */
4304
#if defined(NEED_eval_pv)
4305
static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4308
extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4314
#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
4315
#define Perl_eval_pv DPPP_(my_eval_pv)
4317
#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
4320
DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
4323
SV* sv = newSVpv(p, 0);
4326
eval_sv(sv, G_SCALAR);
4333
if (croak_on_error && SvTRUE(GvSV(errgv)))
4334
croak(SvPVx(GvSV(errgv), na));
4342
#ifndef vload_module
4343
#if defined(NEED_vload_module)
4344
static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
4347
extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
4351
# undef vload_module
4353
#define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
4354
#define Perl_vload_module DPPP_(my_vload_module)
4356
#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
4359
DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
4365
OP * const modname = newSVOP(OP_CONST, 0, name);
4366
/* 5.005 has a somewhat hacky force_normal that doesn't croak on
4367
SvREADONLY() if PL_compling is true. Current perls take care in
4368
ck_require() to correctly turn off SvREADONLY before calling
4369
force_normal_flags(). This seems a better fix than fudging PL_compling
4371
SvREADONLY_off(((SVOP*)modname)->op_sv);
4372
modname->op_private |= OPpCONST_BARE;
4374
veop = newSVOP(OP_CONST, 0, ver);
4378
if (flags & PERL_LOADMOD_NOIMPORT) {
4379
imop = sawparens(newNULLLIST());
4381
else if (flags & PERL_LOADMOD_IMPORT_OPS) {
4382
imop = va_arg(*args, OP*);
4387
sv = va_arg(*args, SV*);
4389
imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
4390
sv = va_arg(*args, SV*);
4394
const line_t ocopline = PL_copline;
4395
COP * const ocurcop = PL_curcop;
4396
const int oexpect = PL_expect;
4398
#if (PERL_BCDVERSION >= 0x5004000)
4399
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
4400
veop, modname, imop);
4402
utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
4405
PL_expect = oexpect;
4406
PL_copline = ocopline;
4407
PL_curcop = ocurcop;
4415
#if defined(NEED_load_module)
4416
static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
4419
extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
4425
#define load_module DPPP_(my_load_module)
4426
#define Perl_load_module DPPP_(my_load_module)
4428
#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
4431
DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
4434
va_start(args, ver);
4435
vload_module(flags, name, ver, &args);
4442
# define newRV_inc(sv) newRV(sv) /* Replace */
338
4445
#ifndef newRV_noinc
340
#define newRV_noinc(sv) \
342
SV *nsv = (SV*)newRV(sv); \
4446
#if defined(NEED_newRV_noinc)
4447
static SV * DPPP_(my_newRV_noinc)(SV *sv);
347
#if defined(USE_THREADS)
4450
extern SV * DPPP_(my_newRV_noinc)(SV *sv);
4456
#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
4457
#define Perl_newRV_noinc DPPP_(my_newRV_noinc)
4459
#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
4461
DPPP_(my_newRV_noinc)(SV *sv)
351
SV *nsv = (SV *) newRV(sv);
4463
SV *rv = (SV *)newRV(sv);
357
#define newRV_noinc(sv) \
358
(PL_Sv=(SV*)newRV(sv), SvREFCNT_dec(sv), (SV*)PL_Sv)
363
/* Provide: newCONSTSUB */
4470
/* Hint: newCONSTSUB
4471
* Returns a CV* as of perl-5.7.1. This return value is not supported
365
4475
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
366
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))
4476
#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
368
4477
#if defined(NEED_newCONSTSUB)
4478
static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
371
extern void newCONSTSUB(HV *stash, char *name, SV *sv);
4481
extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
4487
#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
4488
#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
374
4490
#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
4492
/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
4493
/* (There's no PL_parser in perl < 5.005, so this is completely safe) */
4494
#define D_PPP_PL_copline PL_copline
376
newCONSTSUB(stash, name, sv)
4497
DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
381
U32 oldhints = PL_hints;
382
HV *old_cop_stash = PL_curcop->cop_stash;
383
HV *old_curstash = PL_curstash;
384
line_t oldline = PL_curcop->cop_line;
386
PL_curcop->cop_line = PL_copline;
4499
U32 oldhints = PL_hints;
4500
HV *old_cop_stash = PL_curcop->cop_stash;
4501
HV *old_curstash = PL_curstash;
4502
line_t oldline = PL_curcop->cop_line;
4503
PL_curcop->cop_line = D_PPP_PL_copline;
388
4505
PL_hints &= ~HINT_BLOCK_SCOPE;
500
4625
#define aMY_CXT_
501
4626
#define _aMY_CXT
503
#endif /* START_MY_CXT */
4628
#endif /* START_MY_CXT */
4630
#ifndef MY_CXT_CLONE
4631
#define MY_CXT_CLONE NOOP
506
#if IVSIZE == LONGSIZE
513
#if IVSIZE == INTSIZE
4637
# if IVSIZE == LONGSIZE
4644
# if IVSIZE == INTSIZE
524
#if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
525
defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
526
#define NVef PERL_PRIeldbl
527
#define NVff PERL_PRIfldbl
528
#define NVgf PERL_PRIgldbl
536
#ifndef AvFILLp /* Older perls (<=5.003) lack AvFILLp */
537
#define AvFILLp AvFILL
4655
# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
4656
defined(PERL_PRIfldbl) && (PERL_BCDVERSION != 0x5006000)
4657
/* Not very likely, but let's try anyway. */
4658
# define NVef PERL_PRIeldbl
4659
# define NVff PERL_PRIfldbl
4660
# define NVgf PERL_PRIgldbl
4668
#ifndef SvREFCNT_inc
4669
# ifdef PERL_USE_GCC_BRACE_GROUPS
4670
# define SvREFCNT_inc(sv) \
4672
SV * const _sv = (SV*)(sv); \
4674
(SvREFCNT(_sv))++; \
4678
# define SvREFCNT_inc(sv) \
4679
((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
4683
#ifndef SvREFCNT_inc_simple
4684
# ifdef PERL_USE_GCC_BRACE_GROUPS
4685
# define SvREFCNT_inc_simple(sv) \
4692
# define SvREFCNT_inc_simple(sv) \
4693
((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
4697
#ifndef SvREFCNT_inc_NN
4698
# ifdef PERL_USE_GCC_BRACE_GROUPS
4699
# define SvREFCNT_inc_NN(sv) \
4701
SV * const _sv = (SV*)(sv); \
4706
# define SvREFCNT_inc_NN(sv) \
4707
(PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
4711
#ifndef SvREFCNT_inc_void
4712
# ifdef PERL_USE_GCC_BRACE_GROUPS
4713
# define SvREFCNT_inc_void(sv) \
4715
SV * const _sv = (SV*)(sv); \
4717
(void)(SvREFCNT(_sv)++); \
4720
# define SvREFCNT_inc_void(sv) \
4721
(void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
4724
#ifndef SvREFCNT_inc_simple_void
4725
# define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
4728
#ifndef SvREFCNT_inc_simple_NN
4729
# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
4732
#ifndef SvREFCNT_inc_void_NN
4733
# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
4736
#ifndef SvREFCNT_inc_simple_void_NN
4737
# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
4742
#if defined(NEED_newSV_type)
4743
static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
4746
extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
4752
#define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
4753
#define Perl_newSV_type DPPP_(my_newSV_type)
4755
#if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
4758
DPPP_(my_newSV_type)(pTHX_ svtype const t)
4760
SV* const sv = newSV(0);
4769
#if (PERL_BCDVERSION < 0x5006000)
4770
# define D_PPP_CONSTPV_ARG(x) ((char *) (x))
4772
# define D_PPP_CONSTPV_ARG(x) (x)
4775
# define newSVpvn(data,len) ((data) \
4776
? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
4779
#ifndef newSVpvn_utf8
4780
# define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
4786
#ifndef newSVpvn_flags
4788
#if defined(NEED_newSVpvn_flags)
4789
static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
4792
extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
4795
#ifdef newSVpvn_flags
4796
# undef newSVpvn_flags
4798
#define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
4799
#define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
4801
#if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
4804
DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
4806
SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
4807
SvFLAGS(sv) |= (flags & SVf_UTF8);
4808
return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
4815
/* Backwards compatibility stuff... :-( */
4816
#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
4817
# define NEED_sv_2pv_flags
4819
#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
4820
# define NEED_sv_2pv_flags_GLOBAL
4823
/* Hint: sv_2pv_nolen
4824
* Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
4826
#ifndef sv_2pv_nolen
4827
# define sv_2pv_nolen(sv) SvPV_nolen(sv)
541
#if PERL_REVISION == 5 && PERL_VERSION < 7
542
/* SvPVbyte does not work in perl-5.6.1, borrowed version for 5.7.3 */
4833
* Does not work in perl-5.6.1, ppport.h implements a version
4834
* borrowed from perl-5.7.3.
4837
#if (PERL_BCDVERSION < 0x5007000)
4839
#if defined(NEED_sv_2pvbyte)
4840
static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
4843
extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
4849
#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
4850
#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
4852
#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
4855
DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
4857
sv_utf8_downgrade(sv,0);
4858
return SvPV(sv,*lp);
4864
* Use the SvPVbyte() macro instead of sv_2pvbyte().
544
#define SvPVbyte(sv, lp) \
545
((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
546
? ((lp = SvCUR(sv)), SvPVX(sv)) : my_sv_2pvbyte(aTHX_ sv, &lp))
548
my_sv_2pvbyte(pTHX_ register SV *sv, STRLEN *lp)
550
sv_utf8_downgrade(sv, 0);
551
return SvPV(sv, *lp);
555
#define SvPVbyte SvPV
4869
#define SvPVbyte(sv, lp) \
4870
((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
4871
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
4877
# define SvPVbyte SvPV
4878
# define sv_2pvbyte sv_2pv
4881
#ifndef sv_2pvbyte_nolen
4882
# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
4886
* Always use the SvPV() macro instead of sv_pvn().
4889
/* Hint: sv_pvn_force
4890
* Always use the SvPV_force() macro instead of sv_pvn_force().
4893
/* If these are undefined, they're not handled by the core anyway */
4894
#ifndef SV_IMMEDIATE_UNREF
4895
# define SV_IMMEDIATE_UNREF 0
4899
# define SV_GMAGIC 0
4902
#ifndef SV_COW_DROP_PV
4903
# define SV_COW_DROP_PV 0
4906
#ifndef SV_UTF8_NO_ENCODING
4907
# define SV_UTF8_NO_ENCODING 0
4911
# define SV_NOSTEAL 0
4914
#ifndef SV_CONST_RETURN
4915
# define SV_CONST_RETURN 0
4918
#ifndef SV_MUTABLE_RETURN
4919
# define SV_MUTABLE_RETURN 0
4923
# define SV_SMAGIC 0
4926
#ifndef SV_HAS_TRAILING_NUL
4927
# define SV_HAS_TRAILING_NUL 0
4930
#ifndef SV_COW_SHARED_HASH_KEYS
4931
# define SV_COW_SHARED_HASH_KEYS 0
4934
#if (PERL_BCDVERSION < 0x5007002)
4936
#if defined(NEED_sv_2pv_flags)
4937
static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
4940
extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
4944
# undef sv_2pv_flags
4946
#define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
4947
#define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
4949
#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
4952
DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
4954
STRLEN n_a = (STRLEN) flags;
4955
return sv_2pv(sv, lp ? lp : &n_a);
4960
#if defined(NEED_sv_pvn_force_flags)
4961
static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
4964
extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
4967
#ifdef sv_pvn_force_flags
4968
# undef sv_pvn_force_flags
4970
#define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
4971
#define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
4973
#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
4976
DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
4978
STRLEN n_a = (STRLEN) flags;
4979
return sv_pvn_force(sv, lp ? lp : &n_a);
4986
#if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
4987
# define DPPP_SVPV_NOLEN_LP_ARG &PL_na
4989
# define DPPP_SVPV_NOLEN_LP_ARG 0
4992
# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
4995
#ifndef SvPV_mutable
4996
# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
4999
# define SvPV_flags(sv, lp, flags) \
5000
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5001
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
5003
#ifndef SvPV_flags_const
5004
# define SvPV_flags_const(sv, lp, flags) \
5005
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5006
? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
5007
(const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
5009
#ifndef SvPV_flags_const_nolen
5010
# define SvPV_flags_const_nolen(sv, flags) \
5011
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5012
? SvPVX_const(sv) : \
5013
(const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
5015
#ifndef SvPV_flags_mutable
5016
# define SvPV_flags_mutable(sv, lp, flags) \
5017
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5018
? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
5019
sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
5022
# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
5025
#ifndef SvPV_force_nolen
5026
# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
5029
#ifndef SvPV_force_mutable
5030
# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
5033
#ifndef SvPV_force_nomg
5034
# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
5037
#ifndef SvPV_force_nomg_nolen
5038
# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
5040
#ifndef SvPV_force_flags
5041
# define SvPV_force_flags(sv, lp, flags) \
5042
((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5043
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
5045
#ifndef SvPV_force_flags_nolen
5046
# define SvPV_force_flags_nolen(sv, flags) \
5047
((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5048
? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
5050
#ifndef SvPV_force_flags_mutable
5051
# define SvPV_force_flags_mutable(sv, lp, flags) \
5052
((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
5053
? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
5054
: sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
558
5056
#ifndef SvPV_nolen
559
#define SvPV_nolen(sv) \
560
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
561
? SvPVX(sv) : sv_2pv_nolen(sv))
563
sv_2pv_nolen(pTHX_ register SV *sv)
567
return sv_2pv(sv, &n_a);
572
#define get_cv(name,create) perl_get_cv(name,create)
576
#define get_sv(name,create) perl_get_sv(name,create)
580
#define get_av(name,create) perl_get_av(name,create)
584
#define get_hv(name,create) perl_get_hv(name,create)
588
#define call_argv perl_call_argv
592
#define call_method perl_call_method
596
#define call_pv perl_call_pv
600
#define call_sv perl_call_sv
604
#define eval_pv perl_eval_pv
608
#define eval_sv perl_eval_sv
611
#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
612
#define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
615
#ifndef PERL_SCAN_SILENT_ILLDIGIT
616
#define PERL_SCAN_SILENT_ILLDIGIT 0x04
619
#ifndef PERL_SCAN_ALLOW_UNDERSCORES
620
#define PERL_SCAN_ALLOW_UNDERSCORES 0x01
623
#ifndef PERL_SCAN_DISALLOW_PREFIX
624
#define PERL_SCAN_DISALLOW_PREFIX 0x02
627
#if (PERL_VERSION > 6) || ((PERL_VERSION == 6) && (PERL_SUBVERSION >= 1))
630
#define I32_CAST (I32*)
636
(PL_curcop == &PL_compiling ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
639
#ifndef IN_LOCALE_RUNTIME
640
#define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
643
#ifndef IN_LOCALE_COMPILETIME
644
#define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
648
#ifndef IS_NUMBER_IN_UV
649
#define IS_NUMBER_IN_UV 0x01
650
#define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
651
#define IS_NUMBER_NOT_INT 0x04
652
#define IS_NUMBER_NEG 0x08
653
#define IS_NUMBER_INFINITY 0x10
654
#define IS_NUMBER_NAN 0x20
5057
# define SvPV_nolen(sv) \
5058
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5059
? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
5061
#ifndef SvPV_nolen_const
5062
# define SvPV_nolen_const(sv) \
5063
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
5064
? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
5067
# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
5070
#ifndef SvPV_nomg_const
5071
# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
5074
#ifndef SvPV_nomg_const_nolen
5075
# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
5078
# define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
5079
SvPV_set((sv), (char *) saferealloc( \
5080
(Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
5084
# define SvMAGIC_set(sv, val) \
5085
STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5086
(((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
5089
#if (PERL_BCDVERSION < 0x5009003)
5091
# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
5094
#ifndef SvPVX_mutable
5095
# define SvPVX_mutable(sv) (0 + SvPVX(sv))
5098
# define SvRV_set(sv, val) \
5099
STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5100
(((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
5105
# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
5108
#ifndef SvPVX_mutable
5109
# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
5112
# define SvRV_set(sv, val) \
5113
STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
5114
((sv)->sv_u.svu_rv = (val)); } STMT_END
5119
# define SvSTASH_set(sv, val) \
5120
STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
5121
(((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
5124
#if (PERL_BCDVERSION < 0x5004000)
5126
# define SvUV_set(sv, val) \
5127
STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5128
(((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
5133
# define SvUV_set(sv, val) \
5134
STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
5135
(((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
5140
#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
5141
#if defined(NEED_vnewSVpvf)
5142
static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
5145
extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
5151
#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
5152
#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
5154
#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
5157
DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
5159
register SV *sv = newSV(0);
5160
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
5167
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
5168
# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5171
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
5172
# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
5175
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
5176
#if defined(NEED_sv_catpvf_mg)
5177
static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5180
extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5183
#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
5185
#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
5188
DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
5191
va_start(args, pat);
5192
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5200
#ifdef PERL_IMPLICIT_CONTEXT
5201
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
5202
#if defined(NEED_sv_catpvf_mg_nocontext)
5203
static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5206
extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5209
#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5210
#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
5212
#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
5215
DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
5219
va_start(args, pat);
5220
sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5229
/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
5230
#ifndef sv_catpvf_mg
5231
# ifdef PERL_IMPLICIT_CONTEXT
5232
# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
5234
# define sv_catpvf_mg Perl_sv_catpvf_mg
5238
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
5239
# define sv_vcatpvf_mg(sv, pat, args) \
5241
sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5246
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
5247
#if defined(NEED_sv_setpvf_mg)
5248
static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5251
extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
5254
#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
5256
#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
5259
DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
5262
va_start(args, pat);
5263
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5271
#ifdef PERL_IMPLICIT_CONTEXT
5272
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
5273
#if defined(NEED_sv_setpvf_mg_nocontext)
5274
static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5277
extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
5280
#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5281
#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
5283
#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
5286
DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
5290
va_start(args, pat);
5291
sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
5300
/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
5301
#ifndef sv_setpvf_mg
5302
# ifdef PERL_IMPLICIT_CONTEXT
5303
# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
5305
# define sv_setpvf_mg Perl_sv_setpvf_mg
5309
#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
5310
# define sv_vsetpvf_mg(sv, pat, args) \
5312
sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
5317
#ifndef newSVpvn_share
5319
#if defined(NEED_newSVpvn_share)
5320
static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
5323
extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
5326
#ifdef newSVpvn_share
5327
# undef newSVpvn_share
5329
#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
5330
#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
5332
#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
5335
DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
5341
PERL_HASH(hash, (char*) src, len);
5342
sv = newSVpvn((char *) src, len);
5343
sv_upgrade(sv, SVt_PVIV);
5353
#ifndef SvSHARED_HASH
5354
# define SvSHARED_HASH(sv) (0 + SvUVX(sv))
5357
# define HvNAME_get(hv) HvNAME(hv)
5359
#ifndef HvNAMELEN_get
5360
# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
5363
# define GvSVn(gv) GvSV(gv)
5366
#ifndef isGV_with_GP
5367
# define isGV_with_GP(gv) isGV(gv)
5373
#ifndef WARN_CLOSURE
5374
# define WARN_CLOSURE 1
5377
#ifndef WARN_DEPRECATED
5378
# define WARN_DEPRECATED 2
5381
#ifndef WARN_EXITING
5382
# define WARN_EXITING 3
5386
# define WARN_GLOB 4
5394
# define WARN_CLOSED 6
5398
# define WARN_EXEC 7
5402
# define WARN_LAYER 8
5405
#ifndef WARN_NEWLINE
5406
# define WARN_NEWLINE 9
5410
# define WARN_PIPE 10
5413
#ifndef WARN_UNOPENED
5414
# define WARN_UNOPENED 11
5418
# define WARN_MISC 12
5421
#ifndef WARN_NUMERIC
5422
# define WARN_NUMERIC 13
5426
# define WARN_ONCE 14
5429
#ifndef WARN_OVERFLOW
5430
# define WARN_OVERFLOW 15
5434
# define WARN_PACK 16
5437
#ifndef WARN_PORTABLE
5438
# define WARN_PORTABLE 17
5441
#ifndef WARN_RECURSION
5442
# define WARN_RECURSION 18
5445
#ifndef WARN_REDEFINE
5446
# define WARN_REDEFINE 19
5450
# define WARN_REGEXP 20
5454
# define WARN_SEVERE 21
5457
#ifndef WARN_DEBUGGING
5458
# define WARN_DEBUGGING 22
5461
#ifndef WARN_INPLACE
5462
# define WARN_INPLACE 23
5465
#ifndef WARN_INTERNAL
5466
# define WARN_INTERNAL 24
5470
# define WARN_MALLOC 25
5474
# define WARN_SIGNAL 26
5478
# define WARN_SUBSTR 27
5482
# define WARN_SYNTAX 28
5485
#ifndef WARN_AMBIGUOUS
5486
# define WARN_AMBIGUOUS 29
5489
#ifndef WARN_BAREWORD
5490
# define WARN_BAREWORD 30
5494
# define WARN_DIGIT 31
5497
#ifndef WARN_PARENTHESIS
5498
# define WARN_PARENTHESIS 32
5501
#ifndef WARN_PRECEDENCE
5502
# define WARN_PRECEDENCE 33
5506
# define WARN_PRINTF 34
5509
#ifndef WARN_PROTOTYPE
5510
# define WARN_PROTOTYPE 35
5517
#ifndef WARN_RESERVED
5518
# define WARN_RESERVED 37
5521
#ifndef WARN_SEMICOLON
5522
# define WARN_SEMICOLON 38
5526
# define WARN_TAINT 39
5529
#ifndef WARN_THREADS
5530
# define WARN_THREADS 40
5533
#ifndef WARN_UNINITIALIZED
5534
# define WARN_UNINITIALIZED 41
5538
# define WARN_UNPACK 42
5542
# define WARN_UNTIE 43
5546
# define WARN_UTF8 44
5550
# define WARN_VOID 45
5553
#ifndef WARN_ASSERTIONS
5554
# define WARN_ASSERTIONS 46
5557
# define packWARN(a) (a)
5562
# define ckWARN(a) (PL_dowarn & G_WARN_ON)
5564
# define ckWARN(a) PL_dowarn
5568
#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
5569
#if defined(NEED_warner)
5570
static void DPPP_(my_warner)(U32 err, const char *pat, ...);
5573
extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
5576
#define Perl_warner DPPP_(my_warner)
5578
#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
5581
DPPP_(my_warner)(U32 err, const char *pat, ...)
5586
PERL_UNUSED_ARG(err);
5588
va_start(args, pat);
5589
sv = vnewSVpvf(pat, &args);
5592
warn("%s", SvPV_nolen(sv));
5595
#define warner Perl_warner
5597
#define Perl_warner_nocontext Perl_warner
5602
/* concatenating with "" ensures that only literal strings are accepted as argument
5603
* note that STR_WITH_LEN() can't be used as argument to macros or functions that
5604
* under some configurations might be macros
5606
#ifndef STR_WITH_LEN
5607
# define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
5610
# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
5613
#ifndef newSVpvs_flags
5614
# define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
5618
# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
5622
# define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
5626
# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
5630
# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
5632
#ifndef gv_fetchpvn_flags
5633
# define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
5637
# define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
5641
# define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
5644
# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
657
5646
#ifndef PERL_MAGIC_sv
658
#define PERL_MAGIC_sv '\0'
5647
# define PERL_MAGIC_sv '\0'
661
5650
#ifndef PERL_MAGIC_overload
662
#define PERL_MAGIC_overload 'A'
5651
# define PERL_MAGIC_overload 'A'
665
5654
#ifndef PERL_MAGIC_overload_elem
666
#define PERL_MAGIC_overload_elem 'a'
5655
# define PERL_MAGIC_overload_elem 'a'
669
5658
#ifndef PERL_MAGIC_overload_table
670
#define PERL_MAGIC_overload_table 'c'
5659
# define PERL_MAGIC_overload_table 'c'
673
5662
#ifndef PERL_MAGIC_bm
674
#define PERL_MAGIC_bm 'B'
5663
# define PERL_MAGIC_bm 'B'
677
5666
#ifndef PERL_MAGIC_regdata
678
#define PERL_MAGIC_regdata 'D'
5667
# define PERL_MAGIC_regdata 'D'
681
5670
#ifndef PERL_MAGIC_regdatum
682
#define PERL_MAGIC_regdatum 'd'
5671
# define PERL_MAGIC_regdatum 'd'
685
5674
#ifndef PERL_MAGIC_env
686
#define PERL_MAGIC_env 'E'
5675
# define PERL_MAGIC_env 'E'
689
5678
#ifndef PERL_MAGIC_envelem
690
#define PERL_MAGIC_envelem 'e'
5679
# define PERL_MAGIC_envelem 'e'
693
5682
#ifndef PERL_MAGIC_fm
694
#define PERL_MAGIC_fm 'f'
5683
# define PERL_MAGIC_fm 'f'
697
5686
#ifndef PERL_MAGIC_regex_global
698
#define PERL_MAGIC_regex_global 'g'
5687
# define PERL_MAGIC_regex_global 'g'
701
5690
#ifndef PERL_MAGIC_isa
702
#define PERL_MAGIC_isa 'I'
5691
# define PERL_MAGIC_isa 'I'
705
5694
#ifndef PERL_MAGIC_isaelem
706
#define PERL_MAGIC_isaelem 'i'
5695
# define PERL_MAGIC_isaelem 'i'
709
5698
#ifndef PERL_MAGIC_nkeys
710
#define PERL_MAGIC_nkeys 'k'
5699
# define PERL_MAGIC_nkeys 'k'
713
5702
#ifndef PERL_MAGIC_dbfile
714
#define PERL_MAGIC_dbfile 'L'
5703
# define PERL_MAGIC_dbfile 'L'
717
5706
#ifndef PERL_MAGIC_dbline
718
#define PERL_MAGIC_dbline 'l'
5707
# define PERL_MAGIC_dbline 'l'
721
5710
#ifndef PERL_MAGIC_mutex
722
#define PERL_MAGIC_mutex 'm'
5711
# define PERL_MAGIC_mutex 'm'
725
5714
#ifndef PERL_MAGIC_shared
726
#define PERL_MAGIC_shared 'N'
5715
# define PERL_MAGIC_shared 'N'
729
5718
#ifndef PERL_MAGIC_shared_scalar
730
#define PERL_MAGIC_shared_scalar 'n'
5719
# define PERL_MAGIC_shared_scalar 'n'
733
5722
#ifndef PERL_MAGIC_collxfrm
734
#define PERL_MAGIC_collxfrm 'o'
5723
# define PERL_MAGIC_collxfrm 'o'
737
5726
#ifndef PERL_MAGIC_tied
738
#define PERL_MAGIC_tied 'P'
5727
# define PERL_MAGIC_tied 'P'
741
5730
#ifndef PERL_MAGIC_tiedelem
742
#define PERL_MAGIC_tiedelem 'p'
5731
# define PERL_MAGIC_tiedelem 'p'
745
5734
#ifndef PERL_MAGIC_tiedscalar
746
#define PERL_MAGIC_tiedscalar 'q'
5735
# define PERL_MAGIC_tiedscalar 'q'
749
5738
#ifndef PERL_MAGIC_qr
750
#define PERL_MAGIC_qr 'r'
5739
# define PERL_MAGIC_qr 'r'
753
5742
#ifndef PERL_MAGIC_sig
754
#define PERL_MAGIC_sig 'S'
5743
# define PERL_MAGIC_sig 'S'
757
5746
#ifndef PERL_MAGIC_sigelem
758
#define PERL_MAGIC_sigelem 's'
5747
# define PERL_MAGIC_sigelem 's'
761
5750
#ifndef PERL_MAGIC_taint
762
#define PERL_MAGIC_taint 't'
5751
# define PERL_MAGIC_taint 't'
765
5754
#ifndef PERL_MAGIC_uvar
766
#define PERL_MAGIC_uvar 'U'
5755
# define PERL_MAGIC_uvar 'U'
769
5758
#ifndef PERL_MAGIC_uvar_elem
770
#define PERL_MAGIC_uvar_elem 'u'
5759
# define PERL_MAGIC_uvar_elem 'u'
773
5762
#ifndef PERL_MAGIC_vstring
774
#define PERL_MAGIC_vstring 'V'
5763
# define PERL_MAGIC_vstring 'V'
777
5766
#ifndef PERL_MAGIC_vec
778
#define PERL_MAGIC_vec 'v'
5767
# define PERL_MAGIC_vec 'v'
781
5770
#ifndef PERL_MAGIC_utf8
782
#define PERL_MAGIC_utf8 'w'
5771
# define PERL_MAGIC_utf8 'w'
785
5774
#ifndef PERL_MAGIC_substr
786
#define PERL_MAGIC_substr 'x'
5775
# define PERL_MAGIC_substr 'x'
789
5778
#ifndef PERL_MAGIC_defelem
790
#define PERL_MAGIC_defelem 'y'
5779
# define PERL_MAGIC_defelem 'y'
793
5782
#ifndef PERL_MAGIC_glob
794
#define PERL_MAGIC_glob '*'
5783
# define PERL_MAGIC_glob '*'
797
5786
#ifndef PERL_MAGIC_arylen
798
#define PERL_MAGIC_arylen '#'
5787
# define PERL_MAGIC_arylen '#'
801
5790
#ifndef PERL_MAGIC_pos
802
#define PERL_MAGIC_pos '.'
5791
# define PERL_MAGIC_pos '.'
805
5794
#ifndef PERL_MAGIC_backref
806
#define PERL_MAGIC_backref '<'
5795
# define PERL_MAGIC_backref '<'
809
5798
#ifndef PERL_MAGIC_ext
810
#define PERL_MAGIC_ext '~'
812
#endif /* _P_P_PORTABILITY_H_ */
5799
# define PERL_MAGIC_ext '~'
5802
/* That's the best we can do... */
5803
#ifndef sv_catpvn_nomg
5804
# define sv_catpvn_nomg sv_catpvn
5807
#ifndef sv_catsv_nomg
5808
# define sv_catsv_nomg sv_catsv
5811
#ifndef sv_setsv_nomg
5812
# define sv_setsv_nomg sv_setsv
5816
# define sv_pvn_nomg sv_pvn
5820
# define SvIV_nomg SvIV
5824
# define SvUV_nomg SvUV
5828
# define sv_catpv_mg(sv, ptr) \
5831
sv_catpv(TeMpSv,ptr); \
5832
SvSETMAGIC(TeMpSv); \
5836
#ifndef sv_catpvn_mg
5837
# define sv_catpvn_mg(sv, ptr, len) \
5840
sv_catpvn(TeMpSv,ptr,len); \
5841
SvSETMAGIC(TeMpSv); \
5846
# define sv_catsv_mg(dsv, ssv) \
5849
sv_catsv(TeMpSv,ssv); \
5850
SvSETMAGIC(TeMpSv); \
5855
# define sv_setiv_mg(sv, i) \
5858
sv_setiv(TeMpSv,i); \
5859
SvSETMAGIC(TeMpSv); \
5864
# define sv_setnv_mg(sv, num) \
5867
sv_setnv(TeMpSv,num); \
5868
SvSETMAGIC(TeMpSv); \
5873
# define sv_setpv_mg(sv, ptr) \
5876
sv_setpv(TeMpSv,ptr); \
5877
SvSETMAGIC(TeMpSv); \
5881
#ifndef sv_setpvn_mg
5882
# define sv_setpvn_mg(sv, ptr, len) \
5885
sv_setpvn(TeMpSv,ptr,len); \
5886
SvSETMAGIC(TeMpSv); \
5891
# define sv_setsv_mg(dsv, ssv) \
5894
sv_setsv(TeMpSv,ssv); \
5895
SvSETMAGIC(TeMpSv); \
5900
# define sv_setuv_mg(sv, i) \
5903
sv_setuv(TeMpSv,i); \
5904
SvSETMAGIC(TeMpSv); \
5908
#ifndef sv_usepvn_mg
5909
# define sv_usepvn_mg(sv, ptr, len) \
5912
sv_usepvn(TeMpSv,ptr,len); \
5913
SvSETMAGIC(TeMpSv); \
5916
#ifndef SvVSTRING_mg
5917
# define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
5920
/* Hint: sv_magic_portable
5921
* This is a compatibility function that is only available with
5922
* Devel::PPPort. It is NOT in the perl core.
5923
* Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
5924
* it is being passed a name pointer with namlen == 0. In that
5925
* case, perl 5.8.0 and later store the pointer, not a copy of it.
5926
* The compatibility can be provided back to perl 5.004. With
5927
* earlier versions, the code will not compile.
5930
#if (PERL_BCDVERSION < 0x5004000)
5932
/* code that uses sv_magic_portable will not compile */
5934
#elif (PERL_BCDVERSION < 0x5008000)
5936
# define sv_magic_portable(sv, obj, how, name, namlen) \
5938
SV *SvMp_sv = (sv); \
5939
char *SvMp_name = (char *) (name); \
5940
I32 SvMp_namlen = (namlen); \
5941
if (SvMp_name && SvMp_namlen == 0) \
5944
sv_magic(SvMp_sv, obj, how, 0, 0); \
5945
mg = SvMAGIC(SvMp_sv); \
5946
mg->mg_len = -42; /* XXX: this is the tricky part */ \
5947
mg->mg_ptr = SvMp_name; \
5951
sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
5957
# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
5963
# define CopFILE(c) ((c)->cop_file)
5967
# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
5971
# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
5975
# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
5979
# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
5983
# define CopSTASHPV(c) ((c)->cop_stashpv)
5986
#ifndef CopSTASHPV_set
5987
# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
5991
# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
5994
#ifndef CopSTASH_set
5995
# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
5999
# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
6000
|| (CopSTASHPV(c) && HvNAME(hv) \
6001
&& strEQ(CopSTASHPV(c), HvNAME(hv)))))
6006
# define CopFILEGV(c) ((c)->cop_filegv)
6009
#ifndef CopFILEGV_set
6010
# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
6014
# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
6018
# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
6022
# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
6026
# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
6030
# define CopSTASH(c) ((c)->cop_stash)
6033
#ifndef CopSTASH_set
6034
# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
6038
# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
6041
#ifndef CopSTASHPV_set
6042
# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
6046
# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
6049
#endif /* USE_ITHREADS */
6050
#ifndef IN_PERL_COMPILETIME
6051
# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
6054
#ifndef IN_LOCALE_RUNTIME
6055
# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
6058
#ifndef IN_LOCALE_COMPILETIME
6059
# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
6063
# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
6065
#ifndef IS_NUMBER_IN_UV
6066
# define IS_NUMBER_IN_UV 0x01
6069
#ifndef IS_NUMBER_GREATER_THAN_UV_MAX
6070
# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
6073
#ifndef IS_NUMBER_NOT_INT
6074
# define IS_NUMBER_NOT_INT 0x04
6077
#ifndef IS_NUMBER_NEG
6078
# define IS_NUMBER_NEG 0x08
6081
#ifndef IS_NUMBER_INFINITY
6082
# define IS_NUMBER_INFINITY 0x10
6085
#ifndef IS_NUMBER_NAN
6086
# define IS_NUMBER_NAN 0x20
6088
#ifndef GROK_NUMERIC_RADIX
6089
# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
6091
#ifndef PERL_SCAN_GREATER_THAN_UV_MAX
6092
# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
6095
#ifndef PERL_SCAN_SILENT_ILLDIGIT
6096
# define PERL_SCAN_SILENT_ILLDIGIT 0x04
6099
#ifndef PERL_SCAN_ALLOW_UNDERSCORES
6100
# define PERL_SCAN_ALLOW_UNDERSCORES 0x01
6103
#ifndef PERL_SCAN_DISALLOW_PREFIX
6104
# define PERL_SCAN_DISALLOW_PREFIX 0x02
6107
#ifndef grok_numeric_radix
6108
#if defined(NEED_grok_numeric_radix)
6109
static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6112
extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
6115
#ifdef grok_numeric_radix
6116
# undef grok_numeric_radix
6118
#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
6119
#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
6121
#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
6123
DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
6125
#ifdef USE_LOCALE_NUMERIC
6126
#ifdef PL_numeric_radix_sv
6127
if (PL_numeric_radix_sv && IN_LOCALE) {
6129
char* radix = SvPV(PL_numeric_radix_sv, len);
6130
if (*sp + len <= send && memEQ(*sp, radix, len)) {
6136
/* older perls don't have PL_numeric_radix_sv so the radix
6137
* must manually be requested from locale.h
6140
dTHR; /* needed for older threaded perls */
6141
struct lconv *lc = localeconv();
6142
char *radix = lc->decimal_point;
6143
if (radix && IN_LOCALE) {
6144
STRLEN len = strlen(radix);
6145
if (*sp + len <= send && memEQ(*sp, radix, len)) {
6151
#endif /* USE_LOCALE_NUMERIC */
6152
/* always try "." if numeric radix didn't match because
6153
* we may have data from different locales mixed */
6154
if (*sp < send && **sp == '.') {
6164
#if defined(NEED_grok_number)
6165
static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6168
extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
6174
#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
6175
#define Perl_grok_number DPPP_(my_grok_number)
6177
#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
6179
DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
6182
const char *send = pv + len;
6183
const UV max_div_10 = UV_MAX / 10;
6184
const char max_mod_10 = UV_MAX % 10;
6189
while (s < send && isSPACE(*s))
6193
} else if (*s == '-') {
6195
numtype = IS_NUMBER_NEG;
6203
/* next must be digit or the radix separator or beginning of infinity */
6205
/* UVs are at least 32 bits, so the first 9 decimal digits cannot
6207
UV value = *s - '0';
6208
/* This construction seems to be more optimiser friendly.
6209
(without it gcc does the isDIGIT test and the *s - '0' separately)
6210
With it gcc on arm is managing 6 instructions (6 cycles) per digit.
6211
In theory the optimiser could deduce how far to unroll the loop
6212
before checking for overflow. */
6214
int digit = *s - '0';
6215
if (digit >= 0 && digit <= 9) {
6216
value = value * 10 + digit;
6219
if (digit >= 0 && digit <= 9) {
6220
value = value * 10 + digit;
6223
if (digit >= 0 && digit <= 9) {
6224
value = value * 10 + digit;
6227
if (digit >= 0 && digit <= 9) {
6228
value = value * 10 + digit;
6231
if (digit >= 0 && digit <= 9) {
6232
value = value * 10 + digit;
6235
if (digit >= 0 && digit <= 9) {
6236
value = value * 10 + digit;
6239
if (digit >= 0 && digit <= 9) {
6240
value = value * 10 + digit;
6243
if (digit >= 0 && digit <= 9) {
6244
value = value * 10 + digit;
6246
/* Now got 9 digits, so need to check
6247
each time for overflow. */
6249
while (digit >= 0 && digit <= 9
6250
&& (value < max_div_10
6251
|| (value == max_div_10
6252
&& digit <= max_mod_10))) {
6253
value = value * 10 + digit;
6259
if (digit >= 0 && digit <= 9
6261
/* value overflowed.
6262
skip the remaining digits, don't
6263
worry about setting *valuep. */
6266
} while (s < send && isDIGIT(*s));
6268
IS_NUMBER_GREATER_THAN_UV_MAX;
6288
numtype |= IS_NUMBER_IN_UV;
6293
if (GROK_NUMERIC_RADIX(&s, send)) {
6294
numtype |= IS_NUMBER_NOT_INT;
6295
while (s < send && isDIGIT(*s)) /* optional digits after the radix */
6299
else if (GROK_NUMERIC_RADIX(&s, send)) {
6300
numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
6301
/* no digits before the radix means we need digits after it */
6302
if (s < send && isDIGIT(*s)) {
6305
} while (s < send && isDIGIT(*s));
6307
/* integer approximation is valid - it's 0. */
6313
} else if (*s == 'I' || *s == 'i') {
6314
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6315
s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
6316
s++; if (s < send && (*s == 'I' || *s == 'i')) {
6317
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6318
s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
6319
s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
6320
s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
6324
} else if (*s == 'N' || *s == 'n') {
6325
/* XXX TODO: There are signaling NaNs and quiet NaNs. */
6326
s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
6327
s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
6334
numtype &= IS_NUMBER_NEG; /* Keep track of sign */
6335
numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
6336
} else if (sawnan) {
6337
numtype &= IS_NUMBER_NEG; /* Keep track of sign */
6338
numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
6339
} else if (s < send) {
6340
/* we can have an optional exponent part */
6341
if (*s == 'e' || *s == 'E') {
6342
/* The only flag we keep is sign. Blow away any "it's UV" */
6343
numtype &= IS_NUMBER_NEG;
6344
numtype |= IS_NUMBER_NOT_INT;
6346
if (s < send && (*s == '-' || *s == '+'))
6348
if (s < send && isDIGIT(*s)) {
6351
} while (s < send && isDIGIT(*s));
6357
while (s < send && isSPACE(*s))
6361
if (len == 10 && memEQ(pv, "0 but true", 10)) {
6364
return IS_NUMBER_IN_UV;
6372
* The grok_* routines have been modified to use warn() instead of
6373
* Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
6374
* which is why the stack variable has been renamed to 'xdigit'.
6378
#if defined(NEED_grok_bin)
6379
static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6382
extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6388
#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
6389
#define Perl_grok_bin DPPP_(my_grok_bin)
6391
#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
6393
DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6395
const char *s = start;
6396
STRLEN len = *len_p;
6400
const UV max_div_2 = UV_MAX / 2;
6401
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6402
bool overflowed = FALSE;
6404
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6405
/* strip off leading b or 0b.
6406
for compatibility silently suffer "b" and "0b" as valid binary
6413
else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
6420
for (; len-- && *s; s++) {
6422
if (bit == '0' || bit == '1') {
6423
/* Write it in this wonky order with a goto to attempt to get the
6424
compiler to make the common case integer-only loop pretty tight.
6425
With gcc seems to be much straighter code than old scan_bin. */
6428
if (value <= max_div_2) {
6429
value = (value << 1) | (bit - '0');
6432
/* Bah. We're just overflowed. */
6433
warn("Integer overflow in binary number");
6435
value_nv = (NV) value;
6438
/* If an NV has not enough bits in its mantissa to
6439
* represent a UV this summing of small low-order numbers
6440
* is a waste of time (because the NV cannot preserve
6441
* the low-order bits anyway): we could just remember when
6442
* did we overflow and in the end just multiply value_nv by the
6444
value_nv += (NV)(bit - '0');
6447
if (bit == '_' && len && allow_underscores && (bit = s[1])
6448
&& (bit == '0' || bit == '1'))
6454
if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6455
warn("Illegal binary digit '%c' ignored", *s);
6459
if ( ( overflowed && value_nv > 4294967295.0)
6461
|| (!overflowed && value > 0xffffffff )
6464
warn("Binary number > 0b11111111111111111111111111111111 non-portable");
6471
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6480
#if defined(NEED_grok_hex)
6481
static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6484
extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6490
#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
6491
#define Perl_grok_hex DPPP_(my_grok_hex)
6493
#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
6495
DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6497
const char *s = start;
6498
STRLEN len = *len_p;
6502
const UV max_div_16 = UV_MAX / 16;
6503
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6504
bool overflowed = FALSE;
6507
if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6508
/* strip off leading x or 0x.
6509
for compatibility silently suffer "x" and "0x" as valid hex numbers.
6516
else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
6523
for (; len-- && *s; s++) {
6524
xdigit = strchr((char *) PL_hexdigit, *s);
6526
/* Write it in this wonky order with a goto to attempt to get the
6527
compiler to make the common case integer-only loop pretty tight.
6528
With gcc seems to be much straighter code than old scan_hex. */
6531
if (value <= max_div_16) {
6532
value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
6535
warn("Integer overflow in hexadecimal number");
6537
value_nv = (NV) value;
6540
/* If an NV has not enough bits in its mantissa to
6541
* represent a UV this summing of small low-order numbers
6542
* is a waste of time (because the NV cannot preserve
6543
* the low-order bits anyway): we could just remember when
6544
* did we overflow and in the end just multiply value_nv by the
6545
* right amount of 16-tuples. */
6546
value_nv += (NV)((xdigit - PL_hexdigit) & 15);
6549
if (*s == '_' && len && allow_underscores && s[1]
6550
&& (xdigit = strchr((char *) PL_hexdigit, s[1])))
6556
if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6557
warn("Illegal hexadecimal digit '%c' ignored", *s);
6561
if ( ( overflowed && value_nv > 4294967295.0)
6563
|| (!overflowed && value > 0xffffffff )
6566
warn("Hexadecimal number > 0xffffffff non-portable");
6573
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6582
#if defined(NEED_grok_oct)
6583
static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6586
extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6592
#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
6593
#define Perl_grok_oct DPPP_(my_grok_oct)
6595
#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
6597
DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6599
const char *s = start;
6600
STRLEN len = *len_p;
6604
const UV max_div_8 = UV_MAX / 8;
6605
bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6606
bool overflowed = FALSE;
6608
for (; len-- && *s; s++) {
6609
/* gcc 2.95 optimiser not smart enough to figure that this subtraction
6610
out front allows slicker code. */
6611
int digit = *s - '0';
6612
if (digit >= 0 && digit <= 7) {
6613
/* Write it in this wonky order with a goto to attempt to get the
6614
compiler to make the common case integer-only loop pretty tight.
6618
if (value <= max_div_8) {
6619
value = (value << 3) | digit;
6622
/* Bah. We're just overflowed. */
6623
warn("Integer overflow in octal number");
6625
value_nv = (NV) value;
6628
/* If an NV has not enough bits in its mantissa to
6629
* represent a UV this summing of small low-order numbers
6630
* is a waste of time (because the NV cannot preserve
6631
* the low-order bits anyway): we could just remember when
6632
* did we overflow and in the end just multiply value_nv by the
6633
* right amount of 8-tuples. */
6634
value_nv += (NV)digit;
6637
if (digit == ('_' - '0') && len && allow_underscores
6638
&& (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
6644
/* Allow \octal to work the DWIM way (that is, stop scanning
6645
* as soon as non-octal characters are seen, complain only iff
6646
* someone seems to want to use the digits eight and nine). */
6647
if (digit == 8 || digit == 9) {
6648
if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6649
warn("Illegal octal digit '%c' ignored", *s);
6654
if ( ( overflowed && value_nv > 4294967295.0)
6656
|| (!overflowed && value > 0xffffffff )
6659
warn("Octal number > 037777777777 non-portable");
6666
*flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6674
#if !defined(my_snprintf)
6675
#if defined(NEED_my_snprintf)
6676
static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6679
extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6682
#define my_snprintf DPPP_(my_my_snprintf)
6683
#define Perl_my_snprintf DPPP_(my_my_snprintf)
6685
#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
6688
DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
6693
va_start(ap, format);
6694
#ifdef HAS_VSNPRINTF
6695
retval = vsnprintf(buffer, len, format, ap);
6697
retval = vsprintf(buffer, format, ap);
6700
if (retval < 0 || (len > 0 && (Size_t)retval >= len))
6701
Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
6708
#if !defined(my_sprintf)
6709
#if defined(NEED_my_sprintf)
6710
static int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
6713
extern int DPPP_(my_my_sprintf)(char * buffer, const char * pat, ...);
6716
#define my_sprintf DPPP_(my_my_sprintf)
6717
#define Perl_my_sprintf DPPP_(my_my_sprintf)
6719
#if defined(NEED_my_sprintf) || defined(NEED_my_sprintf_GLOBAL)
6722
DPPP_(my_my_sprintf)(char *buffer, const char* pat, ...)
6725
va_start(args, pat);
6726
vsprintf(buffer, pat, args);
6728
return strlen(buffer);
6736
# define dXCPT dJMPENV; int rEtV = 0
6737
# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
6738
# define XCPT_TRY_END JMPENV_POP;
6739
# define XCPT_CATCH if (rEtV != 0)
6740
# define XCPT_RETHROW JMPENV_JUMP(rEtV)
6742
# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
6743
# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
6744
# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
6745
# define XCPT_CATCH if (rEtV != 0)
6746
# define XCPT_RETHROW Siglongjmp(top_env, rEtV)
6750
#if !defined(my_strlcat)
6751
#if defined(NEED_my_strlcat)
6752
static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
6755
extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
6758
#define my_strlcat DPPP_(my_my_strlcat)
6759
#define Perl_my_strlcat DPPP_(my_my_strlcat)
6761
#if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
6764
DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
6766
Size_t used, length, copy;
6769
length = strlen(src);
6770
if (size > 0 && used < size - 1) {
6771
copy = (length >= size - used) ? size - used - 1 : length;
6772
memcpy(dst + used, src, copy);
6773
dst[used + copy] = '\0';
6775
return used + length;
6780
#if !defined(my_strlcpy)
6781
#if defined(NEED_my_strlcpy)
6782
static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
6785
extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
6788
#define my_strlcpy DPPP_(my_my_strlcpy)
6789
#define Perl_my_strlcpy DPPP_(my_my_strlcpy)
6791
#if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
6794
DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
6796
Size_t length, copy;
6798
length = strlen(src);
6800
copy = (length >= size) ? size - 1 : length;
6801
memcpy(dst, src, copy);
6809
#ifndef PERL_PV_ESCAPE_QUOTE
6810
# define PERL_PV_ESCAPE_QUOTE 0x0001
6813
#ifndef PERL_PV_PRETTY_QUOTE
6814
# define PERL_PV_PRETTY_QUOTE PERL_PV_ESCAPE_QUOTE
6817
#ifndef PERL_PV_PRETTY_ELLIPSES
6818
# define PERL_PV_PRETTY_ELLIPSES 0x0002
6821
#ifndef PERL_PV_PRETTY_LTGT
6822
# define PERL_PV_PRETTY_LTGT 0x0004
6825
#ifndef PERL_PV_ESCAPE_FIRSTCHAR
6826
# define PERL_PV_ESCAPE_FIRSTCHAR 0x0008
6829
#ifndef PERL_PV_ESCAPE_UNI
6830
# define PERL_PV_ESCAPE_UNI 0x0100
6833
#ifndef PERL_PV_ESCAPE_UNI_DETECT
6834
# define PERL_PV_ESCAPE_UNI_DETECT 0x0200
6837
#ifndef PERL_PV_ESCAPE_ALL
6838
# define PERL_PV_ESCAPE_ALL 0x1000
6841
#ifndef PERL_PV_ESCAPE_NOBACKSLASH
6842
# define PERL_PV_ESCAPE_NOBACKSLASH 0x2000
6845
#ifndef PERL_PV_ESCAPE_NOCLEAR
6846
# define PERL_PV_ESCAPE_NOCLEAR 0x4000
6849
#ifndef PERL_PV_ESCAPE_RE
6850
# define PERL_PV_ESCAPE_RE 0x8000
6853
#ifndef PERL_PV_PRETTY_NOCLEAR
6854
# define PERL_PV_PRETTY_NOCLEAR PERL_PV_ESCAPE_NOCLEAR
6856
#ifndef PERL_PV_PRETTY_DUMP
6857
# define PERL_PV_PRETTY_DUMP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_QUOTE
6860
#ifndef PERL_PV_PRETTY_REGPROP
6861
# define PERL_PV_PRETTY_REGPROP PERL_PV_PRETTY_ELLIPSES|PERL_PV_PRETTY_LTGT|PERL_PV_ESCAPE_RE
6865
* Note that unicode functionality is only backported to
6866
* those perl versions that support it. For older perl
6867
* versions, the implementation will fall back to bytes.
6871
#if defined(NEED_pv_escape)
6872
static char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
6875
extern char * DPPP_(my_pv_escape)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, STRLEN * const escaped, const U32 flags);
6881
#define pv_escape(a,b,c,d,e,f) DPPP_(my_pv_escape)(aTHX_ a,b,c,d,e,f)
6882
#define Perl_pv_escape DPPP_(my_pv_escape)
6884
#if defined(NEED_pv_escape) || defined(NEED_pv_escape_GLOBAL)
6887
DPPP_(my_pv_escape)(pTHX_ SV *dsv, char const * const str,
6888
const STRLEN count, const STRLEN max,
6889
STRLEN * const escaped, const U32 flags)
6891
const char esc = flags & PERL_PV_ESCAPE_RE ? '%' : '\\';
6892
const char dq = flags & PERL_PV_ESCAPE_QUOTE ? '"' : esc;
6893
char octbuf[32] = "%123456789ABCDF";
6896
STRLEN readsize = 1;
6897
#if defined(is_utf8_string) && defined(utf8_to_uvchr)
6898
bool isuni = flags & PERL_PV_ESCAPE_UNI ? 1 : 0;
6900
const char *pv = str;
6901
const char * const end = pv + count;
6904
if (!(flags & PERL_PV_ESCAPE_NOCLEAR))
6907
#if defined(is_utf8_string) && defined(utf8_to_uvchr)
6908
if ((flags & PERL_PV_ESCAPE_UNI_DETECT) && is_utf8_string((U8*)pv, count))
6912
for (; pv < end && (!max || wrote < max) ; pv += readsize) {
6914
#if defined(is_utf8_string) && defined(utf8_to_uvchr)
6915
isuni ? utf8_to_uvchr((U8*)pv, &readsize) :
6918
const U8 c = (U8)u & 0xFF;
6920
if (u > 255 || (flags & PERL_PV_ESCAPE_ALL)) {
6921
if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
6922
chsize = my_snprintf(octbuf, sizeof octbuf,
6925
chsize = my_snprintf(octbuf, sizeof octbuf,
6926
"%cx{%"UVxf"}", esc, u);
6927
} else if (flags & PERL_PV_ESCAPE_NOBACKSLASH) {
6930
if (c == dq || c == esc || !isPRINT(c)) {
6933
case '\\' : /* fallthrough */
6934
case '%' : if (c == esc)
6939
case '\v' : octbuf[1] = 'v'; break;
6940
case '\t' : octbuf[1] = 't'; break;
6941
case '\r' : octbuf[1] = 'r'; break;
6942
case '\n' : octbuf[1] = 'n'; break;
6943
case '\f' : octbuf[1] = 'f'; break;
6944
case '"' : if (dq == '"')
6949
default: chsize = my_snprintf(octbuf, sizeof octbuf,
6950
pv < end && isDIGIT((U8)*(pv+readsize))
6951
? "%c%03o" : "%c%o", esc, c);
6957
if (max && wrote + chsize > max) {
6959
} else if (chsize > 1) {
6960
sv_catpvn(dsv, octbuf, chsize);
6964
my_snprintf(tmp, sizeof tmp, "%c", c);
6965
sv_catpvn(dsv, tmp, 1);
6968
if (flags & PERL_PV_ESCAPE_FIRSTCHAR)
6971
if (escaped != NULL)
6980
#if defined(NEED_pv_pretty)
6981
static char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
6984
extern char * DPPP_(my_pv_pretty)(pTHX_ SV * dsv, char const * const str, const STRLEN count, const STRLEN max, char const * const start_color, char const * const end_color, const U32 flags);
6990
#define pv_pretty(a,b,c,d,e,f,g) DPPP_(my_pv_pretty)(aTHX_ a,b,c,d,e,f,g)
6991
#define Perl_pv_pretty DPPP_(my_pv_pretty)
6993
#if defined(NEED_pv_pretty) || defined(NEED_pv_pretty_GLOBAL)
6996
DPPP_(my_pv_pretty)(pTHX_ SV *dsv, char const * const str, const STRLEN count,
6997
const STRLEN max, char const * const start_color, char const * const end_color,
7000
const U8 dq = (flags & PERL_PV_PRETTY_QUOTE) ? '"' : '%';
7003
if (!(flags & PERL_PV_PRETTY_NOCLEAR))
7007
sv_catpvs(dsv, "\"");
7008
else if (flags & PERL_PV_PRETTY_LTGT)
7009
sv_catpvs(dsv, "<");
7011
if (start_color != NULL)
7012
sv_catpv(dsv, D_PPP_CONSTPV_ARG(start_color));
7014
pv_escape(dsv, str, count, max, &escaped, flags | PERL_PV_ESCAPE_NOCLEAR);
7016
if (end_color != NULL)
7017
sv_catpv(dsv, D_PPP_CONSTPV_ARG(end_color));
7020
sv_catpvs(dsv, "\"");
7021
else if (flags & PERL_PV_PRETTY_LTGT)
7022
sv_catpvs(dsv, ">");
7024
if ((flags & PERL_PV_PRETTY_ELLIPSES) && escaped < count)
7025
sv_catpvs(dsv, "...");
7034
#if defined(NEED_pv_display)
7035
static char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
7038
extern char * DPPP_(my_pv_display)(pTHX_ SV * dsv, const char * pv, STRLEN cur, STRLEN len, STRLEN pvlim);
7044
#define pv_display(a,b,c,d,e) DPPP_(my_pv_display)(aTHX_ a,b,c,d,e)
7045
#define Perl_pv_display DPPP_(my_pv_display)
7047
#if defined(NEED_pv_display) || defined(NEED_pv_display_GLOBAL)
7050
DPPP_(my_pv_display)(pTHX_ SV *dsv, const char *pv, STRLEN cur, STRLEN len, STRLEN pvlim)
7052
pv_pretty(dsv, pv, cur, pvlim, NULL, NULL, PERL_PV_PRETTY_DUMP);
7053
if (len > cur && pv[cur] == '\0')
7054
sv_catpvs(dsv, "\\0");
7061
#endif /* _P_P_PORTABILITY_H_ */
814
7063
/* End of File ppport.h */