~peter-pearse/ubuntu/natty/postgresql-8.4/prop001

« back to all changes in this revision

Viewing changes to src/pl/plperl/ppport.h

  • Committer: Bazaar Package Importer
  • Author(s): Martin Pitt
  • Date: 2010-05-15 13:31:46 UTC
  • mfrom: (1.2.4 upstream)
  • Revision ID: james.westby@ubuntu.com-20100515133146-kd8qmfietgxqvam0
Tags: 8.4.4-1
* Urgency medium due to security fixes.
* New upstream security/bug fix release:
  - Enforce restrictions in plperl using an opmask applied to the whole
    interpreter, instead of using "Safe.pm".
    Recent developments have convinced us that "Safe.pm" is too
    insecure to rely on for making plperl trustable. This change
    removes use of "Safe.pm" altogether, in favor of using a separate
    interpreter with an opcode mask that is always applied. Pleasant
    side effects of the change include that it is now possible to use
    Perl's strict pragma in a natural way in plperl, and that Perl's $a
    and $b variables work as expected in sort routines, and that
    function compilation is significantly faster. (CVE-2010-1169)
  - Prevent PL/Tcl from executing untrustworthy code from pltcl_modules.
    PL/Tcl's feature for autoloading Tcl code from a database table
    could be exploited for trojan-horse attacks, because there was no
    restriction on who could create or insert into that table. This
    change disables the feature unless pltcl_modules is owned by a
    superuser. (However, the permissions on the table are not checked,
    so installations that really need a less-than-secure modules table
    can still grant suitable privileges to trusted non-superusers.)
    Also, prevent loading code into the unrestricted "normal" Tcl
    interpreter unless we are really going to execute a pltclu
    function. (CVE-2010-1170)
  - Fix data corruption during WAL replay of ALTER ... SET TABLESPACE.
    When archive_mode is on, ALTER ... SET TABLESPACE generates a WAL
    record whose replay logic was incorrect. It could write the data to
    the wrong place, leading to possibly-unrecoverable data corruption.
    Data corruption would be observed on standby slaves, and could
    occur on the master as well if a database crash and recovery
    occurred after committing the ALTER and before the next checkpoint.
  - Fix possible crash if a cache reset message is received during
    rebuild of a relcache entry.
    This error was introduced in 8.4.3 while fixing a related failure.
  - Apply per-function GUC settings while running the language
    validator for the function. This avoids failures if the function's code
    is invalid without the setting; an example is that SQL functions may not
    parse if the search_path is not correct.
  - Do constraint exclusion for inherited "UPDATE" and "DELETE" target
    tables when constraint_exclusion = partition.
    Due to an oversight, this setting previously only caused constraint
    exclusion to be checked in "SELECT" commands.
  - Do not allow an unprivileged user to reset superuser-only parameter
    settings.
    Previously, if an unprivileged user ran ALTER USER ... RESET ALL
    for himself, or ALTER DATABASE ... RESET ALL for a database he
    owns, this would remove all special parameter settings for the user
    or database, even ones that are only supposed to be changeable by a
    superuser. Now, the "ALTER" will only remove the parameters that
    the user has permission to change.
  - Avoid possible crash during backend shutdown if shutdown occurs
    when a CONTEXT addition would be made to log entries.
    In some cases the context-printing function would fail because the
    current transaction had already been rolled back when it came time
    to print a log message.
  - Fix erroneous handling of %r parameter in recovery_end_command.
    The value always came out zero.
  - Ensure the archiver process responds to changes in archive_command
    as soon as possible.
  - Fix pl/pgsql's CASE statement to not fail when the case expression
    is a query that returns no rows.
  - Update pl/perl's "ppport.h" for modern Perl versions.
  - Fix assorted memory leaks in pl/python.
  - Handle empty-string connect parameters properly in ecpg.
  - Prevent infinite recursion in psql when expanding a variable that
    refers to itself.
  - Fix psql's \copy to not add spaces around a dot within \copy
    (select ...).
    Addition of spaces around the decimal point in a numeric literal
    would result in a syntax error.
  - Avoid formatting failure in psql when running in a locale context
    that doesn't match the client_encoding.
  - Fix unnecessary "GIN indexes do not support whole-index scans"
    errors for unsatisfiable queries using "contrib/intarray" operators.
  - Ensure that "contrib/pgstattuple" functions respond to cancel
    interrupts promptly.

Show diffs side-by-side

added added

removed removed

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