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.010000.
10
11 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
12 includes in parts/inc/ instead.
13
14 Use 'perldoc ppport.h' to view the documentation below.
15
16 ----------------------------------------------------------------------
17
18 SKIP
19
20 =pod
21
22 =head1 NAME
23
24 ppport.h - Perl/Pollution/Portability version 3.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 swash_fetch||5.007002|
2250 swash_get|||
2251 swash_init||5.006000|
2252 sys_intern_clear|||
2253 sys_intern_dup|||
2254 sys_intern_init|||
2255 taint_env|||
2256 taint_proper|||
2257 tmps_grow||5.006000|
2258 toLOWER|||
2259 toUPPER|||
2260 to_byte_substr|||
2261 to_uni_fold||5.007003|
2262 to_uni_lower_lc||5.006000|
2263 to_uni_lower||5.007003|
2264 to_uni_title_lc||5.006000|
2265 to_uni_title||5.007003|
2266 to_uni_upper_lc||5.006000|
2267 to_uni_upper||5.007003|
2268 to_utf8_case||5.007003|
2269 to_utf8_fold||5.007003|
2270 to_utf8_lower||5.007003|
2271 to_utf8_substr|||
2272 to_utf8_title||5.007003|
2273 to_utf8_upper||5.007003|
2274 token_free|||
2275 token_getmad|||
2276 tokenize_use|||
2277 tokeq|||
2278 tokereport|||
2279 too_few_arguments|||
2280 too_many_arguments|||
2281 uiv_2buf|||n
2282 unlnk|||
2283 unpack_rec|||
2284 unpack_str||5.007003|
2285 unpackstring||5.008001|
2286 unshare_hek_or_pvn|||
2287 unshare_hek|||
2288 unsharepvn||5.004000|
2289 unwind_handler_stack|||
2290 update_debugger_info|||
2291 upg_version||5.009005|
2292 usage|||
2293 utf16_to_utf8_reversed||5.006001|
2294 utf16_to_utf8||5.006001|
2295 utf8_distance||5.006000|
2296 utf8_hop||5.006000|
2297 utf8_length||5.007001|
2298 utf8_mg_pos_cache_update|||
2299 utf8_to_bytes||5.006001|
2300 utf8_to_uvchr||5.007001|
2301 utf8_to_uvuni||5.007001|
2302 utf8n_to_uvchr|||
2303 utf8n_to_uvuni||5.007001|
2304 utilize|||
2305 uvchr_to_utf8_flags||5.007003|
2306 uvchr_to_utf8|||
2307 uvuni_to_utf8_flags||5.007003|
2308 uvuni_to_utf8||5.007001|
2309 validate_suid|||
2310 varname|||
2311 vcmp||5.009000|
2312 vcroak||5.006000|
2313 vdeb||5.007003|
2314 vdie_common|||
2315 vdie_croak_common|||
2316 vdie|||
2317 vform||5.006000|
2318 visit|||
2319 vivify_defelem|||
2320 vivify_ref|||
2321 vload_module|5.006000||p
2322 vmess||5.006000|
2323 vnewSVpvf|5.006000|5.004000|p
2324 vnormal||5.009002|
2325 vnumify||5.009000|
2326 vstringify||5.009000|
2327 vverify||5.009003|
2328 vwarner||5.006000|
2329 vwarn||5.006000|
2330 wait4pid|||
2331 warn_nocontext|||vn
2332 warner_nocontext|||vn
2333 warner|5.006000|5.004000|pv
2334 warn|||v
2335 watch|||
2336 whichsig|||
2337 write_no_mem|||
2338 write_to_stderr|||
2339 xmldump_all|||
2340 xmldump_attr|||
2341 xmldump_eval|||
2342 xmldump_form|||
2343 xmldump_indent|||v
2344 xmldump_packsubs|||
2345 xmldump_sub|||
2346 xmldump_vindent|||
2347 yyerror|||
2348 yylex|||
2349 yyparse|||
2350 yywarn|||
2351 );
2352
2353 if (exists $opt{'list-unsupported'}) {
2354 my $f;
2355 for $f (sort { lc $a cmp lc $b } keys %API) {
2356 next unless $API{$f}{todo};
2357 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
2358 }
2359 exit 0;
2360 }
2361
2362 # Scan for possible replacement candidates
2363
2364 my(%replace, %need, %hints, %warnings, %depends);
2365 my $replace = 0;
2366 my($hint, $define, $function);
2367
2368 sub find_api
2369 {
2370 my $code = shift;
2371 $code =~ s{
2372 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
2373 | "[^"\\]*(?:\\.[^"\\]*)*"
2374 | '[^'\\]*(?:\\.[^'\\]*)*' }{}egsx;
2375 grep { exists $API{$_} } $code =~ /(\w+)/mg;
2376 }
2377
2378 while (<DATA>) {
2379 if ($hint) {
2380 my $h = $hint->[0] eq 'Hint' ? \%hints : \%warnings;
2381 if (m{^\s*\*\s(.*?)\s*$}) {
2382 for (@{$hint->[1]}) {
2383 $h->{$_} ||= ''; # suppress warning with older perls
2384 $h->{$_} .= "$1\n";
2385 }
2386 }
2387 else { undef $hint }
2388 }
2389
2390 $hint = [$1, [split /,?\s+/, $2]]
2391 if m{^\s*$rccs\s+(Hint|Warning):\s+(\w+(?:,?\s+\w+)*)\s*$};
2392
2393 if ($define) {
2394 if ($define->[1] =~ /\\$/) {
2395 $define->[1] .= $_;
2396 }
2397 else {
2398 if (exists $API{$define->[0]} && $define->[1] !~ /^DPPP_\(/) {
2399 my @n = find_api($define->[1]);
2400 push @{$depends{$define->[0]}}, @n if @n
2401 }
2402 undef $define;
2403 }
2404 }
2405
2406 $define = [$1, $2] if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(.*)};
2407
2408 if ($function) {
2409 if (/^}/) {
2410 if (exists $API{$function->[0]}) {
2411 my @n = find_api($function->[1]);
2412 push @{$depends{$function->[0]}}, @n if @n
2413 }
2414 undef $define;
2415 }
2416 else {
2417 $function->[1] .= $_;
2418 }
2419 }
2420
2421 $function = [$1, ''] if m{^DPPP_\(my_(\w+)\)};
2422
2423 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2424 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2425 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2426 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2427
2428 if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2429 push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2;
2430 }
2431
2432 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2433 }
2434
2435 for (values %depends) {
2436 my %s;
2437 $_ = [sort grep !$s{$_}++, @$_];
2438 }
2439
2440 if (exists $opt{'api-info'}) {
2441 my $f;
2442 my $count = 0;
2443 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2444 for $f (sort { lc $a cmp lc $b } keys %API) {
2445 next unless $f =~ /$match/;
2446 print "\n=== $f ===\n\n";
2447 my $info = 0;
2448 if ($API{$f}{base} || $API{$f}{todo}) {
2449 my $base = format_version($API{$f}{base} || $API{$f}{todo});
2450 print "Supported at least starting from perl-$base.\n";
2451 $info++;
2452 }
2453 if ($API{$f}{provided}) {
2454 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2455 print "Support by $ppport provided back to perl-$todo.\n";
2456 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2457 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2458 print "\n$hints{$f}" if exists $hints{$f};
2459 print "\nWARNING:\n$warnings{$f}" if exists $warnings{$f};
2460 $info++;
2461 }
2462 print "No portability information available.\n" unless $info;
2463 $count++;
2464 }
2465 $count or print "Found no API matching '$opt{'api-info'}'.";
2466 print "\n";
2467 exit 0;
2468 }
2469
2470 if (exists $opt{'list-provided'}) {
2471 my $f;
2472 for $f (sort { lc $a cmp lc $b } keys %API) {
2473 next unless $API{$f}{provided};
2474 my @flags;
2475 push @flags, 'explicit' if exists $need{$f};
2476 push @flags, 'depend' if exists $depends{$f};
2477 push @flags, 'hint' if exists $hints{$f};
2478 push @flags, 'warning' if exists $warnings{$f};
2479 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
2480 print "$f$flags\n";
2481 }
2482 exit 0;
2483 }
2484
2485 my @files;
2486 my @srcext = qw( .xs .c .h .cc .cpp -c.inc -xs.inc );
2487 my $srcext = join '|', map { quotemeta $_ } @srcext;
2488
2489 if (@ARGV) {
2490 my %seen;
2491 for (@ARGV) {
2492 if (-e) {
2493 if (-f) {
2494 push @files, $_ unless $seen{$_}++;
2495 }
2496 else { warn "'$_' is not a file.\n" }
2497 }
2498 else {
2499 my @new = grep { -f } glob $_
2500 or warn "'$_' does not exist.\n";
2501 push @files, grep { !$seen{$_}++ } @new;
2502 }
2503 }
2504 }
2505 else {
2506 eval {
2507 require File::Find;
2508 File::Find::find(sub {
2509 $File::Find::name =~ /($srcext)$/i
2510 and push @files, $File::Find::name;
2511 }, '.');
2512 };
2513 if ($@) {
2514 @files = map { glob "*$_" } @srcext;
2515 }
2516 }
2517
2518 if (!@ARGV || $opt{filter}) {
2519 my(@in, @out);
2520 my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files;
2521 for (@files) {
2522 my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/($srcext)$/i;
2523 push @{ $out ? \@out : \@in }, $_;
2524 }
2525 if (@ARGV && @out) {
2526 warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out);
2527 }
2528 @files = @in;
2529 }
2530
2531 die "No input files given!\n" unless @files;
2532
2533 my(%files, %global, %revreplace);
2534 %revreplace = reverse %replace;
2535 my $filename;
2536 my $patch_opened = 0;
2537
2538 for $filename (@files) {
2539 unless (open IN, "<$filename") {
2540 warn "Unable to read from $filename: $!\n";
2541 next;
2542 }
2543
2544 info("Scanning $filename ...");
2545
2546 my $c = do { local $/; <IN> };
2547 close IN;
2548
2549 my %file = (orig => $c, changes => 0);
2550
2551 # Temporarily remove C/XS comments and strings from the code
2552 my @ccom;
2553
2554 $c =~ s{
2555 ( ^$HS*\#$HS*include\b[^\r\n]+\b(?:\Q$ppport\E|XSUB\.h)\b[^\r\n]*
2556 | ^$HS*\#$HS*(?:define|elif|if(?:def)?)\b[^\r\n]* )
2557 | ( ^$HS*\#[^\r\n]*
2558 | "[^"\\]*(?:\\.[^"\\]*)*"
2559 | '[^'\\]*(?:\\.[^'\\]*)*'
2560 | / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]* ) )
2561 }{ defined $2 and push @ccom, $2;
2562 defined $1 ? $1 : "$ccs$#ccom$cce" }mgsex;
2563
2564 $file{ccom} = \@ccom;
2565 $file{code} = $c;
2566 $file{has_inc_ppport} = $c =~ /^$HS*#$HS*include[^\r\n]+\b\Q$ppport\E\b/m;
2567
2568 my $func;
2569
2570 for $func (keys %API) {
2571 my $match = $func;
2572 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
2573 if ($c =~ /\b(?:Perl_)?($match)\b/) {
2574 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
2575 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
2576 if (exists $API{$func}{provided}) {
2577 $file{uses_provided}{$func}++;
2578 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
2579 $file{uses}{$func}++;
2580 my @deps = rec_depend($func);
2581 if (@deps) {
2582 $file{uses_deps}{$func} = \@deps;
2583 for (@deps) {
2584 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
2585 }
2586 }
2587 for ($func, @deps) {
2588 $file{needs}{$_} = 'static' if exists $need{$_};
2589 }
2590 }
2591 }
2592 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
2593 if ($c =~ /\b$func\b/) {
2594 $file{uses_todo}{$func}++;
2595 }
2596 }
2597 }
2598 }
2599
2600 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
2601 if (exists $need{$2}) {
2602 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
2603 }
2604 else { warning("Possibly wrong #define $1 in $filename") }
2605 }
2606
2607 for (qw(uses needs uses_todo needed_global needed_static)) {
2608 for $func (keys %{$file{$_}}) {
2609 push @{$global{$_}{$func}}, $filename;
2610 }
2611 }
2612
2613 $files{$filename} = \%file;
2614 }
2615
2616 # Globally resolve NEED_'s
2617 my $need;
2618 for $need (keys %{$global{needs}}) {
2619 if (@{$global{needs}{$need}} > 1) {
2620 my @targets = @{$global{needs}{$need}};
2621 my @t = grep $files{$_}{needed_global}{$need}, @targets;
2622 @targets = @t if @t;
2623 @t = grep /\.xs$/i, @targets;
2624 @targets = @t if @t;
2625 my $target = shift @targets;
2626 $files{$target}{needs}{$need} = 'global';
2627 for (@{$global{needs}{$need}}) {
2628 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
2629 }
2630 }
2631 }
2632
2633 for $filename (@files) {
2634 exists $files{$filename} or next;
2635
2636 info("=== Analyzing $filename ===");
2637
2638 my %file = %{$files{$filename}};
2639 my $func;
2640 my $c = $file{code};
2641 my $warnings = 0;
2642
2643 for $func (sort keys %{$file{uses_Perl}}) {
2644 if ($API{$func}{varargs}) {
2645 unless ($API{$func}{nothxarg}) {
2646 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
2647 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
2648 if ($changes) {
2649 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
2650 $file{changes} += $changes;
2651 }
2652 }
2653 }
2654 else {
2655 warning("Uses Perl_$func instead of $func");
2656 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
2657 {$func$1(}g);
2658 }
2659 }
2660
2661 for $func (sort keys %{$file{uses_replace}}) {
2662 warning("Uses $func instead of $replace{$func}");
2663 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2664 }
2665
2666 for $func (sort keys %{$file{uses_provided}}) {
2667 if ($file{uses}{$func}) {
2668 if (exists $file{uses_deps}{$func}) {
2669 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
2670 }
2671 else {
2672 diag("Uses $func");
2673 }
2674 }
2675 $warnings += hint($func);
2676 }
2677
2678 unless ($opt{quiet}) {
2679 for $func (sort keys %{$file{uses_todo}}) {
2680 print "*** WARNING: Uses $func, which may not be portable below perl ",
2681 format_version($API{$func}{todo}), ", even with '$ppport'\n";
2682 $warnings++;
2683 }
2684 }
2685
2686 for $func (sort keys %{$file{needed_static}}) {
2687 my $message = '';
2688 if (not exists $file{uses}{$func}) {
2689 $message = "No need to define NEED_$func if $func is never used";
2690 }
2691 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
2692 $message = "No need to define NEED_$func when already needed globally";
2693 }
2694 if ($message) {
2695 diag($message);
2696 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
2697 }
2698 }
2699
2700 for $func (sort keys %{$file{needed_global}}) {
2701 my $message = '';
2702 if (not exists $global{uses}{$func}) {
2703 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
2704 }
2705 elsif (exists $file{needs}{$func}) {
2706 if ($file{needs}{$func} eq 'extern') {
2707 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
2708 }
2709 elsif ($file{needs}{$func} eq 'static') {
2710 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
2711 }
2712 }
2713 if ($message) {
2714 diag($message);
2715 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
2716 }
2717 }
2718
2719 $file{needs_inc_ppport} = keys %{$file{uses}};
2720
2721 if ($file{needs_inc_ppport}) {
2722 my $pp = '';
2723
2724 for $func (sort keys %{$file{needs}}) {
2725 my $type = $file{needs}{$func};
2726 next if $type eq 'extern';
2727 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
2728 unless (exists $file{"needed_$type"}{$func}) {
2729 if ($type eq 'global') {
2730 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
2731 }
2732 else {
2733 diag("File needs $func, adding static request");
2734 }
2735 $pp .= "#define NEED_$func$suffix\n";
2736 }
2737 }
2738
2739 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
2740 $pp = '';
2741 $file{changes}++;
2742 }
2743
2744 unless ($file{has_inc_ppport}) {
2745 diag("Needs to include '$ppport'");
2746 $pp .= qq(#include "$ppport"\n)
2747 }
2748
2749 if ($pp) {
2750 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
2751 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
2752 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
2753 || ($c =~ s/^/$pp/);
2754 }
2755 }
2756 else {
2757 if ($file{has_inc_ppport}) {
2758 diag("No need to include '$ppport'");
2759 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
2760 }
2761 }
2762
2763 # put back in our C comments
2764 my $ix;
2765 my $cppc = 0;
2766 my @ccom = @{$file{ccom}};
2767 for $ix (0 .. $#ccom) {
2768 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
2769 $cppc++;
2770 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
2771 }
2772 else {
2773 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
2774 }
2775 }
2776
2777 if ($cppc) {
2778 my $s = $cppc != 1 ? 's' : '';
2779 warning("Uses $cppc C++ style comment$s, which is not portable");
2780 }
2781
2782 my $s = $warnings != 1 ? 's' : '';
2783 my $warn = $warnings ? " ($warnings warning$s)" : '';
2784 info("Analysis completed$warn");
2785
2786 if ($file{changes}) {
2787 if (exists $opt{copy}) {
2788 my $newfile = "$filename$opt{copy}";
2789 if (-e $newfile) {
2790 error("'$newfile' already exists, refusing to write copy of '$filename'");
2791 }
2792 else {
2793 local *F;
2794 if (open F, ">$newfile") {
2795 info("Writing copy of '$filename' with changes to '$newfile'");
2796 print F $c;
2797 close F;
2798 }
2799 else {
2800 error("Cannot open '$newfile' for writing: $!");
2801 }
2802 }
2803 }
2804 elsif (exists $opt{patch} || $opt{changes}) {
2805 if (exists $opt{patch}) {
2806 unless ($patch_opened) {
2807 if (open PATCH, ">$opt{patch}") {
2808 $patch_opened = 1;
2809 }
2810 else {
2811 error("Cannot open '$opt{patch}' for writing: $!");
2812 delete $opt{patch};
2813 $opt{changes} = 1;
2814 goto fallback;
2815 }
2816 }
2817 mydiff(\*PATCH, $filename, $c);
2818 }
2819 else {
2820 fallback:
2821 info("Suggested changes:");
2822 mydiff(\*STDOUT, $filename, $c);
2823 }
2824 }
2825 else {
2826 my $s = $file{changes} == 1 ? '' : 's';
2827 info("$file{changes} potentially required change$s detected");
2828 }
2829 }
2830 else {
2831 info("Looks good");
2832 }
2833 }
2834
2835 close PATCH if $patch_opened;
2836
2837 exit 0;
2838
2839
2840 sub try_use { eval "use @_;"; return $@ eq '' }
2841
2842 sub mydiff
2843 {
2844 local *F = shift;
2845 my($file, $str) = @_;
2846 my $diff;
2847
2848 if (exists $opt{diff}) {
2849 $diff = run_diff($opt{diff}, $file, $str);
2850 }
2851
2852 if (!defined $diff and try_use('Text::Diff')) {
2853 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
2854 $diff = <<HEADER . $diff;
2855 --- $file
2856 +++ $file.patched
2857 HEADER
2858 }
2859
2860 if (!defined $diff) {
2861 $diff = run_diff('diff -u', $file, $str);
2862 }
2863
2864 if (!defined $diff) {
2865 $diff = run_diff('diff', $file, $str);
2866 }
2867
2868 if (!defined $diff) {
2869 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
2870 return;
2871 }
2872
2873 print F $diff;
2874 }
2875
2876 sub run_diff
2877 {
2878 my($prog, $file, $str) = @_;
2879 my $tmp = 'dppptemp';
2880 my $suf = 'aaa';
2881 my $diff = '';
2882 local *F;
2883
2884 while (-e "$tmp.$suf") { $suf++ }
2885 $tmp = "$tmp.$suf";
2886
2887 if (open F, ">$tmp") {
2888 print F $str;
2889 close F;
2890
2891 if (open F, "$prog $file $tmp |") {
2892 while (<F>) {
2893 s/\Q$tmp\E/$file.patched/;
2894 $diff .= $_;
2895 }
2896 close F;
2897 unlink $tmp;
2898 return $diff;
2899 }
2900
2901 unlink $tmp;
2902 }
2903 else {
2904 error("Cannot open '$tmp' for writing: $!");
2905 }
2906
2907 return undef;
2908 }
2909
2910 sub rec_depend
2911 {
2912 my($func, $seen) = @_;
2913 return () unless exists $depends{$func};
2914 $seen = {%{$seen||{}}};
2915 return () if $seen->{$func}++;
2916 my %s;
2917 grep !$s{$_}++, map { ($_, rec_depend($_, $seen)) } @{$depends{$func}};
2918 }
2919
2920 sub parse_version
2921 {
2922 my $ver = shift;
2923
2924 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
2925 return ($1, $2, $3);
2926 }
2927 elsif ($ver !~ /^\d+\.[\d_]+$/) {
2928 die "cannot parse version '$ver'\n";
2929 }
2930
2931 $ver =~ s/_//g;
2932 $ver =~ s/$/000000/;
2933
2934 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
2935
2936 $v = int $v;
2937 $s = int $s;
2938
2939 if ($r < 5 || ($r == 5 && $v < 6)) {
2940 if ($s % 10) {
2941 die "cannot parse version '$ver'\n";
2942 }
2943 }
2944
2945 return ($r, $v, $s);
2946 }
2947
2948 sub format_version
2949 {
2950 my $ver = shift;
2951
2952 $ver =~ s/$/000000/;
2953 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
2954
2955 $v = int $v;
2956 $s = int $s;
2957
2958 if ($r < 5 || ($r == 5 && $v < 6)) {
2959 if ($s % 10) {
2960 die "invalid version '$ver'\n";
2961 }
2962 $s /= 10;
2963
2964 $ver = sprintf "%d.%03d", $r, $v;
2965 $s > 0 and $ver .= sprintf "_%02d", $s;
2966
2967 return $ver;
2968 }
2969
2970 return sprintf "%d.%d.%d", $r, $v, $s;
2971 }
2972
2973 sub info
2974 {
2975 $opt{quiet} and return;
2976 print @_, "\n";
2977 }
2978
2979 sub diag
2980 {
2981 $opt{quiet} and return;
2982 $opt{diag} and print @_, "\n";
2983 }
2984
2985 sub warning
2986 {
2987 $opt{quiet} and return;
2988 print "*** ", @_, "\n";
2989 }
2990
2991 sub error
2992 {
2993 print "*** ERROR: ", @_, "\n";
2994 }
2995
2996 my %given_hints;
2997 my %given_warnings;
2998 sub hint
2999 {
3000 $opt{quiet} and return;
3001 my $func = shift;
3002 my $rv = 0;
3003 if (exists $warnings{$func} && !$given_warnings{$func}++) {
3004 my $warn = $warnings{$func};
3005 $warn =~ s!^!*** !mg;
3006 print "*** WARNING: $func\n", $warn;
3007 $rv++;
3008 }
3009 if ($opt{hints} && exists $hints{$func} && !$given_hints{$func}++) {
3010 my $hint = $hints{$func};
3011 $hint =~ s/^/ /mg;
3012 print " --- hint for $func ---\n", $hint;
3013 }
3014 $rv;
3015 }
3016
3017 sub usage
3018 {
3019 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
3020 my %M = ( 'I' => '*' );
3021 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
3022 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
3023
3024 print <<ENDUSAGE;
3025
3026 Usage: $usage
3027
3028 See perldoc $0 for details.
3029
3030 ENDUSAGE
3031
3032 exit 2;
3033 }
3034
3035 sub strip
3036 {
3037 my $self = do { local(@ARGV,$/)=($0); <> };
3038 my($copy) = $self =~ /^=head\d\s+COPYRIGHT\s*^(.*?)^=\w+/ms;
3039 $copy =~ s/^(?=\S+)/ /gms;
3040 $self =~ s/^$HS+Do NOT edit.*?(?=^-)/$copy/ms;
3041 $self =~ s/^SKIP.*(?=^__DATA__)/SKIP
3042 if (\@ARGV && \$ARGV[0] eq '--unstrip') {
3043 eval { require Devel::PPPort };
3044 \$@ and die "Cannot require Devel::PPPort, please install.\\n";
3045 if (\$Devel::PPPort::VERSION < $VERSION) {
3046 die "$0 was originally generated with Devel::PPPort $VERSION.\\n"
3047 . "Your Devel::PPPort is only version \$Devel::PPPort::VERSION.\\n"
3048 . "Please install a newer version, or --unstrip will not work.\\n";
3049 }
3050 Devel::PPPort::WriteFile(\$0);
3051 exit 0;
3052 }
3053 print <<END;
3054
3055 Sorry, but this is a stripped version of \$0.
3056
3057 To be able to use its original script and doc functionality,
3058 please try to regenerate this file using:
3059
3060 \$^X \$0 --unstrip
3061
3062 END
3063 /ms;
3064 my($pl, $c) = $self =~ /(.*^__DATA__)(.*)/ms;
3065 $c =~ s{
3066 / (?: \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / | /[^\r\n]*)
3067 | ( "[^"\\]*(?:\\.[^"\\]*)*"
3068 | '[^'\\]*(?:\\.[^'\\]*)*' )
3069 | ($HS+) }{ defined $2 ? ' ' : ($1 || '') }gsex;
3070 $c =~ s!\s+$!!mg;
3071 $c =~ s!^$LF!!mg;
3072 $c =~ s!^\s*#\s*!#!mg;
3073 $c =~ s!^\s+!!mg;
3074
3075 open OUT, ">$0" or die "cannot strip $0: $!\n";
3076 print OUT "$pl$c\n";
3077
3078 exit 0;
3079 }
3080
3081 __DATA__
3082 */
3083
3084 #ifndef _P_P_PORTABILITY_H_
3085 #define _P_P_PORTABILITY_H_
3086
3087 #ifndef DPPP_NAMESPACE
3088 # define DPPP_NAMESPACE DPPP_
3089 #endif
3090
3091 #define DPPP_CAT2(x,y) CAT2(x,y)
3092 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
3093
3094 #ifndef PERL_REVISION
3095 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
3096 # define PERL_PATCHLEVEL_H_IMPLICIT
3097 # include <patchlevel.h>
3098 # endif
3099 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
3100 # include <could_not_find_Perl_patchlevel.h>
3101 # endif
3102 # ifndef PERL_REVISION
3103 # define PERL_REVISION (5)
3104 /* Replace: 1 */
3105 # define PERL_VERSION PATCHLEVEL
3106 # define PERL_SUBVERSION SUBVERSION
3107 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
3108 /* Replace: 0 */
3109 # endif
3110 #endif
3111
3112 #define _dpppDEC2BCD(dec) ((((dec)/100)<<8)|((((dec)%100)/10)<<4)|((dec)%10))
3113 #define PERL_BCDVERSION ((_dpppDEC2BCD(PERL_REVISION)<<24)|(_dpppDEC2BCD(PERL_VERSION)<<12)|_dpppDEC2BCD(PERL_SUBVERSION))
3114
3115 /* It is very unlikely that anyone will try to use this with Perl 6
3116 (or greater), but who knows.
3117 */
3118 #if PERL_REVISION != 5
3119 # error ppport.h only works with Perl version 5
3120 #endif /* PERL_REVISION != 5 */
3121
3122 #ifdef I_LIMITS
3123 # include <limits.h>
3124 #endif
3125
3126 #ifndef PERL_UCHAR_MIN
3127 # define PERL_UCHAR_MIN ((unsigned char)0)
3128 #endif
3129
3130 #ifndef PERL_UCHAR_MAX
3131 # ifdef UCHAR_MAX
3132 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
3133 # else
3134 # ifdef MAXUCHAR
3135 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
3136 # else
3137 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
3138 # endif
3139 # endif
3140 #endif
3141
3142 #ifndef PERL_USHORT_MIN
3143 # define PERL_USHORT_MIN ((unsigned short)0)
3144 #endif
3145
3146 #ifndef PERL_USHORT_MAX
3147 # ifdef USHORT_MAX
3148 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
3149 # else
3150 # ifdef MAXUSHORT
3151 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
3152 # else
3153 # ifdef USHRT_MAX
3154 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
3155 # else
3156 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
3157 # endif
3158 # endif
3159 # endif
3160 #endif
3161
3162 #ifndef PERL_SHORT_MAX
3163 # ifdef SHORT_MAX
3164 # define PERL_SHORT_MAX ((short)SHORT_MAX)
3165 # else
3166 # ifdef MAXSHORT /* Often used in <values.h> */
3167 # define PERL_SHORT_MAX ((short)MAXSHORT)
3168 # else
3169 # ifdef SHRT_MAX
3170 # define PERL_SHORT_MAX ((short)SHRT_MAX)
3171 # else
3172 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
3173 # endif
3174 # endif
3175 # endif
3176 #endif
3177
3178 #ifndef PERL_SHORT_MIN
3179 # ifdef SHORT_MIN
3180 # define PERL_SHORT_MIN ((short)SHORT_MIN)
3181 # else
3182 # ifdef MINSHORT
3183 # define PERL_SHORT_MIN ((short)MINSHORT)
3184 # else
3185 # ifdef SHRT_MIN
3186 # define PERL_SHORT_MIN ((short)SHRT_MIN)
3187 # else
3188 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
3189 # endif
3190 # endif
3191 # endif
3192 #endif
3193
3194 #ifndef PERL_UINT_MAX
3195 # ifdef UINT_MAX
3196 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
3197 # else
3198 # ifdef MAXUINT
3199 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
3200 # else
3201 # define PERL_UINT_MAX (~(unsigned int)0)
3202 # endif
3203 # endif
3204 #endif
3205
3206 #ifndef PERL_UINT_MIN
3207 # define PERL_UINT_MIN ((unsigned int)0)
3208 #endif
3209
3210 #ifndef PERL_INT_MAX
3211 # ifdef INT_MAX
3212 # define PERL_INT_MAX ((int)INT_MAX)
3213 # else
3214 # ifdef MAXINT /* Often used in <values.h> */
3215 # define PERL_INT_MAX ((int)MAXINT)
3216 # else
3217 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
3218 # endif
3219 # endif
3220 #endif
3221
3222 #ifndef PERL_INT_MIN
3223 # ifdef INT_MIN
3224 # define PERL_INT_MIN ((int)INT_MIN)
3225 # else
3226 # ifdef MININT
3227 # define PERL_INT_MIN ((int)MININT)
3228 # else
3229 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
3230 # endif
3231 # endif
3232 #endif
3233
3234 #ifndef PERL_ULONG_MAX
3235 # ifdef ULONG_MAX
3236 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
3237 # else
3238 # ifdef MAXULONG
3239 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
3240 # else
3241 # define PERL_ULONG_MAX (~(unsigned long)0)
3242 # endif
3243 # endif
3244 #endif
3245
3246 #ifndef PERL_ULONG_MIN
3247 # define PERL_ULONG_MIN ((unsigned long)0L)
3248 #endif
3249
3250 #ifndef PERL_LONG_MAX
3251 # ifdef LONG_MAX
3252 # define PERL_LONG_MAX ((long)LONG_MAX)
3253 # else
3254 # ifdef MAXLONG
3255 # define PERL_LONG_MAX ((long)MAXLONG)
3256 # else
3257 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
3258 # endif
3259 # endif
3260 #endif
3261
3262 #ifndef PERL_LONG_MIN
3263 # ifdef LONG_MIN
3264 # define PERL_LONG_MIN ((long)LONG_MIN)
3265 # else
3266 # ifdef MINLONG
3267 # define PERL_LONG_MIN ((long)MINLONG)
3268 # else
3269 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
3270 # endif
3271 # endif
3272 #endif
3273
3274 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
3275 # ifndef PERL_UQUAD_MAX
3276 # ifdef ULONGLONG_MAX
3277 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
3278 # else
3279 # ifdef MAXULONGLONG
3280 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
3281 # else
3282 # define PERL_UQUAD_MAX (~(unsigned long long)0)
3283 # endif
3284 # endif
3285 # endif
3286
3287 # ifndef PERL_UQUAD_MIN
3288 # define PERL_UQUAD_MIN ((unsigned long long)0L)
3289 # endif
3290
3291 # ifndef PERL_QUAD_MAX
3292 # ifdef LONGLONG_MAX
3293 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
3294 # else
3295 # ifdef MAXLONGLONG
3296 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
3297 # else
3298 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
3299 # endif
3300 # endif
3301 # endif
3302
3303 # ifndef PERL_QUAD_MIN
3304 # ifdef LONGLONG_MIN
3305 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
3306 # else
3307 # ifdef MINLONGLONG
3308 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
3309 # else
3310 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
3311 # endif
3312 # endif
3313 # endif
3314 #endif
3315
3316 /* This is based on code from 5.003 perl.h */
3317 #ifdef HAS_QUAD
3318 # ifdef cray
3319 #ifndef IVTYPE
3320 # define IVTYPE int
3321 #endif
3322
3323 #ifndef IV_MIN
3324 # define IV_MIN PERL_INT_MIN
3325 #endif
3326
3327 #ifndef IV_MAX
3328 # define IV_MAX PERL_INT_MAX
3329 #endif
3330
3331 #ifndef UV_MIN
3332 # define UV_MIN PERL_UINT_MIN
3333 #endif
3334
3335 #ifndef UV_MAX
3336 # define UV_MAX PERL_UINT_MAX
3337 #endif
3338
3339 # ifdef INTSIZE
3340 #ifndef IVSIZE
3341 # define IVSIZE INTSIZE
3342 #endif
3343
3344 # endif
3345 # else
3346 # if defined(convex) || defined(uts)
3347 #ifndef IVTYPE
3348 # define IVTYPE long long
3349 #endif
3350
3351 #ifndef IV_MIN
3352 # define IV_MIN PERL_QUAD_MIN
3353 #endif
3354
3355 #ifndef IV_MAX
3356 # define IV_MAX PERL_QUAD_MAX
3357 #endif
3358
3359 #ifndef UV_MIN
3360 # define UV_MIN PERL_UQUAD_MIN
3361 #endif
3362
3363 #ifndef UV_MAX
3364 # define UV_MAX PERL_UQUAD_MAX
3365 #endif
3366
3367 # ifdef LONGLONGSIZE
3368 #ifndef IVSIZE
3369 # define IVSIZE LONGLONGSIZE
3370 #endif
3371
3372 # endif
3373 # else
3374 #ifndef IVTYPE
3375 # define IVTYPE long
3376 #endif
3377
3378 #ifndef IV_MIN
3379 # define IV_MIN PERL_LONG_MIN
3380 #endif
3381
3382 #ifndef IV_MAX
3383 # define IV_MAX PERL_LONG_MAX
3384 #endif
3385
3386 #ifndef UV_MIN
3387 # define UV_MIN PERL_ULONG_MIN
3388 #endif
3389
3390 #ifndef UV_MAX
3391 # define UV_MAX PERL_ULONG_MAX
3392 #endif
3393
3394 # ifdef LONGSIZE
3395 #ifndef IVSIZE
3396 # define IVSIZE LONGSIZE
3397 #endif
3398
3399 # endif
3400 # endif
3401 # endif
3402 #ifndef IVSIZE
3403 # define IVSIZE 8
3404 #endif
3405
3406 #ifndef PERL_QUAD_MIN
3407 # define PERL_QUAD_MIN IV_MIN
3408 #endif
3409
3410 #ifndef PERL_QUAD_MAX
3411 # define PERL_QUAD_MAX IV_MAX
3412 #endif
3413
3414 #ifndef PERL_UQUAD_MIN
3415 # define PERL_UQUAD_MIN UV_MIN
3416 #endif
3417
3418 #ifndef PERL_UQUAD_MAX
3419 # define PERL_UQUAD_MAX UV_MAX
3420 #endif
3421
3422 #else
3423 #ifndef IVTYPE
3424 # define IVTYPE long
3425 #endif
3426
3427 #ifndef IV_MIN
3428 # define IV_MIN PERL_LONG_MIN
3429 #endif
3430
3431 #ifndef IV_MAX
3432 # define IV_MAX PERL_LONG_MAX
3433 #endif
3434
3435 #ifndef UV_MIN
3436 # define UV_MIN PERL_ULONG_MIN
3437 #endif
3438
3439 #ifndef UV_MAX
3440 # define UV_MAX PERL_ULONG_MAX
3441 #endif
3442
3443 #endif
3444
3445 #ifndef IVSIZE
3446 # ifdef LONGSIZE
3447 # define IVSIZE LONGSIZE
3448 # else
3449 # define IVSIZE 4 /* A bold guess, but the best we can make. */
3450 # endif
3451 #endif
3452 #ifndef UVTYPE
3453 # define UVTYPE unsigned IVTYPE
3454 #endif
3455
3456 #ifndef UVSIZE
3457 # define UVSIZE IVSIZE
3458 #endif
3459 #ifndef sv_setuv
3460 # define sv_setuv(sv, uv) \
3461 STMT_START { \
3462 UV TeMpUv = uv; \
3463 if (TeMpUv <= IV_MAX) \
3464 sv_setiv(sv, TeMpUv); \
3465 else \
3466 sv_setnv(sv, (double)TeMpUv); \
3467 } STMT_END
3468 #endif
3469 #ifndef newSVuv
3470 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
3471 #endif
3472 #ifndef sv_2uv
3473 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
3474 #endif
3475
3476 #ifndef SvUVX
3477 # define SvUVX(sv) ((UV)SvIVX(sv))
3478 #endif
3479
3480 #ifndef SvUVXx
3481 # define SvUVXx(sv) SvUVX(sv)
3482 #endif
3483
3484 #ifndef SvUV
3485 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
3486 #endif
3487
3488 #ifndef SvUVx
3489 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
3490 #endif
3491
3492 /* Hint: sv_uv
3493 * Always use the SvUVx() macro instead of sv_uv().
3494 */
3495 #ifndef sv_uv
3496 # define sv_uv(sv) SvUVx(sv)
3497 #endif
3498
3499 #if !defined(SvUOK) && defined(SvIOK_UV)
3500 # define SvUOK(sv) SvIOK_UV(sv)
3501 #endif
3502 #ifndef XST_mUV
3503 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
3504 #endif
3505
3506 #ifndef XSRETURN_UV
3507 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
3508 #endif
3509 #ifndef PUSHu
3510 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
3511 #endif
3512
3513 #ifndef XPUSHu
3514 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
3515 #endif
3516
3517 #ifdef HAS_MEMCMP
3518 #ifndef memNE
3519 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
3520 #endif
3521
3522 #ifndef memEQ
3523 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
3524 #endif
3525
3526 #else
3527 #ifndef memNE
3528 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
3529 #endif
3530
3531 #ifndef memEQ
3532 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
3533 #endif
3534
3535 #endif
3536 #ifndef MoveD
3537 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
3538 #endif
3539
3540 #ifndef CopyD
3541 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
3542 #endif
3543
3544 #ifdef HAS_MEMSET
3545 #ifndef ZeroD
3546 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
3547 #endif
3548
3549 #else
3550 #ifndef ZeroD
3551 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d)
3552 #endif
3553
3554 #endif
3555 #ifndef PoisonWith
3556 # define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t))
3557 #endif
3558
3559 #ifndef PoisonNew
3560 # define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB)
3561 #endif
3562
3563 #ifndef PoisonFree
3564 # define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF)
3565 #endif
3566
3567 #ifndef Poison
3568 # define Poison(d,n,t) PoisonFree(d,n,t)
3569 #endif
3570 #ifndef Newx
3571 # define Newx(v,n,t) New(0,v,n,t)
3572 #endif
3573
3574 #ifndef Newxc
3575 # define Newxc(v,n,t,c) Newc(0,v,n,t,c)
3576 #endif
3577
3578 #ifndef Newxz
3579 # define Newxz(v,n,t) Newz(0,v,n,t)
3580 #endif
3581
3582 #ifndef PERL_UNUSED_DECL
3583 # ifdef HASATTRIBUTE
3584 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
3585 # define PERL_UNUSED_DECL
3586 # else
3587 # define PERL_UNUSED_DECL __attribute__((unused))
3588 # endif
3589 # else
3590 # define PERL_UNUSED_DECL
3591 # endif
3592 #endif
3593
3594 #ifndef PERL_UNUSED_ARG
3595 # if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
3596 # include <note.h>
3597 # define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
3598 # else
3599 # define PERL_UNUSED_ARG(x) ((void)x)
3600 # endif
3601 #endif
3602
3603 #ifndef PERL_UNUSED_VAR
3604 # define PERL_UNUSED_VAR(x) ((void)x)
3605 #endif
3606
3607 #ifndef PERL_UNUSED_CONTEXT
3608 # ifdef USE_ITHREADS
3609 # define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
3610 # else
3611 # define PERL_UNUSED_CONTEXT
3612 # endif
3613 #endif
3614 #ifndef NOOP
3615 # define NOOP /*EMPTY*/(void)0
3616 #endif
3617
3618 #ifndef dNOOP
3619 # define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
3620 #endif
3621
3622 #ifndef NVTYPE
3623 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
3624 # define NVTYPE long double
3625 # else
3626 # define NVTYPE double
3627 # endif
3628 typedef NVTYPE NV;
3629 #endif
3630
3631 #ifndef INT2PTR
3632
3633 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
3634 # define PTRV UV
3635 # define INT2PTR(any,d) (any)(d)
3636 # else
3637 # if PTRSIZE == LONGSIZE
3638 # define PTRV unsigned long
3639 # else
3640 # define PTRV unsigned
3641 # endif
3642 # define INT2PTR(any,d) (any)(PTRV)(d)
3643 # endif
3644
3645 # define NUM2PTR(any,d) (any)(PTRV)(d)
3646 # define PTR2IV(p) INT2PTR(IV,p)
3647 # define PTR2UV(p) INT2PTR(UV,p)
3648 # define PTR2NV(p) NUM2PTR(NV,p)
3649
3650 # if PTRSIZE == LONGSIZE
3651 # define PTR2ul(p) (unsigned long)(p)
3652 # else
3653 # define PTR2ul(p) INT2PTR(unsigned long,p)
3654 # endif
3655
3656 #endif /* !INT2PTR */
3657
3658 #undef START_EXTERN_C
3659 #undef END_EXTERN_C
3660 #undef EXTERN_C
3661 #ifdef __cplusplus
3662 # define START_EXTERN_C extern "C" {
3663 # define END_EXTERN_C }
3664 # define EXTERN_C extern "C"
3665 #else
3666 # define START_EXTERN_C
3667 # define END_EXTERN_C
3668 # define EXTERN_C extern
3669 #endif
3670
3671 #if defined(PERL_GCC_PEDANTIC)
3672 # ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
3673 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
3674 # endif
3675 #endif
3676
3677 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
3678 # ifndef PERL_USE_GCC_BRACE_GROUPS
3679 # define PERL_USE_GCC_BRACE_GROUPS
3680 # endif
3681 #endif
3682
3683 #undef STMT_START
3684 #undef STMT_END
3685 #ifdef PERL_USE_GCC_BRACE_GROUPS
3686 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
3687 # define STMT_END )
3688 #else
3689 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
3690 # define STMT_START if (1)
3691 # define STMT_END else (void)0
3692 # else
3693 # define STMT_START do
3694 # define STMT_END while (0)
3695 # endif
3696 #endif
3697 #ifndef boolSV
3698 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
3699 #endif
3700
3701 /* DEFSV appears first in 5.004_56 */
3702 #ifndef DEFSV
3703 # define DEFSV GvSV(PL_defgv)
3704 #endif
3705
3706 #ifndef SAVE_DEFSV
3707 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
3708 #endif
3709
3710 /* Older perls (<=5.003) lack AvFILLp */
3711 #ifndef AvFILLp
3712 # define AvFILLp AvFILL
3713 #endif
3714 #ifndef ERRSV
3715 # define ERRSV get_sv("@",FALSE)
3716 #endif
3717 #ifndef newSVpvn
3718 # define newSVpvn(data,len) ((data) \
3719 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
3720 : newSV(0))
3721 #endif
3722
3723 /* Hint: gv_stashpvn
3724 * This function's backport doesn't support the length parameter, but
3725 * rather ignores it. Portability can only be ensured if the length
3726 * parameter is used for speed reasons, but the length can always be
3727 * correctly computed from the string argument.
3728 */
3729 #ifndef gv_stashpvn
3730 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
3731 #endif
3732
3733 /* Replace: 1 */
3734 #ifndef get_cv
3735 # define get_cv perl_get_cv
3736 #endif
3737
3738 #ifndef get_sv
3739 # define get_sv perl_get_sv
3740 #endif
3741
3742 #ifndef get_av
3743 # define get_av perl_get_av
3744 #endif
3745
3746 #ifndef get_hv
3747 # define get_hv perl_get_hv
3748 #endif
3749
3750 /* Replace: 0 */
3751 #ifndef dUNDERBAR
3752 # define dUNDERBAR dNOOP
3753 #endif
3754
3755 #ifndef UNDERBAR
3756 # define UNDERBAR DEFSV
3757 #endif
3758 #ifndef dAX
3759 # define dAX I32 ax = MARK - PL_stack_base + 1
3760 #endif
3761
3762 #ifndef dITEMS
3763 # define dITEMS I32 items = SP - MARK
3764 #endif
3765 #ifndef dXSTARG
3766 # define dXSTARG SV * targ = sv_newmortal()
3767 #endif
3768 #ifndef dAXMARK
3769 # define dAXMARK I32 ax = POPMARK; \
3770 register SV ** const mark = PL_stack_base + ax++
3771 #endif
3772 #ifndef XSprePUSH
3773 # define XSprePUSH (sp = PL_stack_base + ax - 1)
3774 #endif
3775
3776 #if (PERL_BCDVERSION < 0x5005000)
3777 # undef XSRETURN
3778 # define XSRETURN(off) \
3779 STMT_START { \
3780 PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
3781 return; \
3782 } STMT_END
3783 #endif
3784 #ifndef PERL_ABS
3785 # define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
3786 #endif
3787 #ifndef dVAR
3788 # define dVAR dNOOP
3789 #endif
3790 #ifndef SVf
3791 # define SVf "_"
3792 #endif
3793 #ifndef UTF8_MAXBYTES
3794 # define UTF8_MAXBYTES UTF8_MAXLEN
3795 #endif
3796 #ifndef PERL_HASH
3797 # define PERL_HASH(hash,str,len) \
3798 STMT_START { \
3799 const char *s_PeRlHaSh = str; \
3800 I32 i_PeRlHaSh = len; \
3801 U32 hash_PeRlHaSh = 0; \
3802 while (i_PeRlHaSh--) \
3803 hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
3804 (hash) = hash_PeRlHaSh; \
3805 } STMT_END
3806 #endif
3807
3808 #ifndef PERL_SIGNALS_UNSAFE_FLAG
3809
3810 #define PERL_SIGNALS_UNSAFE_FLAG 0x0001
3811
3812 #if (PERL_BCDVERSION < 0x5008000)
3813 # define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
3814 #else
3815 # define D_PPP_PERL_SIGNALS_INIT 0
3816 #endif
3817
3818 #if defined(NEED_PL_signals)
3819 static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
3820 #elif defined(NEED_PL_signals_GLOBAL)
3821 U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
3822 #else
3823 extern U32 DPPP_(my_PL_signals);
3824 #endif
3825 #define PL_signals DPPP_(my_PL_signals)
3826
3827 #endif
3828
3829 /* Hint: PL_ppaddr
3830 * Calling an op via PL_ppaddr requires passing a context argument
3831 * for threaded builds. Since the context argument is different for
3832 * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
3833 * automatically be defined as the correct argument.
3834 */
3835
3836 #if (PERL_BCDVERSION <= 0x5005005)
3837 /* Replace: 1 */
3838 # define PL_ppaddr ppaddr
3839 # define PL_no_modify no_modify
3840 /* Replace: 0 */
3841 #endif
3842
3843 #if (PERL_BCDVERSION <= 0x5004005)
3844 /* Replace: 1 */
3845 # define PL_DBsignal DBsignal
3846 # define PL_DBsingle DBsingle
3847 # define PL_DBsub DBsub
3848 # define PL_DBtrace DBtrace
3849 # define PL_Sv Sv
3850 # define PL_compiling compiling
3851 # define PL_copline copline
3852 # define PL_curcop curcop
3853 # define PL_curstash curstash
3854 # define PL_debstash debstash
3855 # define PL_defgv defgv
3856 # define PL_diehook diehook
3857 # define PL_dirty dirty
3858 # define PL_dowarn dowarn
3859 # define PL_errgv errgv
3860 # define PL_expect expect
3861 # define PL_hexdigit hexdigit
3862 # define PL_hints hints
3863 # define PL_laststatval laststatval
3864 # define PL_na na
3865 # define PL_perl_destruct_level perl_destruct_level
3866 # define PL_perldb perldb
3867 # define PL_rsfp_filters rsfp_filters
3868 # define PL_rsfp rsfp
3869 # define PL_stack_base stack_base
3870 # define PL_stack_sp stack_sp
3871 # define PL_statcache statcache
3872 # define PL_stdingv stdingv
3873 # define PL_sv_arenaroot sv_arenaroot
3874 # define PL_sv_no sv_no
3875 # define PL_sv_undef sv_undef
3876 # define PL_sv_yes sv_yes
3877 # define PL_tainted tainted
3878 # define PL_tainting tainting
3879 /* Replace: 0 */
3880 #endif
3881
3882 /* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters
3883 * Do not use this variable. It is internal to the perl parser
3884 * and may change or even be removed in the future. Note that
3885 * as of perl 5.9.5 you cannot assign to this variable anymore.
3886 */
3887
3888 /* TODO: cannot assign to these vars; is it worth fixing? */
3889 #if (PERL_BCDVERSION >= 0x5009005)
3890 # define PL_expect (PL_parser ? PL_parser->expect : 0)
3891 # define PL_copline (PL_parser ? PL_parser->copline : 0)
3892 # define PL_rsfp (PL_parser ? PL_parser->rsfp : (PerlIO *) 0)
3893 # define PL_rsfp_filters (PL_parser ? PL_parser->rsfp_filters : (AV *) 0)
3894 #endif
3895 #ifndef dTHR
3896 # define dTHR dNOOP
3897 #endif
3898 #ifndef dTHX
3899 # define dTHX dNOOP
3900 #endif
3901
3902 #ifndef dTHXa
3903 # define dTHXa(x) dNOOP
3904 #endif
3905 #ifndef pTHX
3906 # define pTHX void
3907 #endif
3908
3909 #ifndef pTHX_
3910 # define pTHX_
3911 #endif
3912
3913 #ifndef aTHX
3914 # define aTHX
3915 #endif
3916
3917 #ifndef aTHX_
3918 # define aTHX_
3919 #endif
3920
3921 #if (PERL_BCDVERSION < 0x5006000)
3922 # ifdef USE_THREADS
3923 # define aTHXR thr
3924 # define aTHXR_ thr,
3925 # else
3926 # define aTHXR
3927 # define aTHXR_
3928 # endif
3929 # define dTHXR dTHR
3930 #else
3931 # define aTHXR aTHX
3932 # define aTHXR_ aTHX_
3933 # define dTHXR dTHX
3934 #endif
3935 #ifndef dTHXoa
3936 # define dTHXoa(x) dTHXa(x)
3937 #endif
3938 #ifndef PUSHmortal
3939 # define PUSHmortal PUSHs(sv_newmortal())
3940 #endif
3941
3942 #ifndef mPUSHp
3943 # define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l))
3944 #endif
3945
3946 #ifndef mPUSHn
3947 # define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n))
3948 #endif
3949
3950 #ifndef mPUSHi
3951 # define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i))
3952 #endif
3953
3954 #ifndef mPUSHu
3955 # define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u))
3956 #endif
3957 #ifndef XPUSHmortal
3958 # define XPUSHmortal XPUSHs(sv_newmortal())
3959 #endif
3960
3961 #ifndef mXPUSHp
3962 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END
3963 #endif
3964
3965 #ifndef mXPUSHn
3966 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END
3967 #endif
3968
3969 #ifndef mXPUSHi
3970 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END
3971 #endif
3972
3973 #ifndef mXPUSHu
3974 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END
3975 #endif
3976
3977 /* Replace: 1 */
3978 #ifndef call_sv
3979 # define call_sv perl_call_sv
3980 #endif
3981
3982 #ifndef call_pv
3983 # define call_pv perl_call_pv
3984 #endif
3985
3986 #ifndef call_argv
3987 # define call_argv perl_call_argv
3988 #endif
3989
3990 #ifndef call_method
3991 # define call_method perl_call_method
3992 #endif
3993 #ifndef eval_sv
3994 # define eval_sv perl_eval_sv
3995 #endif
3996 #ifndef PERL_LOADMOD_DENY
3997 # define PERL_LOADMOD_DENY 0x1
3998 #endif
3999
4000 #ifndef PERL_LOADMOD_NOIMPORT
4001 # define PERL_LOADMOD_NOIMPORT 0x2
4002 #endif
4003
4004 #ifndef PERL_LOADMOD_IMPORT_OPS
4005 # define PERL_LOADMOD_IMPORT_OPS 0x4
4006 #endif
4007
4008 /* Replace: 0 */
4009
4010 /* Replace perl_eval_pv with eval_pv */
4011
4012 #ifndef eval_pv
4013 #if defined(NEED_eval_pv)
4014 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4015 static
4016 #else
4017 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
4018 #endif
4019
4020 #ifdef eval_pv
4021 # undef eval_pv
4022 #endif
4023 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
4024 #define Perl_eval_pv DPPP_(my_eval_pv)
4025
4026 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
4027
4028 SV*
DPPP_(my_eval_pv)4029 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
4030 {
4031 dSP;
4032 SV* sv = newSVpv(p, 0);
4033
4034 PUSHMARK(sp);
4035 eval_sv(sv, G_SCALAR);
4036 SvREFCNT_dec(sv);
4037
4038 SPAGAIN;
4039 sv = POPs;
4040 PUTBACK;
4041
4042 if (croak_on_error && SvTRUE(GvSV(errgv)))
4043 croak(SvPVx(GvSV(errgv), na));
4044
4045 return sv;
4046 }
4047
4048 #endif
4049 #endif
4050
4051 #ifndef vload_module
4052 #if defined(NEED_vload_module)
4053 static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
4054 static
4055 #else
4056 extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
4057 #endif
4058
4059 #ifdef vload_module
4060 # undef vload_module
4061 #endif
4062 #define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
4063 #define Perl_vload_module DPPP_(my_vload_module)
4064
4065 #if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
4066
4067 void
DPPP_(my_vload_module)4068 DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
4069 {
4070 dTHR;
4071 dVAR;
4072 OP *veop, *imop;
4073
4074 OP * const modname = newSVOP(OP_CONST, 0, name);
4075 /* 5.005 has a somewhat hacky force_normal that doesn't croak on
4076 SvREADONLY() if PL_compling is true. Current perls take care in
4077 ck_require() to correctly turn off SvREADONLY before calling
4078 force_normal_flags(). This seems a better fix than fudging PL_compling
4079 */
4080 SvREADONLY_off(((SVOP*)modname)->op_sv);
4081 modname->op_private |= OPpCONST_BARE;
4082 if (ver) {
4083 veop = newSVOP(OP_CONST, 0, ver);
4084 }
4085 else
4086 veop = NULL;
4087 if (flags & PERL_LOADMOD_NOIMPORT) {
4088 imop = sawparens(newNULLLIST());
4089 }
4090 else if (flags & PERL_LOADMOD_IMPORT_OPS) {
4091 imop = va_arg(*args, OP*);
4092 }
4093 else {
4094 SV *sv;
4095 imop = NULL;
4096 sv = va_arg(*args, SV*);
4097 while (sv) {
4098 imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
4099 sv = va_arg(*args, SV*);
4100 }
4101 }
4102 {
4103 const line_t ocopline = PL_copline;
4104 COP * const ocurcop = PL_curcop;
4105 const int oexpect = PL_expect;
4106
4107 #if (PERL_BCDVERSION >= 0x5004000)
4108 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
4109 veop, modname, imop);
4110 #else
4111 utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
4112 modname, imop);
4113 #endif
4114 PL_expect = oexpect;
4115 PL_copline = ocopline;
4116 PL_curcop = ocurcop;
4117 }
4118 }
4119
4120 #endif
4121 #endif
4122
4123 #ifndef load_module
4124 #if defined(NEED_load_module)
4125 static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
4126 static
4127 #else
4128 extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
4129 #endif
4130
4131 #ifdef load_module
4132 # undef load_module
4133 #endif
4134 #define load_module DPPP_(my_load_module)
4135 #define Perl_load_module DPPP_(my_load_module)
4136
4137 #if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
4138
4139 void
DPPP_(my_load_module)4140 DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
4141 {
4142 va_list args;
4143 va_start(args, ver);
4144 vload_module(flags, name, ver, &args);
4145 va_end(args);
4146 }
4147
4148 #endif
4149 #endif
4150 #ifndef newRV_inc
4151 # define newRV_inc(sv) newRV(sv) /* Replace */
4152 #endif
4153
4154 #ifndef newRV_noinc
4155 #if defined(NEED_newRV_noinc)
4156 static SV * DPPP_(my_newRV_noinc)(SV *sv);
4157 static
4158 #else
4159 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
4160 #endif
4161
4162 #ifdef newRV_noinc
4163 # undef newRV_noinc
4164 #endif
4165 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
4166 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
4167
4168 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
4169 SV *
DPPP_(my_newRV_noinc)4170 DPPP_(my_newRV_noinc)(SV *sv)
4171 {
4172 SV *rv = (SV *)newRV(sv);
4173 SvREFCNT_dec(sv);
4174 return rv;
4175 }
4176 #endif
4177 #endif
4178
4179 /* Hint: newCONSTSUB
4180 * Returns a CV* as of perl-5.7.1. This return value is not supported
4181 * by Devel::PPPort.
4182 */
4183
4184 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
4185 #if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
4186 #if defined(NEED_newCONSTSUB)
4187 static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
4188 static
4189 #else
4190 extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
4191 #endif
4192
4193 #ifdef newCONSTSUB
4194 # undef newCONSTSUB
4195 #endif
4196 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
4197 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
4198
4199 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
4200
4201 void
DPPP_(my_newCONSTSUB)4202 DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
4203 {
4204 U32 oldhints = PL_hints;
4205 HV *old_cop_stash = PL_curcop->cop_stash;
4206 HV *old_curstash = PL_curstash;
4207 line_t oldline = PL_curcop->cop_line;
4208 PL_curcop->cop_line = PL_copline;
4209
4210 PL_hints &= ~HINT_BLOCK_SCOPE;
4211 if (stash)
4212 PL_curstash = PL_curcop->cop_stash = stash;
4213
4214 newSUB(
4215
4216 #if (PERL_BCDVERSION < 0x5003022)
4217 start_subparse(),
4218 #elif (PERL_BCDVERSION == 0x5003022)
4219 start_subparse(0),
4220 #else /* 5.003_23 onwards */
4221 start_subparse(FALSE, 0),
4222 #endif
4223
4224 newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
4225 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
4226 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
4227 );
4228
4229 PL_hints = oldhints;
4230 PL_curcop->cop_stash = old_cop_stash;
4231 PL_curstash = old_curstash;
4232 PL_curcop->cop_line = oldline;
4233 }
4234 #endif
4235 #endif
4236
4237 /*
4238 * Boilerplate macros for initializing and accessing interpreter-local
4239 * data from C. All statics in extensions should be reworked to use
4240 * this, if you want to make the extension thread-safe. See ext/re/re.xs
4241 * for an example of the use of these macros.
4242 *
4243 * Code that uses these macros is responsible for the following:
4244 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
4245 * 2. Declare a typedef named my_cxt_t that is a structure that contains
4246 * all the data that needs to be interpreter-local.
4247 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
4248 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
4249 * (typically put in the BOOT: section).
4250 * 5. Use the members of the my_cxt_t structure everywhere as
4251 * MY_CXT.member.
4252 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
4253 * access MY_CXT.
4254 */
4255
4256 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
4257 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
4258
4259 #ifndef START_MY_CXT
4260
4261 /* This must appear in all extensions that define a my_cxt_t structure,
4262 * right after the definition (i.e. at file scope). The non-threads
4263 * case below uses it to declare the data as static. */
4264 #define START_MY_CXT
4265
4266 #if (PERL_BCDVERSION < 0x5004068)
4267 /* Fetches the SV that keeps the per-interpreter data. */
4268 #define dMY_CXT_SV \
4269 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
4270 #else /* >= perl5.004_68 */
4271 #define dMY_CXT_SV \
4272 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
4273 sizeof(MY_CXT_KEY)-1, TRUE)
4274 #endif /* < perl5.004_68 */
4275
4276 /* This declaration should be used within all functions that use the
4277 * interpreter-local data. */
4278 #define dMY_CXT \
4279 dMY_CXT_SV; \
4280 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
4281
4282 /* Creates and zeroes the per-interpreter data.
4283 * (We allocate my_cxtp in a Perl SV so that it will be released when
4284 * the interpreter goes away.) */
4285 #define MY_CXT_INIT \
4286 dMY_CXT_SV; \
4287 /* newSV() allocates one more than needed */ \
4288 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4289 Zero(my_cxtp, 1, my_cxt_t); \
4290 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4291
4292 /* This macro must be used to access members of the my_cxt_t structure.
4293 * e.g. MYCXT.some_data */
4294 #define MY_CXT (*my_cxtp)
4295
4296 /* Judicious use of these macros can reduce the number of times dMY_CXT
4297 * is used. Use is similar to pTHX, aTHX etc. */
4298 #define pMY_CXT my_cxt_t *my_cxtp
4299 #define pMY_CXT_ pMY_CXT,
4300 #define _pMY_CXT ,pMY_CXT
4301 #define aMY_CXT my_cxtp
4302 #define aMY_CXT_ aMY_CXT,
4303 #define _aMY_CXT ,aMY_CXT
4304
4305 #endif /* START_MY_CXT */
4306
4307 #ifndef MY_CXT_CLONE
4308 /* Clones the per-interpreter data. */
4309 #define MY_CXT_CLONE \
4310 dMY_CXT_SV; \
4311 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
4312 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
4313 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
4314 #endif
4315
4316 #else /* single interpreter */
4317
4318 #ifndef START_MY_CXT
4319
4320 #define START_MY_CXT static my_cxt_t my_cxt;
4321 #define dMY_CXT_SV dNOOP
4322 #define dMY_CXT dNOOP
4323 #define MY_CXT_INIT NOOP
4324 #define MY_CXT my_cxt
4325
4326 #define pMY_CXT void
4327 #define pMY_CXT_
4328 #define _pMY_CXT
4329 #define aMY_CXT
4330 #define aMY_CXT_
4331 #define _aMY_CXT
4332
4333 #endif /* START_MY_CXT */
4334
4335 #ifndef MY_CXT_CLONE
4336 #define MY_CXT_CLONE NOOP
4337 #endif
4338
4339 #endif
4340
4341 #ifndef IVdf
4342 # if IVSIZE == LONGSIZE
4343 # define IVdf "ld"
4344 # define UVuf "lu"
4345 # define UVof "lo"
4346 # define UVxf "lx"
4347 # define UVXf "lX"
4348 # else
4349 # if IVSIZE == INTSIZE
4350 # define IVdf "d"
4351 # define UVuf "u"
4352 # define UVof "o"
4353 # define UVxf "x"
4354 # define UVXf "X"
4355 # endif
4356 # endif
4357 #endif
4358
4359 #ifndef NVef
4360 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
4361 defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
4362 # define NVef PERL_PRIeldbl
4363 # define NVff PERL_PRIfldbl
4364 # define NVgf PERL_PRIgldbl
4365 # else
4366 # define NVef "e"
4367 # define NVff "f"
4368 # define NVgf "g"
4369 # endif
4370 #endif
4371
4372 #ifndef SvREFCNT_inc
4373 # ifdef PERL_USE_GCC_BRACE_GROUPS
4374 # define SvREFCNT_inc(sv) \
4375 ({ \
4376 SV * const _sv = (SV*)(sv); \
4377 if (_sv) \
4378 (SvREFCNT(_sv))++; \
4379 _sv; \
4380 })
4381 # else
4382 # define SvREFCNT_inc(sv) \
4383 ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
4384 # endif
4385 #endif
4386
4387 #ifndef SvREFCNT_inc_simple
4388 # ifdef PERL_USE_GCC_BRACE_GROUPS
4389 # define SvREFCNT_inc_simple(sv) \
4390 ({ \
4391 if (sv) \
4392 (SvREFCNT(sv))++; \
4393 (SV *)(sv); \
4394 })
4395 # else
4396 # define SvREFCNT_inc_simple(sv) \
4397 ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
4398 # endif
4399 #endif
4400
4401 #ifndef SvREFCNT_inc_NN
4402 # ifdef PERL_USE_GCC_BRACE_GROUPS
4403 # define SvREFCNT_inc_NN(sv) \
4404 ({ \
4405 SV * const _sv = (SV*)(sv); \
4406 SvREFCNT(_sv)++; \
4407 _sv; \
4408 })
4409 # else
4410 # define SvREFCNT_inc_NN(sv) \
4411 (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
4412 # endif
4413 #endif
4414
4415 #ifndef SvREFCNT_inc_void
4416 # ifdef PERL_USE_GCC_BRACE_GROUPS
4417 # define SvREFCNT_inc_void(sv) \
4418 ({ \
4419 SV * const _sv = (SV*)(sv); \
4420 if (_sv) \
4421 (void)(SvREFCNT(_sv)++); \
4422 })
4423 # else
4424 # define SvREFCNT_inc_void(sv) \
4425 (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
4426 # endif
4427 #endif
4428 #ifndef SvREFCNT_inc_simple_void
4429 # define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
4430 #endif
4431
4432 #ifndef SvREFCNT_inc_simple_NN
4433 # define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
4434 #endif
4435
4436 #ifndef SvREFCNT_inc_void_NN
4437 # define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
4438 #endif
4439
4440 #ifndef SvREFCNT_inc_simple_void_NN
4441 # define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
4442 #endif
4443
4444 /* Backwards compatibility stuff... :-( */
4445 #if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
4446 # define NEED_sv_2pv_flags
4447 #endif
4448 #if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
4449 # define NEED_sv_2pv_flags_GLOBAL
4450 #endif
4451
4452 /* Hint: sv_2pv_nolen
4453 * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
4454 */
4455 #ifndef sv_2pv_nolen
4456 # define sv_2pv_nolen(sv) SvPV_nolen(sv)
4457 #endif
4458
4459 #ifdef SvPVbyte
4460
4461 /* Hint: SvPVbyte
4462 * Does not work in perl-5.6.1, ppport.h implements a version
4463 * borrowed from perl-5.7.3.
4464 */
4465
4466 #if (PERL_BCDVERSION < 0x5007000)
4467
4468 #if defined(NEED_sv_2pvbyte)
4469 static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV * sv, STRLEN * lp);
4470 static
4471 #else
4472 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV * sv, STRLEN * lp);
4473 #endif
4474
4475 #ifdef sv_2pvbyte
4476 # undef sv_2pvbyte
4477 #endif
4478 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
4479 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
4480
4481 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
4482
4483 char *
DPPP_(my_sv_2pvbyte)4484 DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
4485 {
4486 sv_utf8_downgrade(sv,0);
4487 return SvPV(sv,*lp);
4488 }
4489
4490 #endif
4491
4492 /* Hint: sv_2pvbyte
4493 * Use the SvPVbyte() macro instead of sv_2pvbyte().
4494 */
4495
4496 #undef SvPVbyte
4497
4498 #define SvPVbyte(sv, lp) \
4499 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
4500 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
4501
4502 #endif
4503
4504 #else
4505
4506 # define SvPVbyte SvPV
4507 # define sv_2pvbyte sv_2pv
4508
4509 #endif
4510 #ifndef sv_2pvbyte_nolen
4511 # define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
4512 #endif
4513
4514 /* Hint: sv_pvn
4515 * Always use the SvPV() macro instead of sv_pvn().
4516 */
4517
4518 /* Hint: sv_pvn_force
4519 * Always use the SvPV_force() macro instead of sv_pvn_force().
4520 */
4521
4522 /* If these are undefined, they're not handled by the core anyway */
4523 #ifndef SV_IMMEDIATE_UNREF
4524 # define SV_IMMEDIATE_UNREF 0
4525 #endif
4526
4527 #ifndef SV_GMAGIC
4528 # define SV_GMAGIC 0
4529 #endif
4530
4531 #ifndef SV_COW_DROP_PV
4532 # define SV_COW_DROP_PV 0
4533 #endif
4534
4535 #ifndef SV_UTF8_NO_ENCODING
4536 # define SV_UTF8_NO_ENCODING 0
4537 #endif
4538
4539 #ifndef SV_NOSTEAL
4540 # define SV_NOSTEAL 0
4541 #endif
4542
4543 #ifndef SV_CONST_RETURN
4544 # define SV_CONST_RETURN 0
4545 #endif
4546
4547 #ifndef SV_MUTABLE_RETURN
4548 # define SV_MUTABLE_RETURN 0
4549 #endif
4550
4551 #ifndef SV_SMAGIC
4552 # define SV_SMAGIC 0
4553 #endif
4554
4555 #ifndef SV_HAS_TRAILING_NUL
4556 # define SV_HAS_TRAILING_NUL 0
4557 #endif
4558
4559 #ifndef SV_COW_SHARED_HASH_KEYS
4560 # define SV_COW_SHARED_HASH_KEYS 0
4561 #endif
4562
4563 #if (PERL_BCDVERSION < 0x5007002)
4564
4565 #if defined(NEED_sv_2pv_flags)
4566 static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags);
4567 static
4568 #else
4569 extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags);
4570 #endif
4571
4572 #ifdef sv_2pv_flags
4573 # undef sv_2pv_flags
4574 #endif
4575 #define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
4576 #define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
4577
4578 #if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
4579
4580 char *
DPPP_(my_sv_2pv_flags)4581 DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
4582 {
4583 STRLEN n_a = (STRLEN) flags;
4584 return sv_2pv(sv, lp ? lp : &n_a);
4585 }
4586
4587 #endif
4588
4589 #if defined(NEED_sv_pvn_force_flags)
4590 static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags);
4591 static
4592 #else
4593 extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV * sv, STRLEN * lp, I32 flags);
4594 #endif
4595
4596 #ifdef sv_pvn_force_flags
4597 # undef sv_pvn_force_flags
4598 #endif
4599 #define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
4600 #define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
4601
4602 #if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
4603
4604 char *
DPPP_(my_sv_pvn_force_flags)4605 DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
4606 {
4607 STRLEN n_a = (STRLEN) flags;
4608 return sv_pvn_force(sv, lp ? lp : &n_a);
4609 }
4610
4611 #endif
4612
4613 #endif
4614 #ifndef SvPV_const
4615 # define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
4616 #endif
4617
4618 #ifndef SvPV_mutable
4619 # define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
4620 #endif
4621 #ifndef SvPV_flags
4622 # define SvPV_flags(sv, lp, flags) \
4623 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4624 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
4625 #endif
4626 #ifndef SvPV_flags_const
4627 # define SvPV_flags_const(sv, lp, flags) \
4628 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4629 ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
4630 (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
4631 #endif
4632 #ifndef SvPV_flags_const_nolen
4633 # define SvPV_flags_const_nolen(sv, flags) \
4634 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4635 ? SvPVX_const(sv) : \
4636 (const char*) sv_2pv_flags(sv, 0, flags|SV_CONST_RETURN))
4637 #endif
4638 #ifndef SvPV_flags_mutable
4639 # define SvPV_flags_mutable(sv, lp, flags) \
4640 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4641 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
4642 sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
4643 #endif
4644 #ifndef SvPV_force
4645 # define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
4646 #endif
4647
4648 #ifndef SvPV_force_nolen
4649 # define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
4650 #endif
4651
4652 #ifndef SvPV_force_mutable
4653 # define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
4654 #endif
4655
4656 #ifndef SvPV_force_nomg
4657 # define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
4658 #endif
4659
4660 #ifndef SvPV_force_nomg_nolen
4661 # define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
4662 #endif
4663 #ifndef SvPV_force_flags
4664 # define SvPV_force_flags(sv, lp, flags) \
4665 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
4666 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
4667 #endif
4668 #ifndef SvPV_force_flags_nolen
4669 # define SvPV_force_flags_nolen(sv, flags) \
4670 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
4671 ? SvPVX(sv) : sv_pvn_force_flags(sv, 0, flags))
4672 #endif
4673 #ifndef SvPV_force_flags_mutable
4674 # define SvPV_force_flags_mutable(sv, lp, flags) \
4675 ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
4676 ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
4677 : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
4678 #endif
4679 #ifndef SvPV_nolen
4680 # define SvPV_nolen(sv) \
4681 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4682 ? SvPVX(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC))
4683 #endif
4684 #ifndef SvPV_nolen_const
4685 # define SvPV_nolen_const(sv) \
4686 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
4687 ? SvPVX_const(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC|SV_CONST_RETURN))
4688 #endif
4689 #ifndef SvPV_nomg
4690 # define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
4691 #endif
4692
4693 #ifndef SvPV_nomg_const
4694 # define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
4695 #endif
4696
4697 #ifndef SvPV_nomg_const_nolen
4698 # define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
4699 #endif
4700 #ifndef SvMAGIC_set
4701 # define SvMAGIC_set(sv, val) \
4702 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
4703 (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
4704 #endif
4705
4706 #if (PERL_BCDVERSION < 0x5009003)
4707 #ifndef SvPVX_const
4708 # define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
4709 #endif
4710
4711 #ifndef SvPVX_mutable
4712 # define SvPVX_mutable(sv) (0 + SvPVX(sv))
4713 #endif
4714 #ifndef SvRV_set
4715 # define SvRV_set(sv, val) \
4716 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
4717 (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
4718 #endif
4719
4720 #else
4721 #ifndef SvPVX_const
4722 # define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
4723 #endif
4724
4725 #ifndef SvPVX_mutable
4726 # define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
4727 #endif
4728 #ifndef SvRV_set
4729 # define SvRV_set(sv, val) \
4730 STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
4731 ((sv)->sv_u.svu_rv = (val)); } STMT_END
4732 #endif
4733
4734 #endif
4735 #ifndef SvSTASH_set
4736 # define SvSTASH_set(sv, val) \
4737 STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
4738 (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
4739 #endif
4740
4741 #if (PERL_BCDVERSION < 0x5004000)
4742 #ifndef SvUV_set
4743 # define SvUV_set(sv, val) \
4744 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
4745 (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
4746 #endif
4747
4748 #else
4749 #ifndef SvUV_set
4750 # define SvUV_set(sv, val) \
4751 STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
4752 (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
4753 #endif
4754
4755 #endif
4756
4757 #if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
4758 #if defined(NEED_vnewSVpvf)
4759 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
4760 static
4761 #else
4762 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
4763 #endif
4764
4765 #ifdef vnewSVpvf
4766 # undef vnewSVpvf
4767 #endif
4768 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
4769 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
4770
4771 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
4772
4773 SV *
DPPP_(my_vnewSVpvf)4774 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
4775 {
4776 register SV *sv = newSV(0);
4777 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
4778 return sv;
4779 }
4780
4781 #endif
4782 #endif
4783
4784 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
4785 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
4786 #endif
4787
4788 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
4789 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
4790 #endif
4791
4792 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
4793 #if defined(NEED_sv_catpvf_mg)
4794 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
4795 static
4796 #else
4797 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
4798 #endif
4799
4800 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
4801
4802 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
4803
4804 void
DPPP_(my_sv_catpvf_mg)4805 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
4806 {
4807 va_list args;
4808 va_start(args, pat);
4809 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4810 SvSETMAGIC(sv);
4811 va_end(args);
4812 }
4813
4814 #endif
4815 #endif
4816
4817 #ifdef PERL_IMPLICIT_CONTEXT
4818 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg_nocontext)
4819 #if defined(NEED_sv_catpvf_mg_nocontext)
4820 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
4821 static
4822 #else
4823 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
4824 #endif
4825
4826 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
4827 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
4828
4829 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
4830
4831 void
DPPP_(my_sv_catpvf_mg_nocontext)4832 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
4833 {
4834 dTHX;
4835 va_list args;
4836 va_start(args, pat);
4837 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4838 SvSETMAGIC(sv);
4839 va_end(args);
4840 }
4841
4842 #endif
4843 #endif
4844 #endif
4845
4846 /* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
4847 #ifndef sv_catpvf_mg
4848 # ifdef PERL_IMPLICIT_CONTEXT
4849 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
4850 # else
4851 # define sv_catpvf_mg Perl_sv_catpvf_mg
4852 # endif
4853 #endif
4854
4855 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf_mg)
4856 # define sv_vcatpvf_mg(sv, pat, args) \
4857 STMT_START { \
4858 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
4859 SvSETMAGIC(sv); \
4860 } STMT_END
4861 #endif
4862
4863 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
4864 #if defined(NEED_sv_setpvf_mg)
4865 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
4866 static
4867 #else
4868 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
4869 #endif
4870
4871 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
4872
4873 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
4874
4875 void
DPPP_(my_sv_setpvf_mg)4876 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
4877 {
4878 va_list args;
4879 va_start(args, pat);
4880 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4881 SvSETMAGIC(sv);
4882 va_end(args);
4883 }
4884
4885 #endif
4886 #endif
4887
4888 #ifdef PERL_IMPLICIT_CONTEXT
4889 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg_nocontext)
4890 #if defined(NEED_sv_setpvf_mg_nocontext)
4891 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
4892 static
4893 #else
4894 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
4895 #endif
4896
4897 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
4898 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
4899
4900 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
4901
4902 void
DPPP_(my_sv_setpvf_mg_nocontext)4903 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
4904 {
4905 dTHX;
4906 va_list args;
4907 va_start(args, pat);
4908 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
4909 SvSETMAGIC(sv);
4910 va_end(args);
4911 }
4912
4913 #endif
4914 #endif
4915 #endif
4916
4917 /* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
4918 #ifndef sv_setpvf_mg
4919 # ifdef PERL_IMPLICIT_CONTEXT
4920 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
4921 # else
4922 # define sv_setpvf_mg Perl_sv_setpvf_mg
4923 # endif
4924 #endif
4925
4926 #if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf_mg)
4927 # define sv_vsetpvf_mg(sv, pat, args) \
4928 STMT_START { \
4929 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
4930 SvSETMAGIC(sv); \
4931 } STMT_END
4932 #endif
4933
4934 #ifndef newSVpvn_share
4935
4936 #if defined(NEED_newSVpvn_share)
4937 static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
4938 static
4939 #else
4940 extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
4941 #endif
4942
4943 #ifdef newSVpvn_share
4944 # undef newSVpvn_share
4945 #endif
4946 #define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
4947 #define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
4948
4949 #if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
4950
4951 SV *
DPPP_(my_newSVpvn_share)4952 DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
4953 {
4954 SV *sv;
4955 if (len < 0)
4956 len = -len;
4957 if (!hash)
4958 PERL_HASH(hash, (char*) src, len);
4959 sv = newSVpvn((char *) src, len);
4960 sv_upgrade(sv, SVt_PVIV);
4961 SvIVX(sv) = hash;
4962 SvREADONLY_on(sv);
4963 SvPOK_on(sv);
4964 return sv;
4965 }
4966
4967 #endif
4968
4969 #endif
4970 #ifndef SvSHARED_HASH
4971 # define SvSHARED_HASH(sv) (0 + SvUVX(sv))
4972 #endif
4973 #ifndef WARN_ALL
4974 # define WARN_ALL 0
4975 #endif
4976
4977 #ifndef WARN_CLOSURE
4978 # define WARN_CLOSURE 1
4979 #endif
4980
4981 #ifndef WARN_DEPRECATED
4982 # define WARN_DEPRECATED 2
4983 #endif
4984
4985 #ifndef WARN_EXITING
4986 # define WARN_EXITING 3
4987 #endif
4988
4989 #ifndef WARN_GLOB
4990 # define WARN_GLOB 4
4991 #endif
4992
4993 #ifndef WARN_IO
4994 # define WARN_IO 5
4995 #endif
4996
4997 #ifndef WARN_CLOSED
4998 # define WARN_CLOSED 6
4999 #endif
5000
5001 #ifndef WARN_EXEC
5002 # define WARN_EXEC 7
5003 #endif
5004
5005 #ifndef WARN_LAYER
5006 # define WARN_LAYER 8
5007 #endif
5008
5009 #ifndef WARN_NEWLINE
5010 # define WARN_NEWLINE 9
5011 #endif
5012
5013 #ifndef WARN_PIPE
5014 # define WARN_PIPE 10
5015 #endif
5016
5017 #ifndef WARN_UNOPENED
5018 # define WARN_UNOPENED 11
5019 #endif
5020
5021 #ifndef WARN_MISC
5022 # define WARN_MISC 12
5023 #endif
5024
5025 #ifndef WARN_NUMERIC
5026 # define WARN_NUMERIC 13
5027 #endif
5028
5029 #ifndef WARN_ONCE
5030 # define WARN_ONCE 14
5031 #endif
5032
5033 #ifndef WARN_OVERFLOW
5034 # define WARN_OVERFLOW 15
5035 #endif
5036
5037 #ifndef WARN_PACK
5038 # define WARN_PACK 16
5039 #endif
5040
5041 #ifndef WARN_PORTABLE
5042 # define WARN_PORTABLE 17
5043 #endif
5044
5045 #ifndef WARN_RECURSION
5046 # define WARN_RECURSION 18
5047 #endif
5048
5049 #ifndef WARN_REDEFINE
5050 # define WARN_REDEFINE 19
5051 #endif
5052
5053 #ifndef WARN_REGEXP
5054 # define WARN_REGEXP 20
5055 #endif
5056
5057 #ifndef WARN_SEVERE
5058 # define WARN_SEVERE 21
5059 #endif
5060
5061 #ifndef WARN_DEBUGGING
5062 # define WARN_DEBUGGING 22
5063 #endif
5064
5065 #ifndef WARN_INPLACE
5066 # define WARN_INPLACE 23
5067 #endif
5068
5069 #ifndef WARN_INTERNAL
5070 # define WARN_INTERNAL 24
5071 #endif
5072
5073 #ifndef WARN_MALLOC
5074 # define WARN_MALLOC 25
5075 #endif
5076
5077 #ifndef WARN_SIGNAL
5078 # define WARN_SIGNAL 26
5079 #endif
5080
5081 #ifndef WARN_SUBSTR
5082 # define WARN_SUBSTR 27
5083 #endif
5084
5085 #ifndef WARN_SYNTAX
5086 # define WARN_SYNTAX 28
5087 #endif
5088
5089 #ifndef WARN_AMBIGUOUS
5090 # define WARN_AMBIGUOUS 29
5091 #endif
5092
5093 #ifndef WARN_BAREWORD
5094 # define WARN_BAREWORD 30
5095 #endif
5096
5097 #ifndef WARN_DIGIT
5098 # define WARN_DIGIT 31
5099 #endif
5100
5101 #ifndef WARN_PARENTHESIS
5102 # define WARN_PARENTHESIS 32
5103 #endif
5104
5105 #ifndef WARN_PRECEDENCE
5106 # define WARN_PRECEDENCE 33
5107 #endif
5108
5109 #ifndef WARN_PRINTF
5110 # define WARN_PRINTF 34
5111 #endif
5112
5113 #ifndef WARN_PROTOTYPE
5114 # define WARN_PROTOTYPE 35
5115 #endif
5116
5117 #ifndef WARN_QW
5118 # define WARN_QW 36
5119 #endif
5120
5121 #ifndef WARN_RESERVED
5122 # define WARN_RESERVED 37
5123 #endif
5124
5125 #ifndef WARN_SEMICOLON
5126 # define WARN_SEMICOLON 38
5127 #endif
5128
5129 #ifndef WARN_TAINT
5130 # define WARN_TAINT 39
5131 #endif
5132
5133 #ifndef WARN_THREADS
5134 # define WARN_THREADS 40
5135 #endif
5136
5137 #ifndef WARN_UNINITIALIZED
5138 # define WARN_UNINITIALIZED 41
5139 #endif
5140
5141 #ifndef WARN_UNPACK
5142 # define WARN_UNPACK 42
5143 #endif
5144
5145 #ifndef WARN_UNTIE
5146 # define WARN_UNTIE 43
5147 #endif
5148
5149 #ifndef WARN_UTF8
5150 # define WARN_UTF8 44
5151 #endif
5152
5153 #ifndef WARN_VOID
5154 # define WARN_VOID 45
5155 #endif
5156
5157 #ifndef WARN_ASSERTIONS
5158 # define WARN_ASSERTIONS 46
5159 #endif
5160 #ifndef packWARN
5161 # define packWARN(a) (a)
5162 #endif
5163
5164 #ifndef ckWARN
5165 # ifdef G_WARN_ON
5166 # define ckWARN(a) (PL_dowarn & G_WARN_ON)
5167 # else
5168 # define ckWARN(a) PL_dowarn
5169 # endif
5170 #endif
5171
5172 #if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
5173 #if defined(NEED_warner)
5174 static void DPPP_(my_warner)(U32 err, const char *pat, ...);
5175 static
5176 #else
5177 extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
5178 #endif
5179
5180 #define Perl_warner DPPP_(my_warner)
5181
5182 #if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
5183
5184 void
DPPP_(my_warner)5185 DPPP_(my_warner)(U32 err, const char *pat, ...)
5186 {
5187 SV *sv;
5188 va_list args;
5189
5190 PERL_UNUSED_ARG(err);
5191
5192 va_start(args, pat);
5193 sv = vnewSVpvf(pat, &args);
5194 va_end(args);
5195 sv_2mortal(sv);
5196 warn("%s", SvPV_nolen(sv));
5197 }
5198
5199 #define warner Perl_warner
5200
5201 #define Perl_warner_nocontext Perl_warner
5202
5203 #endif
5204 #endif
5205
5206 /* concatenating with "" ensures that only literal strings are accepted as argument
5207 * note that STR_WITH_LEN() can't be used as argument to macros or functions that
5208 * under some configurations might be macros
5209 */
5210 #ifndef STR_WITH_LEN
5211 # define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
5212 #endif
5213 #ifndef newSVpvs
5214 # define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
5215 #endif
5216
5217 #ifndef sv_catpvs
5218 # define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
5219 #endif
5220
5221 #ifndef sv_setpvs
5222 # define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
5223 #endif
5224
5225 #ifndef hv_fetchs
5226 # define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
5227 #endif
5228
5229 #ifndef hv_stores
5230 # define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
5231 #endif
5232 #ifndef SvGETMAGIC
5233 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
5234 #endif
5235 #ifndef PERL_MAGIC_sv
5236 # define PERL_MAGIC_sv '\0'
5237 #endif
5238
5239 #ifndef PERL_MAGIC_overload
5240 # define PERL_MAGIC_overload 'A'
5241 #endif
5242
5243 #ifndef PERL_MAGIC_overload_elem
5244 # define PERL_MAGIC_overload_elem 'a'
5245 #endif
5246
5247 #ifndef PERL_MAGIC_overload_table
5248 # define PERL_MAGIC_overload_table 'c'
5249 #endif
5250
5251 #ifndef PERL_MAGIC_bm
5252 # define PERL_MAGIC_bm 'B'
5253 #endif
5254
5255 #ifndef PERL_MAGIC_regdata
5256 # define PERL_MAGIC_regdata 'D'
5257 #endif
5258
5259 #ifndef PERL_MAGIC_regdatum
5260 # define PERL_MAGIC_regdatum 'd'
5261 #endif
5262
5263 #ifndef PERL_MAGIC_env
5264 # define PERL_MAGIC_env 'E'
5265 #endif
5266
5267 #ifndef PERL_MAGIC_envelem
5268 # define PERL_MAGIC_envelem 'e'
5269 #endif
5270
5271 #ifndef PERL_MAGIC_fm
5272 # define PERL_MAGIC_fm 'f'
5273 #endif
5274
5275 #ifndef PERL_MAGIC_regex_global
5276 # define PERL_MAGIC_regex_global 'g'
5277 #endif
5278
5279 #ifndef PERL_MAGIC_isa
5280 # define PERL_MAGIC_isa 'I'
5281 #endif
5282
5283 #ifndef PERL_MAGIC_isaelem
5284 # define PERL_MAGIC_isaelem 'i'
5285 #endif
5286
5287 #ifndef PERL_MAGIC_nkeys
5288 # define PERL_MAGIC_nkeys 'k'
5289 #endif
5290
5291 #ifndef PERL_MAGIC_dbfile
5292 # define PERL_MAGIC_dbfile 'L'
5293 #endif
5294
5295 #ifndef PERL_MAGIC_dbline
5296 # define PERL_MAGIC_dbline 'l'
5297 #endif
5298
5299 #ifndef PERL_MAGIC_mutex
5300 # define PERL_MAGIC_mutex 'm'
5301 #endif
5302
5303 #ifndef PERL_MAGIC_shared
5304 # define PERL_MAGIC_shared 'N'
5305 #endif
5306
5307 #ifndef PERL_MAGIC_shared_scalar
5308 # define PERL_MAGIC_shared_scalar 'n'
5309 #endif
5310
5311 #ifndef PERL_MAGIC_collxfrm
5312 # define PERL_MAGIC_collxfrm 'o'
5313 #endif
5314
5315 #ifndef PERL_MAGIC_tied
5316 # define PERL_MAGIC_tied 'P'
5317 #endif
5318
5319 #ifndef PERL_MAGIC_tiedelem
5320 # define PERL_MAGIC_tiedelem 'p'
5321 #endif
5322
5323 #ifndef PERL_MAGIC_tiedscalar
5324 # define PERL_MAGIC_tiedscalar 'q'
5325 #endif
5326
5327 #ifndef PERL_MAGIC_qr
5328 # define PERL_MAGIC_qr 'r'
5329 #endif
5330
5331 #ifndef PERL_MAGIC_sig
5332 # define PERL_MAGIC_sig 'S'
5333 #endif
5334
5335 #ifndef PERL_MAGIC_sigelem
5336 # define PERL_MAGIC_sigelem 's'
5337 #endif
5338
5339 #ifndef PERL_MAGIC_taint
5340 # define PERL_MAGIC_taint 't'
5341 #endif
5342
5343 #ifndef PERL_MAGIC_uvar
5344 # define PERL_MAGIC_uvar 'U'
5345 #endif
5346
5347 #ifndef PERL_MAGIC_uvar_elem
5348 # define PERL_MAGIC_uvar_elem 'u'
5349 #endif
5350
5351 #ifndef PERL_MAGIC_vstring
5352 # define PERL_MAGIC_vstring 'V'
5353 #endif
5354
5355 #ifndef PERL_MAGIC_vec
5356 # define PERL_MAGIC_vec 'v'
5357 #endif
5358
5359 #ifndef PERL_MAGIC_utf8
5360 # define PERL_MAGIC_utf8 'w'
5361 #endif
5362
5363 #ifndef PERL_MAGIC_substr
5364 # define PERL_MAGIC_substr 'x'
5365 #endif
5366
5367 #ifndef PERL_MAGIC_defelem
5368 # define PERL_MAGIC_defelem 'y'
5369 #endif
5370
5371 #ifndef PERL_MAGIC_glob
5372 # define PERL_MAGIC_glob '*'
5373 #endif
5374
5375 #ifndef PERL_MAGIC_arylen
5376 # define PERL_MAGIC_arylen '#'
5377 #endif
5378
5379 #ifndef PERL_MAGIC_pos
5380 # define PERL_MAGIC_pos '.'
5381 #endif
5382
5383 #ifndef PERL_MAGIC_backref
5384 # define PERL_MAGIC_backref '<'
5385 #endif
5386
5387 #ifndef PERL_MAGIC_ext
5388 # define PERL_MAGIC_ext '~'
5389 #endif
5390
5391 /* That's the best we can do... */
5392 #ifndef sv_catpvn_nomg
5393 # define sv_catpvn_nomg sv_catpvn
5394 #endif
5395
5396 #ifndef sv_catsv_nomg
5397 # define sv_catsv_nomg sv_catsv
5398 #endif
5399
5400 #ifndef sv_setsv_nomg
5401 # define sv_setsv_nomg sv_setsv
5402 #endif
5403
5404 #ifndef sv_pvn_nomg
5405 # define sv_pvn_nomg sv_pvn
5406 #endif
5407
5408 #ifndef SvIV_nomg
5409 # define SvIV_nomg SvIV
5410 #endif
5411
5412 #ifndef SvUV_nomg
5413 # define SvUV_nomg SvUV
5414 #endif
5415
5416 #ifndef sv_catpv_mg
5417 # define sv_catpv_mg(sv, ptr) \
5418 STMT_START { \
5419 SV *TeMpSv = sv; \
5420 sv_catpv(TeMpSv,ptr); \
5421 SvSETMAGIC(TeMpSv); \
5422 } STMT_END
5423 #endif
5424
5425 #ifndef sv_catpvn_mg
5426 # define sv_catpvn_mg(sv, ptr, len) \
5427 STMT_START { \
5428 SV *TeMpSv = sv; \
5429 sv_catpvn(TeMpSv,ptr,len); \
5430 SvSETMAGIC(TeMpSv); \
5431 } STMT_END
5432 #endif
5433
5434 #ifndef sv_catsv_mg
5435 # define sv_catsv_mg(dsv, ssv) \
5436 STMT_START { \
5437 SV *TeMpSv = dsv; \
5438 sv_catsv(TeMpSv,ssv); \
5439 SvSETMAGIC(TeMpSv); \
5440 } STMT_END
5441 #endif
5442
5443 #ifndef sv_setiv_mg
5444 # define sv_setiv_mg(sv, i) \
5445 STMT_START { \
5446 SV *TeMpSv = sv; \
5447 sv_setiv(TeMpSv,i); \
5448 SvSETMAGIC(TeMpSv); \
5449 } STMT_END
5450 #endif
5451
5452 #ifndef sv_setnv_mg
5453 # define sv_setnv_mg(sv, num) \
5454 STMT_START { \
5455 SV *TeMpSv = sv; \
5456 sv_setnv(TeMpSv,num); \
5457 SvSETMAGIC(TeMpSv); \
5458 } STMT_END
5459 #endif
5460
5461 #ifndef sv_setpv_mg
5462 # define sv_setpv_mg(sv, ptr) \
5463 STMT_START { \
5464 SV *TeMpSv = sv; \
5465 sv_setpv(TeMpSv,ptr); \
5466 SvSETMAGIC(TeMpSv); \
5467 } STMT_END
5468 #endif
5469
5470 #ifndef sv_setpvn_mg
5471 # define sv_setpvn_mg(sv, ptr, len) \
5472 STMT_START { \
5473 SV *TeMpSv = sv; \
5474 sv_setpvn(TeMpSv,ptr,len); \
5475 SvSETMAGIC(TeMpSv); \
5476 } STMT_END
5477 #endif
5478
5479 #ifndef sv_setsv_mg
5480 # define sv_setsv_mg(dsv, ssv) \
5481 STMT_START { \
5482 SV *TeMpSv = dsv; \
5483 sv_setsv(TeMpSv,ssv); \
5484 SvSETMAGIC(TeMpSv); \
5485 } STMT_END
5486 #endif
5487
5488 #ifndef sv_setuv_mg
5489 # define sv_setuv_mg(sv, i) \
5490 STMT_START { \
5491 SV *TeMpSv = sv; \
5492 sv_setuv(TeMpSv,i); \
5493 SvSETMAGIC(TeMpSv); \
5494 } STMT_END
5495 #endif
5496
5497 #ifndef sv_usepvn_mg
5498 # define sv_usepvn_mg(sv, ptr, len) \
5499 STMT_START { \
5500 SV *TeMpSv = sv; \
5501 sv_usepvn(TeMpSv,ptr,len); \
5502 SvSETMAGIC(TeMpSv); \
5503 } STMT_END
5504 #endif
5505 #ifndef SvVSTRING_mg
5506 # define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
5507 #endif
5508
5509 /* Hint: sv_magic_portable
5510 * This is a compatibility function that is only available with
5511 * Devel::PPPort. It is NOT in the perl core.
5512 * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
5513 * it is being passed a name pointer with namlen == 0. In that
5514 * case, perl 5.8.0 and later store the pointer, not a copy of it.
5515 * The compatibility can be provided back to perl 5.004. With
5516 * earlier versions, the code will not compile.
5517 */
5518
5519 #if (PERL_BCDVERSION < 0x5004000)
5520
5521 /* code that uses sv_magic_portable will not compile */
5522
5523 #elif (PERL_BCDVERSION < 0x5008000)
5524
5525 # define sv_magic_portable(sv, obj, how, name, namlen) \
5526 STMT_START { \
5527 SV *SvMp_sv = (sv); \
5528 char *SvMp_name = (char *) (name); \
5529 I32 SvMp_namlen = (namlen); \
5530 if (SvMp_name && SvMp_namlen == 0) \
5531 { \
5532 MAGIC *mg; \
5533 sv_magic(SvMp_sv, obj, how, 0, 0); \
5534 mg = SvMAGIC(SvMp_sv); \
5535 mg->mg_len = -42; /* XXX: this is the tricky part */ \
5536 mg->mg_ptr = SvMp_name; \
5537 } \
5538 else \
5539 { \
5540 sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
5541 } \
5542 } STMT_END
5543
5544 #else
5545
5546 # define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
5547
5548 #endif
5549
5550 #ifdef USE_ITHREADS
5551 #ifndef CopFILE
5552 # define CopFILE(c) ((c)->cop_file)
5553 #endif
5554
5555 #ifndef CopFILEGV
5556 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
5557 #endif
5558
5559 #ifndef CopFILE_set
5560 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
5561 #endif
5562
5563 #ifndef CopFILESV
5564 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
5565 #endif
5566
5567 #ifndef CopFILEAV
5568 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
5569 #endif
5570
5571 #ifndef CopSTASHPV
5572 # define CopSTASHPV(c) ((c)->cop_stashpv)
5573 #endif
5574
5575 #ifndef CopSTASHPV_set
5576 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
5577 #endif
5578
5579 #ifndef CopSTASH
5580 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
5581 #endif
5582
5583 #ifndef CopSTASH_set
5584 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
5585 #endif
5586
5587 #ifndef CopSTASH_eq
5588 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
5589 || (CopSTASHPV(c) && HvNAME(hv) \
5590 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
5591 #endif
5592
5593 #else
5594 #ifndef CopFILEGV
5595 # define CopFILEGV(c) ((c)->cop_filegv)
5596 #endif
5597
5598 #ifndef CopFILEGV_set
5599 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
5600 #endif
5601
5602 #ifndef CopFILE_set
5603 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
5604 #endif
5605
5606 #ifndef CopFILESV
5607 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
5608 #endif
5609
5610 #ifndef CopFILEAV
5611 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
5612 #endif
5613
5614 #ifndef CopFILE
5615 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
5616 #endif
5617
5618 #ifndef CopSTASH
5619 # define CopSTASH(c) ((c)->cop_stash)
5620 #endif
5621
5622 #ifndef CopSTASH_set
5623 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
5624 #endif
5625
5626 #ifndef CopSTASHPV
5627 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
5628 #endif
5629
5630 #ifndef CopSTASHPV_set
5631 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
5632 #endif
5633
5634 #ifndef CopSTASH_eq
5635 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
5636 #endif
5637
5638 #endif /* USE_ITHREADS */
5639 #ifndef IN_PERL_COMPILETIME
5640 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
5641 #endif
5642
5643 #ifndef IN_LOCALE_RUNTIME
5644 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
5645 #endif
5646
5647 #ifndef IN_LOCALE_COMPILETIME
5648 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
5649 #endif
5650
5651 #ifndef IN_LOCALE
5652 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
5653 #endif
5654 #ifndef IS_NUMBER_IN_UV
5655 # define IS_NUMBER_IN_UV 0x01
5656 #endif
5657
5658 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
5659 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
5660 #endif
5661
5662 #ifndef IS_NUMBER_NOT_INT
5663 # define IS_NUMBER_NOT_INT 0x04
5664 #endif
5665
5666 #ifndef IS_NUMBER_NEG
5667 # define IS_NUMBER_NEG 0x08
5668 #endif
5669
5670 #ifndef IS_NUMBER_INFINITY
5671 # define IS_NUMBER_INFINITY 0x10
5672 #endif
5673
5674 #ifndef IS_NUMBER_NAN
5675 # define IS_NUMBER_NAN 0x20
5676 #endif
5677 #ifndef GROK_NUMERIC_RADIX
5678 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
5679 #endif
5680 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
5681 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
5682 #endif
5683
5684 #ifndef PERL_SCAN_SILENT_ILLDIGIT
5685 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
5686 #endif
5687
5688 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
5689 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
5690 #endif
5691
5692 #ifndef PERL_SCAN_DISALLOW_PREFIX
5693 # define PERL_SCAN_DISALLOW_PREFIX 0x02
5694 #endif
5695
5696 #ifndef grok_numeric_radix
5697 #if defined(NEED_grok_numeric_radix)
5698 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
5699 static
5700 #else
5701 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
5702 #endif
5703
5704 #ifdef grok_numeric_radix
5705 # undef grok_numeric_radix
5706 #endif
5707 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
5708 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
5709
5710 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
5711 bool
DPPP_(my_grok_numeric_radix)5712 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
5713 {
5714 #ifdef USE_LOCALE_NUMERIC
5715 #ifdef PL_numeric_radix_sv
5716 if (PL_numeric_radix_sv && IN_LOCALE) {
5717 STRLEN len;
5718 char* radix = SvPV(PL_numeric_radix_sv, len);
5719 if (*sp + len <= send && memEQ(*sp, radix, len)) {
5720 *sp += len;
5721 return TRUE;
5722 }
5723 }
5724 #else
5725 /* older perls don't have PL_numeric_radix_sv so the radix
5726 * must manually be requested from locale.h
5727 */
5728 #include <locale.h>
5729 dTHR; /* needed for older threaded perls */
5730 struct lconv *lc = localeconv();
5731 char *radix = lc->decimal_point;
5732 if (radix && IN_LOCALE) {
5733 STRLEN len = strlen(radix);
5734 if (*sp + len <= send && memEQ(*sp, radix, len)) {
5735 *sp += len;
5736 return TRUE;
5737 }
5738 }
5739 #endif
5740 #endif /* USE_LOCALE_NUMERIC */
5741 /* always try "." if numeric radix didn't match because
5742 * we may have data from different locales mixed */
5743 if (*sp < send && **sp == '.') {
5744 ++*sp;
5745 return TRUE;
5746 }
5747 return FALSE;
5748 }
5749 #endif
5750 #endif
5751
5752 #ifndef grok_number
5753 #if defined(NEED_grok_number)
5754 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
5755 static
5756 #else
5757 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
5758 #endif
5759
5760 #ifdef grok_number
5761 # undef grok_number
5762 #endif
5763 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
5764 #define Perl_grok_number DPPP_(my_grok_number)
5765
5766 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
5767 int
DPPP_(my_grok_number)5768 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
5769 {
5770 const char *s = pv;
5771 const char *send = pv + len;
5772 const UV max_div_10 = UV_MAX / 10;
5773 const char max_mod_10 = UV_MAX % 10;
5774 int numtype = 0;
5775 int sawinf = 0;
5776 int sawnan = 0;
5777
5778 while (s < send && isSPACE(*s))
5779 s++;
5780 if (s == send) {
5781 return 0;
5782 } else if (*s == '-') {
5783 s++;
5784 numtype = IS_NUMBER_NEG;
5785 }
5786 else if (*s == '+')
5787 s++;
5788
5789 if (s == send)
5790 return 0;
5791
5792 /* next must be digit or the radix separator or beginning of infinity */
5793 if (isDIGIT(*s)) {
5794 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
5795 overflow. */
5796 UV value = *s - '0';
5797 /* This construction seems to be more optimiser friendly.
5798 (without it gcc does the isDIGIT test and the *s - '0' separately)
5799 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
5800 In theory the optimiser could deduce how far to unroll the loop
5801 before checking for overflow. */
5802 if (++s < send) {
5803 int digit = *s - '0';
5804 if (digit >= 0 && digit <= 9) {
5805 value = value * 10 + digit;
5806 if (++s < send) {
5807 digit = *s - '0';
5808 if (digit >= 0 && digit <= 9) {
5809 value = value * 10 + digit;
5810 if (++s < send) {
5811 digit = *s - '0';
5812 if (digit >= 0 && digit <= 9) {
5813 value = value * 10 + digit;
5814 if (++s < send) {
5815 digit = *s - '0';
5816 if (digit >= 0 && digit <= 9) {
5817 value = value * 10 + digit;
5818 if (++s < send) {
5819 digit = *s - '0';
5820 if (digit >= 0 && digit <= 9) {
5821 value = value * 10 + digit;
5822 if (++s < send) {
5823 digit = *s - '0';
5824 if (digit >= 0 && digit <= 9) {
5825 value = value * 10 + digit;
5826 if (++s < send) {
5827 digit = *s - '0';
5828 if (digit >= 0 && digit <= 9) {
5829 value = value * 10 + digit;
5830 if (++s < send) {
5831 digit = *s - '0';
5832 if (digit >= 0 && digit <= 9) {
5833 value = value * 10 + digit;
5834 if (++s < send) {
5835 /* Now got 9 digits, so need to check
5836 each time for overflow. */
5837 digit = *s - '0';
5838 while (digit >= 0 && digit <= 9
5839 && (value < max_div_10
5840 || (value == max_div_10
5841 && digit <= max_mod_10))) {
5842 value = value * 10 + digit;
5843 if (++s < send)
5844 digit = *s - '0';
5845 else
5846 break;
5847 }
5848 if (digit >= 0 && digit <= 9
5849 && (s < send)) {
5850 /* value overflowed.
5851 skip the remaining digits, don't
5852 worry about setting *valuep. */
5853 do {
5854 s++;
5855 } while (s < send && isDIGIT(*s));
5856 numtype |=
5857 IS_NUMBER_GREATER_THAN_UV_MAX;
5858 goto skip_value;
5859 }
5860 }
5861 }
5862 }
5863 }
5864 }
5865 }
5866 }
5867 }
5868 }
5869 }
5870 }
5871 }
5872 }
5873 }
5874 }
5875 }
5876 }
5877 numtype |= IS_NUMBER_IN_UV;
5878 if (valuep)
5879 *valuep = value;
5880
5881 skip_value:
5882 if (GROK_NUMERIC_RADIX(&s, send)) {
5883 numtype |= IS_NUMBER_NOT_INT;
5884 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
5885 s++;
5886 }
5887 }
5888 else if (GROK_NUMERIC_RADIX(&s, send)) {
5889 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
5890 /* no digits before the radix means we need digits after it */
5891 if (s < send && isDIGIT(*s)) {
5892 do {
5893 s++;
5894 } while (s < send && isDIGIT(*s));
5895 if (valuep) {
5896 /* integer approximation is valid - it's 0. */
5897 *valuep = 0;
5898 }
5899 }
5900 else
5901 return 0;
5902 } else if (*s == 'I' || *s == 'i') {
5903 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
5904 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
5905 s++; if (s < send && (*s == 'I' || *s == 'i')) {
5906 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
5907 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
5908 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
5909 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
5910 s++;
5911 }
5912 sawinf = 1;
5913 } else if (*s == 'N' || *s == 'n') {
5914 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
5915 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
5916 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
5917 s++;
5918 sawnan = 1;
5919 } else
5920 return 0;
5921
5922 if (sawinf) {
5923 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
5924 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
5925 } else if (sawnan) {
5926 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
5927 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
5928 } else if (s < send) {
5929 /* we can have an optional exponent part */
5930 if (*s == 'e' || *s == 'E') {
5931 /* The only flag we keep is sign. Blow away any "it's UV" */
5932 numtype &= IS_NUMBER_NEG;
5933 numtype |= IS_NUMBER_NOT_INT;
5934 s++;
5935 if (s < send && (*s == '-' || *s == '+'))
5936 s++;
5937 if (s < send && isDIGIT(*s)) {
5938 do {
5939 s++;
5940 } while (s < send && isDIGIT(*s));
5941 }
5942 else
5943 return 0;
5944 }
5945 }
5946 while (s < send && isSPACE(*s))
5947 s++;
5948 if (s >= send)
5949 return numtype;
5950 if (len == 10 && memEQ(pv, "0 but true", 10)) {
5951 if (valuep)
5952 *valuep = 0;
5953 return IS_NUMBER_IN_UV;
5954 }
5955 return 0;
5956 }
5957 #endif
5958 #endif
5959
5960 /*
5961 * The grok_* routines have been modified to use warn() instead of
5962 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
5963 * which is why the stack variable has been renamed to 'xdigit'.
5964 */
5965
5966 #ifndef grok_bin
5967 #if defined(NEED_grok_bin)
5968 static UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
5969 static
5970 #else
5971 extern UV DPPP_(my_grok_bin)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
5972 #endif
5973
5974 #ifdef grok_bin
5975 # undef grok_bin
5976 #endif
5977 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
5978 #define Perl_grok_bin DPPP_(my_grok_bin)
5979
5980 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
5981 UV
DPPP_(my_grok_bin)5982 DPPP_(my_grok_bin)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
5983 {
5984 const char *s = start;
5985 STRLEN len = *len_p;
5986 UV value = 0;
5987 NV value_nv = 0;
5988
5989 const UV max_div_2 = UV_MAX / 2;
5990 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
5991 bool overflowed = FALSE;
5992
5993 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
5994 /* strip off leading b or 0b.
5995 for compatibility silently suffer "b" and "0b" as valid binary
5996 numbers. */
5997 if (len >= 1) {
5998 if (s[0] == 'b') {
5999 s++;
6000 len--;
6001 }
6002 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
6003 s+=2;
6004 len-=2;
6005 }
6006 }
6007 }
6008
6009 for (; len-- && *s; s++) {
6010 char bit = *s;
6011 if (bit == '0' || bit == '1') {
6012 /* Write it in this wonky order with a goto to attempt to get the
6013 compiler to make the common case integer-only loop pretty tight.
6014 With gcc seems to be much straighter code than old scan_bin. */
6015 redo:
6016 if (!overflowed) {
6017 if (value <= max_div_2) {
6018 value = (value << 1) | (bit - '0');
6019 continue;
6020 }
6021 /* Bah. We're just overflowed. */
6022 warn("Integer overflow in binary number");
6023 overflowed = TRUE;
6024 value_nv = (NV) value;
6025 }
6026 value_nv *= 2.0;
6027 /* If an NV has not enough bits in its mantissa to
6028 * represent a UV this summing of small low-order numbers
6029 * is a waste of time (because the NV cannot preserve
6030 * the low-order bits anyway): we could just remember when
6031 * did we overflow and in the end just multiply value_nv by the
6032 * right amount. */
6033 value_nv += (NV)(bit - '0');
6034 continue;
6035 }
6036 if (bit == '_' && len && allow_underscores && (bit = s[1])
6037 && (bit == '0' || bit == '1'))
6038 {
6039 --len;
6040 ++s;
6041 goto redo;
6042 }
6043 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6044 warn("Illegal binary digit '%c' ignored", *s);
6045 break;
6046 }
6047
6048 if ( ( overflowed && value_nv > 4294967295.0)
6049 #if UVSIZE > 4
6050 || (!overflowed && value > 0xffffffff )
6051 #endif
6052 ) {
6053 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
6054 }
6055 *len_p = s - start;
6056 if (!overflowed) {
6057 *flags = 0;
6058 return value;
6059 }
6060 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6061 if (result)
6062 *result = value_nv;
6063 return UV_MAX;
6064 }
6065 #endif
6066 #endif
6067
6068 #ifndef grok_hex
6069 #if defined(NEED_grok_hex)
6070 static UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6071 static
6072 #else
6073 extern UV DPPP_(my_grok_hex)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6074 #endif
6075
6076 #ifdef grok_hex
6077 # undef grok_hex
6078 #endif
6079 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
6080 #define Perl_grok_hex DPPP_(my_grok_hex)
6081
6082 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
6083 UV
DPPP_(my_grok_hex)6084 DPPP_(my_grok_hex)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6085 {
6086 const char *s = start;
6087 STRLEN len = *len_p;
6088 UV value = 0;
6089 NV value_nv = 0;
6090
6091 const UV max_div_16 = UV_MAX / 16;
6092 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6093 bool overflowed = FALSE;
6094 const char *xdigit;
6095
6096 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
6097 /* strip off leading x or 0x.
6098 for compatibility silently suffer "x" and "0x" as valid hex numbers.
6099 */
6100 if (len >= 1) {
6101 if (s[0] == 'x') {
6102 s++;
6103 len--;
6104 }
6105 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
6106 s+=2;
6107 len-=2;
6108 }
6109 }
6110 }
6111
6112 for (; len-- && *s; s++) {
6113 xdigit = strchr((char *) PL_hexdigit, *s);
6114 if (xdigit) {
6115 /* Write it in this wonky order with a goto to attempt to get the
6116 compiler to make the common case integer-only loop pretty tight.
6117 With gcc seems to be much straighter code than old scan_hex. */
6118 redo:
6119 if (!overflowed) {
6120 if (value <= max_div_16) {
6121 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
6122 continue;
6123 }
6124 warn("Integer overflow in hexadecimal number");
6125 overflowed = TRUE;
6126 value_nv = (NV) value;
6127 }
6128 value_nv *= 16.0;
6129 /* If an NV has not enough bits in its mantissa to
6130 * represent a UV this summing of small low-order numbers
6131 * is a waste of time (because the NV cannot preserve
6132 * the low-order bits anyway): we could just remember when
6133 * did we overflow and in the end just multiply value_nv by the
6134 * right amount of 16-tuples. */
6135 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
6136 continue;
6137 }
6138 if (*s == '_' && len && allow_underscores && s[1]
6139 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
6140 {
6141 --len;
6142 ++s;
6143 goto redo;
6144 }
6145 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6146 warn("Illegal hexadecimal digit '%c' ignored", *s);
6147 break;
6148 }
6149
6150 if ( ( overflowed && value_nv > 4294967295.0)
6151 #if UVSIZE > 4
6152 || (!overflowed && value > 0xffffffff )
6153 #endif
6154 ) {
6155 warn("Hexadecimal number > 0xffffffff non-portable");
6156 }
6157 *len_p = s - start;
6158 if (!overflowed) {
6159 *flags = 0;
6160 return value;
6161 }
6162 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6163 if (result)
6164 *result = value_nv;
6165 return UV_MAX;
6166 }
6167 #endif
6168 #endif
6169
6170 #ifndef grok_oct
6171 #if defined(NEED_grok_oct)
6172 static UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6173 static
6174 #else
6175 extern UV DPPP_(my_grok_oct)(pTHX_ const char * start, STRLEN * len_p, I32 * flags, NV * result);
6176 #endif
6177
6178 #ifdef grok_oct
6179 # undef grok_oct
6180 #endif
6181 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
6182 #define Perl_grok_oct DPPP_(my_grok_oct)
6183
6184 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
6185 UV
DPPP_(my_grok_oct)6186 DPPP_(my_grok_oct)(pTHX_ const char *start, STRLEN *len_p, I32 *flags, NV *result)
6187 {
6188 const char *s = start;
6189 STRLEN len = *len_p;
6190 UV value = 0;
6191 NV value_nv = 0;
6192
6193 const UV max_div_8 = UV_MAX / 8;
6194 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
6195 bool overflowed = FALSE;
6196
6197 for (; len-- && *s; s++) {
6198 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
6199 out front allows slicker code. */
6200 int digit = *s - '0';
6201 if (digit >= 0 && digit <= 7) {
6202 /* Write it in this wonky order with a goto to attempt to get the
6203 compiler to make the common case integer-only loop pretty tight.
6204 */
6205 redo:
6206 if (!overflowed) {
6207 if (value <= max_div_8) {
6208 value = (value << 3) | digit;
6209 continue;
6210 }
6211 /* Bah. We're just overflowed. */
6212 warn("Integer overflow in octal number");
6213 overflowed = TRUE;
6214 value_nv = (NV) value;
6215 }
6216 value_nv *= 8.0;
6217 /* If an NV has not enough bits in its mantissa to
6218 * represent a UV this summing of small low-order numbers
6219 * is a waste of time (because the NV cannot preserve
6220 * the low-order bits anyway): we could just remember when
6221 * did we overflow and in the end just multiply value_nv by the
6222 * right amount of 8-tuples. */
6223 value_nv += (NV)digit;
6224 continue;
6225 }
6226 if (digit == ('_' - '0') && len && allow_underscores
6227 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
6228 {
6229 --len;
6230 ++s;
6231 goto redo;
6232 }
6233 /* Allow \octal to work the DWIM way (that is, stop scanning
6234 * as soon as non-octal characters are seen, complain only iff
6235 * someone seems to want to use the digits eight and nine). */
6236 if (digit == 8 || digit == 9) {
6237 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
6238 warn("Illegal octal digit '%c' ignored", *s);
6239 }
6240 break;
6241 }
6242
6243 if ( ( overflowed && value_nv > 4294967295.0)
6244 #if UVSIZE > 4
6245 || (!overflowed && value > 0xffffffff )
6246 #endif
6247 ) {
6248 warn("Octal number > 037777777777 non-portable");
6249 }
6250 *len_p = s - start;
6251 if (!overflowed) {
6252 *flags = 0;
6253 return value;
6254 }
6255 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
6256 if (result)
6257 *result = value_nv;
6258 return UV_MAX;
6259 }
6260 #endif
6261 #endif
6262
6263 #if !defined(my_snprintf)
6264 #if defined(NEED_my_snprintf)
6265 static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6266 static
6267 #else
6268 extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...);
6269 #endif
6270
6271 #define my_snprintf DPPP_(my_my_snprintf)
6272 #define Perl_my_snprintf DPPP_(my_my_snprintf)
6273
6274 #if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL)
6275
6276 int
DPPP_(my_my_snprintf)6277 DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...)
6278 {
6279 dTHX;
6280 int retval;
6281 va_list ap;
6282 va_start(ap, format);
6283 #ifdef HAS_VSNPRINTF
6284 retval = vsnprintf(buffer, len, format, ap);
6285 #else
6286 retval = vsprintf(buffer, format, ap);
6287 #endif
6288 va_end(ap);
6289 if (retval >= (int)len)
6290 Perl_croak(aTHX_ "panic: my_snprintf buffer overflow");
6291 return retval;
6292 }
6293
6294 #endif
6295 #endif
6296
6297 #ifdef NO_XSLOCKS
6298 # ifdef dJMPENV
6299 # define dXCPT dJMPENV; int rEtV = 0
6300 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
6301 # define XCPT_TRY_END JMPENV_POP;
6302 # define XCPT_CATCH if (rEtV != 0)
6303 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
6304 # else
6305 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
6306 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
6307 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
6308 # define XCPT_CATCH if (rEtV != 0)
6309 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
6310 # endif
6311 #endif
6312
6313 #if !defined(my_strlcat)
6314 #if defined(NEED_my_strlcat)
6315 static Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
6316 static
6317 #else
6318 extern Size_t DPPP_(my_my_strlcat)(char * dst, const char * src, Size_t size);
6319 #endif
6320
6321 #define my_strlcat DPPP_(my_my_strlcat)
6322 #define Perl_my_strlcat DPPP_(my_my_strlcat)
6323
6324 #if defined(NEED_my_strlcat) || defined(NEED_my_strlcat_GLOBAL)
6325
6326 Size_t
DPPP_(my_my_strlcat)6327 DPPP_(my_my_strlcat)(char *dst, const char *src, Size_t size)
6328 {
6329 Size_t used, length, copy;
6330
6331 used = strlen(dst);
6332 length = strlen(src);
6333 if (size > 0 && used < size - 1) {
6334 copy = (length >= size - used) ? size - used - 1 : length;
6335 memcpy(dst + used, src, copy);
6336 dst[used + copy] = '\0';
6337 }
6338 return used + length;
6339 }
6340 #endif
6341 #endif
6342
6343 #if !defined(my_strlcpy)
6344 #if defined(NEED_my_strlcpy)
6345 static Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
6346 static
6347 #else
6348 extern Size_t DPPP_(my_my_strlcpy)(char * dst, const char * src, Size_t size);
6349 #endif
6350
6351 #define my_strlcpy DPPP_(my_my_strlcpy)
6352 #define Perl_my_strlcpy DPPP_(my_my_strlcpy)
6353
6354 #if defined(NEED_my_strlcpy) || defined(NEED_my_strlcpy_GLOBAL)
6355
6356 Size_t
DPPP_(my_my_strlcpy)6357 DPPP_(my_my_strlcpy)(char *dst, const char *src, Size_t size)
6358 {
6359 Size_t length, copy;
6360
6361 length = strlen(src);
6362 if (size > 0) {
6363 copy = (length >= size) ? size - 1 : length;
6364 memcpy(dst, src, copy);
6365 dst[copy] = '\0';
6366 }
6367 return length;
6368 }
6369
6370 #endif
6371 #endif
6372
6373 #endif /* _P_P_PORTABILITY_H_ */
6374
6375 /* End of File ppport.h */
6376