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