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