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