1 #if 0
2 <<'SKIP';
3 #endif
4 /*
5 ----------------------------------------------------------------------
6
7 ppport.h -- Perl/Pollution/Portability Version 3.06
8
9 Automatically created by Devel::PPPort running under
10 perl 5.009003 on Fri May 20 22:14:30 2005.
11
12 Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
13 includes in parts/inc/ instead.
14
15 Use 'perldoc ppport.h' to view the documentation below.
16
17 ----------------------------------------------------------------------
18
19 SKIP
20
21 =pod
22
23 =head1 NAME
24
25 ppport.h - Perl/Pollution/Portability version 3.06
26
27 =head1 SYNOPSIS
28
29 perl ppport.h [options] [files]
30
31 --help show short help
32
33 --patch=file write one patch file with changes
34 --copy=suffix write changed copies with suffix
35 --diff=program use diff program and options
36
37 --compat-version=version provide compatibility with Perl version
38 --cplusplus accept C++ comments
39
40 --quiet don't output anything except fatal errors
41 --nodiag don't show diagnostics
42 --nohints don't show hints
43 --nochanges don't suggest changes
44
45 --list-provided list provided API
46 --list-unsupported list unsupported API
47 --api-info=name show Perl API portability information
48
49 =head1 COMPATIBILITY
50
51 This version of F<ppport.h> is designed to support operation with Perl
52 installations back to 5.003, and has been tested up to 5.9.2.
53
54 =head1 OPTIONS
55
56 =head2 --help
57
58 Display a brief usage summary.
59
60 =head2 --patch=I<file>
61
62 If this option is given, a single patch file will be created if
63 any changes are suggested. This requires a working diff program
64 to be installed on your system.
65
66 =head2 --copy=I<suffix>
67
68 If this option is given, a copy of each file will be saved with
69 the given suffix that contains the suggested changes. This does
70 not require any external programs.
71
72 If neither C<--patch> or C<--copy> are given, the default is to
73 simply print the diffs for each file. This requires either
74 C<Text::Diff> or a C<diff> program to be installed.
75
76 =head2 --diff=I<program>
77
78 Manually set the diff program and options to use. The default
79 is to use C<Text::Diff>, when installed, and output unified
80 context diffs.
81
82 =head2 --compat-version=I<version>
83
84 Tell F<ppport.h> to check for compatibility with the given
85 Perl version. The default is to check for compatibility with Perl
86 version 5.003. You can use this option to reduce the output
87 of F<ppport.h> if you intend to be backward compatible only
88 up to a certain Perl version.
89
90 =head2 --cplusplus
91
92 Usually, F<ppport.h> will detect C++ style comments and
93 replace them with C style comments for portability reasons.
94 Using this option instructs F<ppport.h> to leave C++
95 comments untouched.
96
97 =head2 --quiet
98
99 Be quiet. Don't print anything except fatal errors.
100
101 =head2 --nodiag
102
103 Don't output any diagnostic messages. Only portability
104 alerts will be printed.
105
106 =head2 --nohints
107
108 Don't output any hints. Hints often contain useful portability
109 notes.
110
111 =head2 --nochanges
112
113 Don't suggest any changes. Only give diagnostic output and hints
114 unless these are also deactivated.
115
116 =head2 --list-provided
117
118 Lists the API elements for which compatibility is provided by
119 F<ppport.h>. Also lists if it must be explicitly requested,
120 if it has dependencies, and if there are hints for it.
121
122 =head2 --list-unsupported
123
124 Lists the API elements that are known not to be supported by
125 F<ppport.h> and below which version of Perl they probably
126 won't be available or work.
127
128 =head2 --api-info=I<name>
129
130 Show portability information for API elements matching I<name>.
131 If I<name> is surrounded by slashes, it is interpreted as a regular
132 expression.
133
134 =head1 DESCRIPTION
135
136 In order for a Perl extension (XS) module to be as portable as possible
137 across differing versions of Perl itself, certain steps need to be taken.
138
139 =over 4
140
141 =item *
142
143 Including this header is the first major one. This alone will give you
144 access to a large part of the Perl API that hasn't been available in
145 earlier Perl releases. Use
146
147 perl ppport.h --list-provided
148
149 to see which API elements are provided by ppport.h.
150
151 =item *
152
153 You should avoid using deprecated parts of the API. For example, using
154 global Perl variables without the C<PL_> prefix is deprecated. Also,
155 some API functions used to have a C<perl_> prefix. Using this form is
156 also deprecated. You can safely use the supported API, as F<ppport.h>
157 will provide wrappers for older Perl versions.
158
159 =item *
160
161 If you use one of a few functions that were not present in earlier
162 versions of Perl, and that can't be provided using a macro, you have
163 to explicitly request support for these functions by adding one or
164 more C<#define>s in your source code before the inclusion of F<ppport.h>.
165
166 These functions will be marked C<explicit> in the list shown by
167 C<--list-provided>.
168
169 Depending on whether you module has a single or multiple files that
170 use such functions, you want either C<static> or global variants.
171
172 For a C<static> function, use:
173
174 #define NEED_function
175
176 For a global function, use:
177
178 #define NEED_function_GLOBAL
179
180 Note that you mustn't have more than one global request for one
181 function in your project.
182
183 Function Static Request Global Request
184 -----------------------------------------------------------------------------------------
185 eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
186 grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
187 grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
188 grok_number() NEED_grok_number NEED_grok_number_GLOBAL
189 grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
190 grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
191 newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
192 newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
193 sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL
194 sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
195 sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
196 sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
197 sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
198 sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
199 vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
200
201 To avoid namespace conflicts, you can change the namespace of the
202 explicitly exported functions using the C<DPPP_NAMESPACE> macro.
203 Just C<#define> the macro before including C<ppport.h>:
204
205 #define DPPP_NAMESPACE MyOwnNamespace_
206 #include "ppport.h"
207
208 The default namespace is C<DPPP_>.
209
210 =back
211
212 The good thing is that most of the above can be checked by running
213 F<ppport.h> on your source code. See the next section for
214 details.
215
216 =head1 EXAMPLES
217
218 To verify whether F<ppport.h> is needed for your module, whether you
219 should make any changes to your code, and whether any special defines
220 should be used, F<ppport.h> can be run as a Perl script to check your
221 source code. Simply say:
222
223 perl ppport.h
224
225 The result will usually be a list of patches suggesting changes
226 that should at least be acceptable, if not necessarily the most
227 efficient solution, or a fix for all possible problems.
228
229 If you know that your XS module uses features only available in
230 newer Perl releases, if you're aware that it uses C++ comments,
231 and if you want all suggestions as a single patch file, you could
232 use something like this:
233
234 perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff
235
236 If you only want your code to be scanned without any suggestions
237 for changes, use:
238
239 perl ppport.h --nochanges
240
241 You can specify a different C<diff> program or options, using
242 the C<--diff> option:
243
244 perl ppport.h --diff='diff -C 10'
245
246 This would output context diffs with 10 lines of context.
247
248 To display portability information for the C<newSVpvn> function,
249 use:
250
251 perl ppport.h --api-info=newSVpvn
252
253 Since the argument to C<--api-info> can be a regular expression,
254 you can use
255
256 perl ppport.h --api-info=/_nomg$/
257
258 to display portability information for all C<_nomg> functions or
259
260 perl ppport.h --api-info=/./
261
262 to display information for all known API elements.
263
264 =head1 BUGS
265
266 If this version of F<ppport.h> is causing failure during
267 the compilation of this module, please check if newer versions
268 of either this module or C<Devel::PPPort> are available on CPAN
269 before sending a bug report.
270
271 If F<ppport.h> was generated using the latest version of
272 C<Devel::PPPort> and is causing failure of this module, please
273 file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>.
274
275 Please include the following information:
276
277 =over 4
278
279 =item 1.
280
281 The complete output from running "perl -V"
282
283 =item 2.
284
285 This file.
286
287 =item 3.
288
289 The name and version of the module you were trying to build.
290
291 =item 4.
292
293 A full log of the build that failed.
294
295 =item 5.
296
297 Any other information that you think could be relevant.
298
299 =back
300
301 For the latest version of this code, please get the C<Devel::PPPort>
302 module from CPAN.
303
304 =head1 COPYRIGHT
305
306 Version 3.x, Copyright (c) 2004-2005, Marcus Holland-Moritz.
307
308 Version 2.x, Copyright (C) 2001, Paul Marquess.
309
310 Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
311
312 This program is free software; you can redistribute it and/or
313 modify it under the same terms as Perl itself.
314
315 =head1 SEE ALSO
316
317 See L<Devel::PPPort>.
318
319 =cut
320
321 use strict;
322
323 my %opt = (
324 quiet => 0,
325 diag => 1,
326 hints => 1,
327 changes => 1,
328 cplusplus => 0,
329 );
330
331 my($ppport) = $0 =~ /([\w.]+)$/;
332 my $LF = '(?:\r\n|[\r\n])'; # line feed
333 my $HS = "[ \t]"; # horizontal whitespace
334
335 eval {
336 require Getopt::Long;
337 Getopt::Long::GetOptions(\%opt, qw(
338 help quiet diag! hints! changes! cplusplus
339 patch=s copy=s diff=s compat-version=s
340 list-provided list-unsupported api-info=s
341 )) or usage();
342 };
343
344 if ($@ and grep /^-/, @ARGV) {
345 usage() if "@ARGV" =~ /^--?h(?:elp)?$/;
346 die "Getopt::Long not found. Please don't use any options.\n";
347 }
348
349 usage() if $opt{help};
350
351 if (exists $opt{'compat-version'}) {
352 my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) };
353 if ($@) {
354 die "Invalid version number format: '$opt{'compat-version'}'\n";
355 }
356 die "Only Perl 5 is supported\n" if $r != 5;
357 die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $v >= 1000;
358 $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s;
359 }
360 else {
361 $opt{'compat-version'} = 5;
362 }
363
364 # Never use C comments in this file!!!!!
365 my $ccs = '/'.'*';
366 my $cce = '*'.'/';
367 my $rccs = quotemeta $ccs;
368 my $rcce = quotemeta $cce;
369
370 my @files;
371
372 if (@ARGV) {
373 @files = map { glob $_ } @ARGV;
374 }
375 else {
376 eval {
377 require File::Find;
378 File::Find::find(sub {
379 $File::Find::name =~ /\.(xs|c|h|cc)$/i
380 and push @files, $File::Find::name;
381 }, '.');
382 };
383 if ($@) {
384 @files = map { glob $_ } qw(*.xs *.c *.h *.cc);
385 }
386 my %filter = map { /(.*)\.xs$/ ? ("$1.c" => 1) : () } @files;
387 @files = grep { !/\b\Q$ppport\E$/i && !exists $filter{$_} } @files;
388 }
389
390 unless (@files) {
391 die "No input files given!\n";
392 }
393
394 my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/
395 ? ( $1 => {
396 ($2 ? ( base => $2 ) : ()),
397 ($3 ? ( todo => $3 ) : ()),
398 (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()),
399 (index($4, 'p') >= 0 ? ( provided => 1 ) : ()),
400 (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()),
401 } )
402 : die "invalid spec: $_" } qw(
403 AvFILLp|5.004050||p
404 AvFILL|||
405 CLASS|||n
406 CX_CURPAD_SAVE|||
407 CX_CURPAD_SV|||
408 CopFILEAV|5.006000||p
409 CopFILEGV_set|5.006000||p
410 CopFILEGV|5.006000||p
411 CopFILESV|5.006000||p
412 CopFILE_set|5.006000||p
413 CopFILE|5.006000||p
414 CopSTASHPV_set|5.006000||p
415 CopSTASHPV|5.006000||p
416 CopSTASH_eq|5.006000||p
417 CopSTASH_set|5.006000||p
418 CopSTASH|5.006000||p
419 CopyD|5.009002||p
420 Copy|||
421 CvPADLIST|||
422 CvSTASH|||
423 CvWEAKOUTSIDE|||
424 DEFSV|5.004050||p
425 END_EXTERN_C|5.005000||p
426 ENTER|||
427 ERRSV|5.004050||p
428 EXTEND|||
429 EXTERN_C|5.005000||p
430 FREETMPS|||
431 GIMME_V||5.004000|n
432 GIMME|||n
433 GROK_NUMERIC_RADIX|5.007002||p
434 G_ARRAY|||
435 G_DISCARD|||
436 G_EVAL|||
437 G_NOARGS|||
438 G_SCALAR|||
439 G_VOID||5.004000|
440 GetVars|||
441 GvSV|||
442 Gv_AMupdate|||
443 HEf_SVKEY||5.004000|
444 HeHASH||5.004000|
445 HeKEY||5.004000|
446 HeKLEN||5.004000|
447 HePV||5.004000|
448 HeSVKEY_force||5.004000|
449 HeSVKEY_set||5.004000|
450 HeSVKEY||5.004000|
451 HeVAL||5.004000|
452 HvNAME|||
453 INT2PTR|5.006000||p
454 IN_LOCALE_COMPILETIME|5.007002||p
455 IN_LOCALE_RUNTIME|5.007002||p
456 IN_LOCALE|5.007002||p
457 IN_PERL_COMPILETIME|5.008001||p
458 IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p
459 IS_NUMBER_INFINITY|5.007002||p
460 IS_NUMBER_IN_UV|5.007002||p
461 IS_NUMBER_NAN|5.007003||p
462 IS_NUMBER_NEG|5.007002||p
463 IS_NUMBER_NOT_INT|5.007002||p
464 IVSIZE|5.006000||p
465 IVTYPE|5.006000||p
466 IVdf|5.006000||p
467 LEAVE|||
468 LVRET|||
469 MARK|||
470 MY_CXT_CLONE|5.009002||p
471 MY_CXT_INIT|5.007003||p
472 MY_CXT|5.007003||p
473 MoveD|5.009002||p
474 Move|||
475 NEWSV|||
476 NOOP|5.005000||p
477 NUM2PTR|5.006000||p
478 NVTYPE|5.006000||p
479 NVef|5.006001||p
480 NVff|5.006001||p
481 NVgf|5.006001||p
482 Newc|||
483 Newz|||
484 New|||
485 Nullav|||
486 Nullch|||
487 Nullcv|||
488 Nullhv|||
489 Nullsv|||
490 ORIGMARK|||
491 PAD_BASE_SV|||
492 PAD_CLONE_VARS|||
493 PAD_COMPNAME_FLAGS|||
494 PAD_COMPNAME_GEN|||
495 PAD_COMPNAME_OURSTASH|||
496 PAD_COMPNAME_PV|||
497 PAD_COMPNAME_TYPE|||
498 PAD_RESTORE_LOCAL|||
499 PAD_SAVE_LOCAL|||
500 PAD_SAVE_SETNULLPAD|||
501 PAD_SETSV|||
502 PAD_SET_CUR_NOSAVE|||
503 PAD_SET_CUR|||
504 PAD_SVl|||
505 PAD_SV|||
506 PERL_BCDVERSION|5.009002||p
507 PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
508 PERL_INT_MAX|5.004000||p
509 PERL_INT_MIN|5.004000||p
510 PERL_LONG_MAX|5.004000||p
511 PERL_LONG_MIN|5.004000||p
512 PERL_MAGIC_arylen|5.007002||p
513 PERL_MAGIC_backref|5.007002||p
514 PERL_MAGIC_bm|5.007002||p
515 PERL_MAGIC_collxfrm|5.007002||p
516 PERL_MAGIC_dbfile|5.007002||p
517 PERL_MAGIC_dbline|5.007002||p
518 PERL_MAGIC_defelem|5.007002||p
519 PERL_MAGIC_envelem|5.007002||p
520 PERL_MAGIC_env|5.007002||p
521 PERL_MAGIC_ext|5.007002||p
522 PERL_MAGIC_fm|5.007002||p
523 PERL_MAGIC_glob|5.007002||p
524 PERL_MAGIC_isaelem|5.007002||p
525 PERL_MAGIC_isa|5.007002||p
526 PERL_MAGIC_mutex|5.007002||p
527 PERL_MAGIC_nkeys|5.007002||p
528 PERL_MAGIC_overload_elem|5.007002||p
529 PERL_MAGIC_overload_table|5.007002||p
530 PERL_MAGIC_overload|5.007002||p
531 PERL_MAGIC_pos|5.007002||p
532 PERL_MAGIC_qr|5.007002||p
533 PERL_MAGIC_regdata|5.007002||p
534 PERL_MAGIC_regdatum|5.007002||p
535 PERL_MAGIC_regex_global|5.007002||p
536 PERL_MAGIC_shared_scalar|5.007003||p
537 PERL_MAGIC_shared|5.007003||p
538 PERL_MAGIC_sigelem|5.007002||p
539 PERL_MAGIC_sig|5.007002||p
540 PERL_MAGIC_substr|5.007002||p
541 PERL_MAGIC_sv|5.007002||p
542 PERL_MAGIC_taint|5.007002||p
543 PERL_MAGIC_tiedelem|5.007002||p
544 PERL_MAGIC_tiedscalar|5.007002||p
545 PERL_MAGIC_tied|5.007002||p
546 PERL_MAGIC_utf8|5.008001||p
547 PERL_MAGIC_uvar_elem|5.007003||p
548 PERL_MAGIC_uvar|5.007002||p
549 PERL_MAGIC_vec|5.007002||p
550 PERL_MAGIC_vstring|5.008001||p
551 PERL_QUAD_MAX|5.004000||p
552 PERL_QUAD_MIN|5.004000||p
553 PERL_REVISION|5.006000||p
554 PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p
555 PERL_SCAN_DISALLOW_PREFIX|5.007003||p
556 PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p
557 PERL_SCAN_SILENT_ILLDIGIT|5.008001||p
558 PERL_SHORT_MAX|5.004000||p
559 PERL_SHORT_MIN|5.004000||p
560 PERL_SUBVERSION|5.006000||p
561 PERL_UCHAR_MAX|5.004000||p
562 PERL_UCHAR_MIN|5.004000||p
563 PERL_UINT_MAX|5.004000||p
564 PERL_UINT_MIN|5.004000||p
565 PERL_ULONG_MAX|5.004000||p
566 PERL_ULONG_MIN|5.004000||p
567 PERL_UNUSED_DECL|5.007002||p
568 PERL_UQUAD_MAX|5.004000||p
569 PERL_UQUAD_MIN|5.004000||p
570 PERL_USHORT_MAX|5.004000||p
571 PERL_USHORT_MIN|5.004000||p
572 PERL_VERSION|5.006000||p
573 PL_DBsingle|||pn
574 PL_DBsub|||pn
575 PL_DBtrace|||n
576 PL_Sv|5.005000||p
577 PL_compiling|5.004050||p
578 PL_copline|5.005000||p
579 PL_curcop|5.004050||p
580 PL_curstash|5.004050||p
581 PL_debstash|5.004050||p
582 PL_defgv|5.004050||p
583 PL_diehook|5.004050||p
584 PL_dirty|5.004050||p
585 PL_dowarn|||pn
586 PL_errgv|5.004050||p
587 PL_hexdigit|5.005000||p
588 PL_hints|5.005000||p
589 PL_last_in_gv|||n
590 PL_modglobal||5.005000|n
591 PL_na|5.004050||pn
592 PL_no_modify|5.006000||p
593 PL_ofs_sv|||n
594 PL_perl_destruct_level|5.004050||p
595 PL_perldb|5.004050||p
596 PL_ppaddr|5.006000||p
597 PL_rsfp_filters|5.004050||p
598 PL_rsfp|5.004050||p
599 PL_rs|||n
600 PL_stack_base|5.004050||p
601 PL_stack_sp|5.004050||p
602 PL_stdingv|5.004050||p
603 PL_sv_arenaroot|5.004050||p
604 PL_sv_no|5.004050||pn
605 PL_sv_undef|5.004050||pn
606 PL_sv_yes|5.004050||pn
607 PL_tainted|5.004050||p
608 PL_tainting|5.004050||p
609 POPi|||n
610 POPl|||n
611 POPn|||n
612 POPpbytex||5.007001|n
613 POPpx||5.005030|n
614 POPp|||n
615 POPs|||n
616 PTR2IV|5.006000||p
617 PTR2NV|5.006000||p
618 PTR2UV|5.006000||p
619 PTR2ul|5.007001||p
620 PTRV|5.006000||p
621 PUSHMARK|||
622 PUSHi|||
623 PUSHmortal|5.009002||p
624 PUSHn|||
625 PUSHp|||
626 PUSHs|||
627 PUSHu|5.004000||p
628 PUTBACK|||
629 PerlIO_clearerr||5.007003|
630 PerlIO_close||5.007003|
631 PerlIO_eof||5.007003|
632 PerlIO_error||5.007003|
633 PerlIO_fileno||5.007003|
634 PerlIO_fill||5.007003|
635 PerlIO_flush||5.007003|
636 PerlIO_get_base||5.007003|
637 PerlIO_get_bufsiz||5.007003|
638 PerlIO_get_cnt||5.007003|
639 PerlIO_get_ptr||5.007003|
640 PerlIO_read||5.007003|
641 PerlIO_seek||5.007003|
642 PerlIO_set_cnt||5.007003|
643 PerlIO_set_ptrcnt||5.007003|
644 PerlIO_setlinebuf||5.007003|
645 PerlIO_stderr||5.007003|
646 PerlIO_stdin||5.007003|
647 PerlIO_stdout||5.007003|
648 PerlIO_tell||5.007003|
649 PerlIO_unread||5.007003|
650 PerlIO_write||5.007003|
651 Poison|5.008000||p
652 RETVAL|||n
653 Renewc|||
654 Renew|||
655 SAVECLEARSV|||
656 SAVECOMPPAD|||
657 SAVEPADSV|||
658 SAVETMPS|||
659 SAVE_DEFSV|5.004050||p
660 SPAGAIN|||
661 SP|||
662 START_EXTERN_C|5.005000||p
663 START_MY_CXT|5.007003||p
664 STMT_END|||p
665 STMT_START|||p
666 ST|||
667 SVt_IV|||
668 SVt_NV|||
669 SVt_PVAV|||
670 SVt_PVCV|||
671 SVt_PVHV|||
672 SVt_PVMG|||
673 SVt_PV|||
674 Safefree|||
675 Slab_Alloc|||
676 Slab_Free|||
677 StructCopy|||
678 SvCUR_set|||
679 SvCUR|||
680 SvEND|||
681 SvGETMAGIC|5.004050||p
682 SvGROW|||
683 SvIOK_UV||5.006000|
684 SvIOK_notUV||5.006000|
685 SvIOK_off|||
686 SvIOK_only_UV||5.006000|
687 SvIOK_only|||
688 SvIOK_on|||
689 SvIOKp|||
690 SvIOK|||
691 SvIVX|||
692 SvIV_nomg|5.009001||p
693 SvIVx|||
694 SvIV|||
695 SvIsCOW_shared_hash||5.008003|
696 SvIsCOW||5.008003|
697 SvLEN|||
698 SvLOCK||5.007003|
699 SvNIOK_off|||
700 SvNIOKp|||
701 SvNIOK|||
702 SvNOK_off|||
703 SvNOK_only|||
704 SvNOK_on|||
705 SvNOKp|||
706 SvNOK|||
707 SvNVX|||
708 SvNVx|||
709 SvNV|||
710 SvOK|||
711 SvOOK|||
712 SvPOK_off|||
713 SvPOK_only_UTF8||5.006000|
714 SvPOK_only|||
715 SvPOK_on|||
716 SvPOKp|||
717 SvPOK|||
718 SvPVX|||
719 SvPV_force_nomg|5.007002||p
720 SvPV_force|||
721 SvPV_nolen|5.006000||p
722 SvPV_nomg|5.007002||p
723 SvPVbyte_force||5.009002|
724 SvPVbyte_nolen||5.006000|
725 SvPVbytex_force||5.006000|
726 SvPVbytex||5.006000|
727 SvPVbyte|5.006000||p
728 SvPVutf8_force||5.006000|
729 SvPVutf8_nolen||5.006000|
730 SvPVutf8x_force||5.006000|
731 SvPVutf8x||5.006000|
732 SvPVutf8||5.006000|
733 SvPVx|||
734 SvPV|||
735 SvREFCNT_dec|||
736 SvREFCNT_inc|||
737 SvREFCNT|||
738 SvROK_off|||
739 SvROK_on|||
740 SvROK|||
741 SvRV|||
742 SvSETMAGIC|||
743 SvSHARE||5.007003|
744 SvSTASH|||
745 SvSetMagicSV_nosteal||5.004000|
746 SvSetMagicSV||5.004000|
747 SvSetSV_nosteal||5.004000|
748 SvSetSV|||
749 SvTAINTED_off||5.004000|
750 SvTAINTED_on||5.004000|
751 SvTAINTED||5.004000|
752 SvTAINT|||
753 SvTRUE|||
754 SvTYPE|||
755 SvUNLOCK||5.007003|
756 SvUOK||5.007001|
757 SvUPGRADE|||
758 SvUTF8_off||5.006000|
759 SvUTF8_on||5.006000|
760 SvUTF8||5.006000|
761 SvUVXx|5.004000||p
762 SvUVX|5.004000||p
763 SvUV_nomg|5.009001||p
764 SvUVx|5.004000||p
765 SvUV|5.004000||p
766 SvVOK||5.008001|
767 THIS|||n
768 UNDERBAR|5.009002||p
769 UVSIZE|5.006000||p
770 UVTYPE|5.006000||p
771 UVXf|5.007001||p
772 UVof|5.006000||p
773 UVuf|5.006000||p
774 UVxf|5.006000||p
775 XCPT_CATCH|5.009002||p
776 XCPT_RETHROW|5.009002||p
777 XCPT_TRY_END|5.009002||p
778 XCPT_TRY_START|5.009002||p
779 XPUSHi|||
780 XPUSHmortal|5.009002||p
781 XPUSHn|||
782 XPUSHp|||
783 XPUSHs|||
784 XPUSHu|5.004000||p
785 XSRETURN_EMPTY|||
786 XSRETURN_IV|||
787 XSRETURN_NO|||
788 XSRETURN_NV|||
789 XSRETURN_PV|||
790 XSRETURN_UNDEF|||
791 XSRETURN_UV|5.008001||p
792 XSRETURN_YES|||
793 XSRETURN|||
794 XST_mIV|||
795 XST_mNO|||
796 XST_mNV|||
797 XST_mPV|||
798 XST_mUNDEF|||
799 XST_mUV|5.008001||p
800 XST_mYES|||
801 XS_VERSION_BOOTCHECK|||
802 XS_VERSION|||
803 XS|||
804 ZeroD|5.009002||p
805 Zero|||
806 _aMY_CXT|5.007003||p
807 _pMY_CXT|5.007003||p
808 aMY_CXT_|5.007003||p
809 aMY_CXT|5.007003||p
810 aTHX_|5.006000||p
811 aTHX|5.006000||p
812 add_data|||
813 allocmy|||
814 amagic_call|||
815 any_dup|||
816 ao|||
817 append_elem|||
818 append_list|||
819 apply_attrs_my|||
820 apply_attrs_string||5.006001|
821 apply_attrs|||
822 apply|||
823 asIV|||
824 asUV|||
825 atfork_lock||5.007003|n
826 atfork_unlock||5.007003|n
827 av_clear|||
828 av_delete||5.006000|
829 av_exists||5.006000|
830 av_extend|||
831 av_fake|||
832 av_fetch|||
833 av_fill|||
834 av_len|||
835 av_make|||
836 av_pop|||
837 av_push|||
838 av_reify|||
839 av_shift|||
840 av_store|||
841 av_undef|||
842 av_unshift|||
843 ax|||n
844 bad_type|||
845 bind_match|||
846 block_end|||
847 block_gimme||5.004000|
848 block_start|||
849 boolSV|5.004000||p
850 boot_core_PerlIO|||
851 boot_core_UNIVERSAL|||
852 boot_core_xsutils|||
853 bytes_from_utf8||5.007001|
854 bytes_to_utf8||5.006001|
855 cache_re|||
856 call_argv|5.006000||p
857 call_atexit||5.006000|
858 call_body|||
859 call_list_body|||
860 call_list||5.004000|
861 call_method|5.006000||p
862 call_pv|5.006000||p
863 call_sv|5.006000||p
864 calloc||5.007002|n
865 cando|||
866 cast_i32||5.006000|
867 cast_iv||5.006000|
868 cast_ulong||5.006000|
869 cast_uv||5.006000|
870 check_uni|||
871 checkcomma|||
872 checkposixcc|||
873 cl_and|||
874 cl_anything|||
875 cl_init_zero|||
876 cl_init|||
877 cl_is_anything|||
878 cl_or|||
879 closest_cop|||
880 convert|||
881 cop_free|||
882 cr_textfilter|||
883 croak_nocontext|||vn
884 croak|||v
885 csighandler||5.007001|n
886 custom_op_desc||5.007003|
887 custom_op_name||5.007003|
888 cv_ckproto|||
889 cv_clone|||
890 cv_const_sv||5.004000|
891 cv_dump|||
892 cv_undef|||
893 cx_dump||5.005000|
894 cx_dup|||
895 cxinc|||
896 dAX|5.007002||p
897 dITEMS|5.007002||p
898 dMARK|||
899 dMY_CXT_SV|5.007003||p
900 dMY_CXT|5.007003||p
901 dNOOP|5.006000||p
902 dORIGMARK|||
903 dSP|||
904 dTHR|5.004050||p
905 dTHXa|5.006000||p
906 dTHXoa|5.006000||p
907 dTHX|5.006000||p
908 dUNDERBAR|5.009002||p
909 dXCPT|5.009002||p
910 dXSARGS|||
911 dXSI32|||
912 dXSTARG|5.006000||p
913 deb_curcv|||
914 deb_nocontext|||vn
915 deb_stack_all|||
916 deb_stack_n|||
917 debop||5.005000|
918 debprofdump||5.005000|
919 debprof|||
920 debstackptrs||5.007003|
921 debstack||5.007003|
922 deb||5.007003|v
923 del_he|||
924 del_sv|||
925 del_xiv|||
926 del_xnv|||
927 del_xpvav|||
928 del_xpvbm|||
929 del_xpvcv|||
930 del_xpvhv|||
931 del_xpviv|||
932 del_xpvlv|||
933 del_xpvmg|||
934 del_xpvnv|||
935 del_xpv|||
936 del_xrv|||
937 delimcpy||5.004000|
938 depcom|||
939 deprecate_old|||
940 deprecate|||
941 despatch_signals||5.007001|
942 die_nocontext|||vn
943 die_where|||
944 die|||v
945 dirp_dup|||
946 div128|||
947 djSP|||
948 do_aexec5|||
949 do_aexec|||
950 do_aspawn|||
951 do_binmode||5.004050|
952 do_chomp|||
953 do_chop|||
954 do_close|||
955 do_dump_pad|||
956 do_eof|||
957 do_exec3|||
958 do_execfree|||
959 do_exec|||
960 do_gv_dump||5.006000|
961 do_gvgv_dump||5.006000|
962 do_hv_dump||5.006000|
963 do_ipcctl|||
964 do_ipcget|||
965 do_join|||
966 do_kv|||
967 do_magic_dump||5.006000|
968 do_msgrcv|||
969 do_msgsnd|||
970 do_oddball|||
971 do_op_dump||5.006000|
972 do_open9||5.006000|
973 do_openn||5.007001|
974 do_open||5.004000|
975 do_pipe|||
976 do_pmop_dump||5.006000|
977 do_print|||
978 do_readline|||
979 do_seek|||
980 do_semop|||
981 do_shmio|||
982 do_spawn_nowait|||
983 do_spawn|||
984 do_sprintf|||
985 do_sv_dump||5.006000|
986 do_sysseek|||
987 do_tell|||
988 do_trans_complex_utf8|||
989 do_trans_complex|||
990 do_trans_count_utf8|||
991 do_trans_count|||
992 do_trans_simple_utf8|||
993 do_trans_simple|||
994 do_trans|||
995 do_vecget|||
996 do_vecset|||
997 do_vop|||
998 docatch_body|||
999 docatch|||
1000 doencodes|||
1001 doeval|||
1002 dofile|||
1003 dofindlabel|||
1004 doform|||
1005 doing_taint||5.008001|n
1006 dooneliner|||
1007 doopen_pm|||
1008 doparseform|||
1009 dopoptoeval|||
1010 dopoptolabel|||
1011 dopoptoloop|||
1012 dopoptosub_at|||
1013 dopoptosub|||
1014 dounwind|||
1015 dowantarray|||
1016 dump_all||5.006000|
1017 dump_eval||5.006000|
1018 dump_fds|||
1019 dump_form||5.006000|
1020 dump_indent||5.006000|v
1021 dump_mstats|||
1022 dump_packsubs||5.006000|
1023 dump_sub||5.006000|
1024 dump_vindent||5.006000|
1025 dumpuntil|||
1026 dup_attrlist|||
1027 emulate_eaccess|||
1028 eval_pv|5.006000||p
1029 eval_sv|5.006000||p
1030 expect_number|||
1031 fbm_compile||5.005000|
1032 fbm_instr||5.005000|
1033 fd_on_nosuid_fs|||
1034 filter_add|||
1035 filter_del|||
1036 filter_gets|||
1037 filter_read|||
1038 find_beginning|||
1039 find_byclass|||
1040 find_in_my_stash|||
1041 find_runcv|||
1042 find_rundefsvoffset||5.009002|
1043 find_script|||
1044 find_uninit_var|||
1045 fold_constants|||
1046 forbid_setid|||
1047 force_ident|||
1048 force_list|||
1049 force_next|||
1050 force_version|||
1051 force_word|||
1052 form_nocontext|||vn
1053 form||5.004000|v
1054 fp_dup|||
1055 fprintf_nocontext|||vn
1056 free_tied_hv_pool|||
1057 free_tmps|||
1058 gen_constant_list|||
1059 get_av|5.006000||p
1060 get_context||5.006000|n
1061 get_cv|5.006000||p
1062 get_db_sub|||
1063 get_debug_opts|||
1064 get_hash_seed|||
1065 get_hv|5.006000||p
1066 get_mstats|||
1067 get_no_modify|||
1068 get_num|||
1069 get_op_descs||5.005000|
1070 get_op_names||5.005000|
1071 get_opargs|||
1072 get_ppaddr||5.006000|
1073 get_sv|5.006000||p
1074 get_vtbl||5.005030|
1075 getcwd_sv||5.007002|
1076 getenv_len|||
1077 gp_dup|||
1078 gp_free|||
1079 gp_ref|||
1080 grok_bin|5.007003||p
1081 grok_hex|5.007003||p
1082 grok_number|5.007002||p
1083 grok_numeric_radix|5.007002||p
1084 grok_oct|5.007003||p
1085 group_end|||
1086 gv_AVadd|||
1087 gv_HVadd|||
1088 gv_IOadd|||
1089 gv_autoload4||5.004000|
1090 gv_check|||
1091 gv_dump||5.006000|
1092 gv_efullname3||5.004000|
1093 gv_efullname4||5.006001|
1094 gv_efullname|||
1095 gv_ename|||
1096 gv_fetchfile|||
1097 gv_fetchmeth_autoload||5.007003|
1098 gv_fetchmethod_autoload||5.004000|
1099 gv_fetchmethod|||
1100 gv_fetchmeth|||
1101 gv_fetchpvn_flags||5.009002|
1102 gv_fetchpv|||
1103 gv_fetchsv||5.009002|
1104 gv_fullname3||5.004000|
1105 gv_fullname4||5.006001|
1106 gv_fullname|||
1107 gv_handler||5.007001|
1108 gv_init_sv|||
1109 gv_init|||
1110 gv_share|||
1111 gv_stashpvn|5.006000||p
1112 gv_stashpv|||
1113 gv_stashsv|||
1114 he_dup|||
1115 hfreeentries|||
1116 hsplit|||
1117 hv_assert||5.009001|
1118 hv_clear_placeholders||5.009001|
1119 hv_clear|||
1120 hv_delayfree_ent||5.004000|
1121 hv_delete_common|||
1122 hv_delete_ent||5.004000|
1123 hv_delete|||
1124 hv_exists_ent||5.004000|
1125 hv_exists|||
1126 hv_fetch_common|||
1127 hv_fetch_ent||5.004000|
1128 hv_fetch|||
1129 hv_free_ent||5.004000|
1130 hv_iterinit|||
1131 hv_iterkeysv||5.004000|
1132 hv_iterkey|||
1133 hv_iternext_flags||5.008000|
1134 hv_iternextsv|||
1135 hv_iternext|||
1136 hv_iterval|||
1137 hv_ksplit||5.004000|
1138 hv_magic_check|||
1139 hv_magic|||
1140 hv_notallowed|||
1141 hv_scalar||5.009001|
1142 hv_store_ent||5.004000|
1143 hv_store_flags||5.008000|
1144 hv_store|||
1145 hv_undef|||
1146 ibcmp_locale||5.004000|
1147 ibcmp_utf8||5.007003|
1148 ibcmp|||
1149 incl_perldb|||
1150 incline|||
1151 incpush|||
1152 ingroup|||
1153 init_argv_symbols|||
1154 init_debugger|||
1155 init_i18nl10n||5.006000|
1156 init_i18nl14n||5.006000|
1157 init_ids|||
1158 init_interp|||
1159 init_lexer|||
1160 init_main_stash|||
1161 init_perllib|||
1162 init_postdump_symbols|||
1163 init_predump_symbols|||
1164 init_stacks||5.005000|
1165 init_tm||5.007002|
1166 instr|||
1167 intro_my|||
1168 intuit_method|||
1169 intuit_more|||
1170 invert|||
1171 io_close|||
1172 isALNUM|||
1173 isALPHA|||
1174 isDIGIT|||
1175 isLOWER|||
1176 isSPACE|||
1177 isUPPER|||
1178 is_an_int|||
1179 is_gv_magical_sv|||
1180 is_gv_magical|||
1181 is_handle_constructor|||
1182 is_lvalue_sub||5.007001|
1183 is_uni_alnum_lc||5.006000|
1184 is_uni_alnumc_lc||5.006000|
1185 is_uni_alnumc||5.006000|
1186 is_uni_alnum||5.006000|
1187 is_uni_alpha_lc||5.006000|
1188 is_uni_alpha||5.006000|
1189 is_uni_ascii_lc||5.006000|
1190 is_uni_ascii||5.006000|
1191 is_uni_cntrl_lc||5.006000|
1192 is_uni_cntrl||5.006000|
1193 is_uni_digit_lc||5.006000|
1194 is_uni_digit||5.006000|
1195 is_uni_graph_lc||5.006000|
1196 is_uni_graph||5.006000|
1197 is_uni_idfirst_lc||5.006000|
1198 is_uni_idfirst||5.006000|
1199 is_uni_lower_lc||5.006000|
1200 is_uni_lower||5.006000|
1201 is_uni_print_lc||5.006000|
1202 is_uni_print||5.006000|
1203 is_uni_punct_lc||5.006000|
1204 is_uni_punct||5.006000|
1205 is_uni_space_lc||5.006000|
1206 is_uni_space||5.006000|
1207 is_uni_upper_lc||5.006000|
1208 is_uni_upper||5.006000|
1209 is_uni_xdigit_lc||5.006000|
1210 is_uni_xdigit||5.006000|
1211 is_utf8_alnumc||5.006000|
1212 is_utf8_alnum||5.006000|
1213 is_utf8_alpha||5.006000|
1214 is_utf8_ascii||5.006000|
1215 is_utf8_char||5.006000|
1216 is_utf8_cntrl||5.006000|
1217 is_utf8_digit||5.006000|
1218 is_utf8_graph||5.006000|
1219 is_utf8_idcont||5.008000|
1220 is_utf8_idfirst||5.006000|
1221 is_utf8_lower||5.006000|
1222 is_utf8_mark||5.006000|
1223 is_utf8_print||5.006000|
1224 is_utf8_punct||5.006000|
1225 is_utf8_space||5.006000|
1226 is_utf8_string_loc||5.008001|
1227 is_utf8_string||5.006001|
1228 is_utf8_upper||5.006000|
1229 is_utf8_xdigit||5.006000|
1230 isa_lookup|||
1231 items|||n
1232 ix|||n
1233 jmaybe|||
1234 keyword|||
1235 leave_scope|||
1236 lex_end|||
1237 lex_start|||
1238 linklist|||
1239 list_assignment|||
1240 listkids|||
1241 list|||
1242 load_module_nocontext|||vn
1243 load_module||5.006000|v
1244 localize|||
1245 looks_like_number|||
1246 lop|||
1247 mPUSHi|5.009002||p
1248 mPUSHn|5.009002||p
1249 mPUSHp|5.009002||p
1250 mPUSHu|5.009002||p
1251 mXPUSHi|5.009002||p
1252 mXPUSHn|5.009002||p
1253 mXPUSHp|5.009002||p
1254 mXPUSHu|5.009002||p
1255 magic_clear_all_env|||
1256 magic_clearenv|||
1257 magic_clearpack|||
1258 magic_clearsig|||
1259 magic_dump||5.006000|
1260 magic_existspack|||
1261 magic_freeovrld|||
1262 magic_freeregexp|||
1263 magic_getarylen|||
1264 magic_getdefelem|||
1265 magic_getglob|||
1266 magic_getnkeys|||
1267 magic_getpack|||
1268 magic_getpos|||
1269 magic_getsig|||
1270 magic_getsubstr|||
1271 magic_gettaint|||
1272 magic_getuvar|||
1273 magic_getvec|||
1274 magic_get|||
1275 magic_killbackrefs|||
1276 magic_len|||
1277 magic_methcall|||
1278 magic_methpack|||
1279 magic_nextpack|||
1280 magic_regdata_cnt|||
1281 magic_regdatum_get|||
1282 magic_regdatum_set|||
1283 magic_scalarpack|||
1284 magic_set_all_env|||
1285 magic_setamagic|||
1286 magic_setarylen|||
1287 magic_setbm|||
1288 magic_setcollxfrm|||
1289 magic_setdbline|||
1290 magic_setdefelem|||
1291 magic_setenv|||
1292 magic_setfm|||
1293 magic_setglob|||
1294 magic_setisa|||
1295 magic_setmglob|||
1296 magic_setnkeys|||
1297 magic_setpack|||
1298 magic_setpos|||
1299 magic_setregexp|||
1300 magic_setsig|||
1301 magic_setsubstr|||
1302 magic_settaint|||
1303 magic_setutf8|||
1304 magic_setuvar|||
1305 magic_setvec|||
1306 magic_set|||
1307 magic_sizepack|||
1308 magic_wipepack|||
1309 magicname|||
1310 malloced_size|||n
1311 malloc||5.007002|n
1312 markstack_grow|||
1313 measure_struct|||
1314 memEQ|5.004000||p
1315 memNE|5.004000||p
1316 mem_collxfrm|||
1317 mess_alloc|||
1318 mess_nocontext|||vn
1319 mess||5.006000|v
1320 method_common|||
1321 mfree||5.007002|n
1322 mg_clear|||
1323 mg_copy|||
1324 mg_dup|||
1325 mg_find|||
1326 mg_free|||
1327 mg_get|||
1328 mg_length||5.005000|
1329 mg_magical|||
1330 mg_set|||
1331 mg_size||5.005000|
1332 mini_mktime||5.007002|
1333 missingterm|||
1334 mode_from_discipline|||
1335 modkids|||
1336 mod|||
1337 more_he|||
1338 more_sv|||
1339 more_xiv|||
1340 more_xnv|||
1341 more_xpvav|||
1342 more_xpvbm|||
1343 more_xpvcv|||
1344 more_xpvhv|||
1345 more_xpviv|||
1346 more_xpvlv|||
1347 more_xpvmg|||
1348 more_xpvnv|||
1349 more_xpv|||
1350 more_xrv|||
1351 moreswitches|||
1352 mul128|||
1353 mulexp10|||n
1354 my_atof2||5.007002|
1355 my_atof||5.006000|
1356 my_attrs|||
1357 my_bcopy|||n
1358 my_betoh16|||n
1359 my_betoh32|||n
1360 my_betoh64|||n
1361 my_betohi|||n
1362 my_betohl|||n
1363 my_betohs|||n
1364 my_bzero|||n
1365 my_chsize|||
1366 my_exit_jump|||
1367 my_exit|||
1368 my_failure_exit||5.004000|
1369 my_fflush_all||5.006000|
1370 my_fork||5.007003|n
1371 my_htobe16|||n
1372 my_htobe32|||n
1373 my_htobe64|||n
1374 my_htobei|||n
1375 my_htobel|||n
1376 my_htobes|||n
1377 my_htole16|||n
1378 my_htole32|||n
1379 my_htole64|||n
1380 my_htolei|||n
1381 my_htolel|||n
1382 my_htoles|||n
1383 my_htonl|||
1384 my_kid|||
1385 my_letoh16|||n
1386 my_letoh32|||n
1387 my_letoh64|||n
1388 my_letohi|||n
1389 my_letohl|||n
1390 my_letohs|||n
1391 my_lstat|||
1392 my_memcmp||5.004000|n
1393 my_memset|||n
1394 my_ntohl|||
1395 my_pclose||5.004000|
1396 my_popen_list||5.007001|
1397 my_popen||5.004000|
1398 my_setenv|||
1399 my_socketpair||5.007003|n
1400 my_stat|||
1401 my_strftime||5.007002|
1402 my_swabn|||n
1403 my_swap|||
1404 my_unexec|||
1405 my|||
1406 newANONATTRSUB||5.006000|
1407 newANONHASH|||
1408 newANONLIST|||
1409 newANONSUB|||
1410 newASSIGNOP|||
1411 newATTRSUB||5.006000|
1412 newAVREF|||
1413 newAV|||
1414 newBINOP|||
1415 newCONDOP|||
1416 newCONSTSUB|5.006000||p
1417 newCVREF|||
1418 newDEFSVOP|||
1419 newFORM|||
1420 newFOROP|||
1421 newGVOP|||
1422 newGVREF|||
1423 newGVgen|||
1424 newHVREF|||
1425 newHVhv||5.005000|
1426 newHV|||
1427 newIO|||
1428 newLISTOP|||
1429 newLOGOP|||
1430 newLOOPEX|||
1431 newLOOPOP|||
1432 newMYSUB||5.006000|
1433 newNULLLIST|||
1434 newOP|||
1435 newPADOP||5.006000|
1436 newPMOP|||
1437 newPROG|||
1438 newPVOP|||
1439 newRANGE|||
1440 newRV_inc|5.004000||p
1441 newRV_noinc|5.006000||p
1442 newRV|||
1443 newSLICEOP|||
1444 newSTATEOP|||
1445 newSUB|||
1446 newSVOP|||
1447 newSVREF|||
1448 newSViv|||
1449 newSVnv|||
1450 newSVpvf_nocontext|||vn
1451 newSVpvf||5.004000|v
1452 newSVpvn_share||5.007001|
1453 newSVpvn|5.006000||p
1454 newSVpv|||
1455 newSVrv|||
1456 newSVsv|||
1457 newSVuv|5.006000||p
1458 newSV|||
1459 newUNOP|||
1460 newWHILEOP||5.004040|
1461 newXSproto||5.006000|
1462 newXS||5.006000|
1463 new_collate||5.006000|
1464 new_constant|||
1465 new_ctype||5.006000|
1466 new_he|||
1467 new_logop|||
1468 new_numeric||5.006000|
1469 new_stackinfo||5.005000|
1470 new_version||5.009000|
1471 new_xiv|||
1472 new_xnv|||
1473 new_xpvav|||
1474 new_xpvbm|||
1475 new_xpvcv|||
1476 new_xpvhv|||
1477 new_xpviv|||
1478 new_xpvlv|||
1479 new_xpvmg|||
1480 new_xpvnv|||
1481 new_xpv|||
1482 new_xrv|||
1483 next_symbol|||
1484 nextargv|||
1485 nextchar|||
1486 ninstr|||
1487 no_bareword_allowed|||
1488 no_fh_allowed|||
1489 no_op|||
1490 not_a_number|||
1491 nothreadhook||5.008000|
1492 nuke_stacks|||
1493 num_overflow|||n
1494 oopsAV|||
1495 oopsCV|||
1496 oopsHV|||
1497 op_clear|||
1498 op_const_sv|||
1499 op_dump||5.006000|
1500 op_free|||
1501 op_null||5.007002|
1502 op_refcnt_lock||5.009002|
1503 op_refcnt_unlock||5.009002|
1504 open_script|||
1505 pMY_CXT_|5.007003||p
1506 pMY_CXT|5.007003||p
1507 pTHX_|5.006000||p
1508 pTHX|5.006000||p
1509 pack_cat||5.007003|
1510 pack_rec|||
1511 package|||
1512 packlist||5.008001|
1513 pad_add_anon|||
1514 pad_add_name|||
1515 pad_alloc|||
1516 pad_block_start|||
1517 pad_check_dup|||
1518 pad_findlex|||
1519 pad_findmy|||
1520 pad_fixup_inner_anons|||
1521 pad_free|||
1522 pad_leavemy|||
1523 pad_new|||
1524 pad_push|||
1525 pad_reset|||
1526 pad_setsv|||
1527 pad_sv|||
1528 pad_swipe|||
1529 pad_tidy|||
1530 pad_undef|||
1531 parse_body|||
1532 parse_unicode_opts|||
1533 path_is_absolute|||
1534 peep|||
1535 pending_ident|||
1536 perl_alloc_using|||n
1537 perl_alloc|||n
1538 perl_clone_using|||n
1539 perl_clone|||n
1540 perl_construct|||n
1541 perl_destruct||5.007003|n
1542 perl_free|||n
1543 perl_parse||5.006000|n
1544 perl_run|||n
1545 pidgone|||
1546 pmflag|||
1547 pmop_dump||5.006000|
1548 pmruntime|||
1549 pmtrans|||
1550 pop_scope|||
1551 pregcomp|||
1552 pregexec|||
1553 pregfree|||
1554 prepend_elem|||
1555 printf_nocontext|||vn
1556 ptr_table_clear|||
1557 ptr_table_fetch|||
1558 ptr_table_free|||
1559 ptr_table_new|||
1560 ptr_table_split|||
1561 ptr_table_store|||
1562 push_scope|||
1563 put_byte|||
1564 pv_display||5.006000|
1565 pv_uni_display||5.007003|
1566 qerror|||
1567 re_croak2|||
1568 re_dup|||
1569 re_intuit_start||5.006000|
1570 re_intuit_string||5.006000|
1571 realloc||5.007002|n
1572 reentrant_free|||
1573 reentrant_init|||
1574 reentrant_retry|||vn
1575 reentrant_size|||
1576 refkids|||
1577 refto|||
1578 ref|||
1579 reg_node|||
1580 reganode|||
1581 regatom|||
1582 regbranch|||
1583 regclass_swash||5.007003|
1584 regclass|||
1585 regcp_set_to|||
1586 regcppop|||
1587 regcppush|||
1588 regcurly|||
1589 regdump||5.005000|
1590 regexec_flags||5.005000|
1591 reghop3|||
1592 reghopmaybe3|||
1593 reghopmaybe|||
1594 reghop|||
1595 reginclass|||
1596 reginitcolors||5.006000|
1597 reginsert|||
1598 regmatch|||
1599 regnext||5.005000|
1600 regoptail|||
1601 regpiece|||
1602 regpposixcc|||
1603 regprop|||
1604 regrepeat_hard|||
1605 regrepeat|||
1606 regtail|||
1607 regtry|||
1608 reguni|||
1609 regwhite|||
1610 reg|||
1611 repeatcpy|||
1612 report_evil_fh|||
1613 report_uninit|||
1614 require_errno|||
1615 require_pv||5.006000|
1616 rninstr|||
1617 rsignal_restore|||
1618 rsignal_save|||
1619 rsignal_state||5.004000|
1620 rsignal||5.004000|
1621 run_body|||
1622 runops_debug||5.005000|
1623 runops_standard||5.005000|
1624 rxres_free|||
1625 rxres_restore|||
1626 rxres_save|||
1627 safesyscalloc||5.006000|n
1628 safesysfree||5.006000|n
1629 safesysmalloc||5.006000|n
1630 safesysrealloc||5.006000|n
1631 same_dirent|||
1632 save_I16||5.004000|
1633 save_I32|||
1634 save_I8||5.006000|
1635 save_aelem||5.004050|
1636 save_alloc||5.006000|
1637 save_aptr|||
1638 save_ary|||
1639 save_bool||5.008001|
1640 save_clearsv|||
1641 save_delete|||
1642 save_destructor_x||5.006000|
1643 save_destructor||5.006000|
1644 save_freeop|||
1645 save_freepv|||
1646 save_freesv|||
1647 save_generic_pvref||5.006001|
1648 save_generic_svref||5.005030|
1649 save_gp||5.004000|
1650 save_hash|||
1651 save_hek_flags|||
1652 save_helem||5.004050|
1653 save_hints||5.005000|
1654 save_hptr|||
1655 save_int|||
1656 save_item|||
1657 save_iv||5.005000|
1658 save_lines|||
1659 save_list|||
1660 save_long|||
1661 save_magic|||
1662 save_mortalizesv||5.007001|
1663 save_nogv|||
1664 save_op|||
1665 save_padsv||5.007001|
1666 save_pptr|||
1667 save_re_context||5.006000|
1668 save_scalar_at|||
1669 save_scalar|||
1670 save_set_svflags||5.009000|
1671 save_shared_pvref||5.007003|
1672 save_sptr|||
1673 save_svref|||
1674 save_threadsv||5.005000|
1675 save_vptr||5.006000|
1676 savepvn|||
1677 savepv|||
1678 savesharedpv||5.007003|
1679 savestack_grow_cnt||5.008001|
1680 savestack_grow|||
1681 savesvpv||5.009002|
1682 sawparens|||
1683 scalar_mod_type|||
1684 scalarboolean|||
1685 scalarkids|||
1686 scalarseq|||
1687 scalarvoid|||
1688 scalar|||
1689 scan_bin||5.006000|
1690 scan_commit|||
1691 scan_const|||
1692 scan_formline|||
1693 scan_heredoc|||
1694 scan_hex|||
1695 scan_ident|||
1696 scan_inputsymbol|||
1697 scan_num||5.007001|
1698 scan_oct|||
1699 scan_pat|||
1700 scan_str|||
1701 scan_subst|||
1702 scan_trans|||
1703 scan_version||5.009001|
1704 scan_vstring||5.008001|
1705 scan_word|||
1706 scope|||
1707 screaminstr||5.005000|
1708 seed|||
1709 set_context||5.006000|n
1710 set_csh|||
1711 set_numeric_local||5.006000|
1712 set_numeric_radix||5.006000|
1713 set_numeric_standard||5.006000|
1714 setdefout|||
1715 setenv_getix|||
1716 share_hek_flags|||
1717 share_hek|||
1718 si_dup|||
1719 sighandler|||n
1720 simplify_sort|||
1721 skipspace|||
1722 sortsv||5.007003|
1723 ss_dup|||
1724 stack_grow|||
1725 start_glob|||
1726 start_subparse||5.004000|
1727 stdize_locale|||
1728 strEQ|||
1729 strGE|||
1730 strGT|||
1731 strLE|||
1732 strLT|||
1733 strNE|||
1734 str_to_version||5.006000|
1735 strnEQ|||
1736 strnNE|||
1737 study_chunk|||
1738 sub_crush_depth|||
1739 sublex_done|||
1740 sublex_push|||
1741 sublex_start|||
1742 sv_2bool|||
1743 sv_2cv|||
1744 sv_2io|||
1745 sv_2iuv_non_preserve|||
1746 sv_2iv_flags||5.009001|
1747 sv_2iv|||
1748 sv_2mortal|||
1749 sv_2nv|||
1750 sv_2pv_flags||5.007002|
1751 sv_2pv_nolen|5.006000||p
1752 sv_2pvbyte_nolen|||
1753 sv_2pvbyte|5.006000||p
1754 sv_2pvutf8_nolen||5.006000|
1755 sv_2pvutf8||5.006000|
1756 sv_2pv|||
1757 sv_2uv_flags||5.009001|
1758 sv_2uv|5.004000||p
1759 sv_add_arena|||
1760 sv_add_backref|||
1761 sv_backoff|||
1762 sv_bless|||
1763 sv_cat_decode||5.008001|
1764 sv_catpv_mg|5.006000||p
1765 sv_catpvf_mg_nocontext|||pvn
1766 sv_catpvf_mg|5.006000|5.004000|pv
1767 sv_catpvf_nocontext|||vn
1768 sv_catpvf||5.004000|v
1769 sv_catpvn_flags||5.007002|
1770 sv_catpvn_mg|5.006000||p
1771 sv_catpvn_nomg|5.007002||p
1772 sv_catpvn|||
1773 sv_catpv|||
1774 sv_catsv_flags||5.007002|
1775 sv_catsv_mg|5.006000||p
1776 sv_catsv_nomg|5.007002||p
1777 sv_catsv|||
1778 sv_chop|||
1779 sv_clean_all|||
1780 sv_clean_objs|||
1781 sv_clear|||
1782 sv_cmp_locale||5.004000|
1783 sv_cmp|||
1784 sv_collxfrm|||
1785 sv_compile_2op||5.008001|
1786 sv_copypv||5.007003|
1787 sv_dec|||
1788 sv_del_backref|||
1789 sv_derived_from||5.004000|
1790 sv_dump|||
1791 sv_dup|||
1792 sv_eq|||
1793 sv_force_normal_flags||5.007001|
1794 sv_force_normal||5.006000|
1795 sv_free2|||
1796 sv_free_arenas|||
1797 sv_free|||
1798 sv_gets||5.004000|
1799 sv_grow|||
1800 sv_inc|||
1801 sv_insert|||
1802 sv_isa|||
1803 sv_isobject|||
1804 sv_iv||5.005000|
1805 sv_len_utf8||5.006000|
1806 sv_len|||
1807 sv_magicext||5.007003|
1808 sv_magic|||
1809 sv_mortalcopy|||
1810 sv_newmortal|||
1811 sv_newref|||
1812 sv_nolocking||5.007003|
1813 sv_nosharing||5.007003|
1814 sv_nounlocking||5.007003|
1815 sv_nv||5.005000|
1816 sv_peek||5.005000|
1817 sv_pos_b2u||5.006000|
1818 sv_pos_u2b||5.006000|
1819 sv_pvbyten_force||5.006000|
1820 sv_pvbyten||5.006000|
1821 sv_pvbyte||5.006000|
1822 sv_pvn_force_flags||5.007002|
1823 sv_pvn_force|||p
1824 sv_pvn_nomg|5.007003||p
1825 sv_pvn|5.006000||p
1826 sv_pvutf8n_force||5.006000|
1827 sv_pvutf8n||5.006000|
1828 sv_pvutf8||5.006000|
1829 sv_pv||5.006000|
1830 sv_recode_to_utf8||5.007003|
1831 sv_reftype|||
1832 sv_release_COW|||
1833 sv_release_IVX|||
1834 sv_replace|||
1835 sv_report_used|||
1836 sv_reset|||
1837 sv_rvweaken||5.006000|
1838 sv_setiv_mg|5.006000||p
1839 sv_setiv|||
1840 sv_setnv_mg|5.006000||p
1841 sv_setnv|||
1842 sv_setpv_mg|5.006000||p
1843 sv_setpvf_mg_nocontext|||pvn
1844 sv_setpvf_mg|5.006000|5.004000|pv
1845 sv_setpvf_nocontext|||vn
1846 sv_setpvf||5.004000|v
1847 sv_setpviv_mg||5.008001|
1848 sv_setpviv||5.008001|
1849 sv_setpvn_mg|5.006000||p
1850 sv_setpvn|||
1851 sv_setpv|||
1852 sv_setref_iv|||
1853 sv_setref_nv|||
1854 sv_setref_pvn|||
1855 sv_setref_pv|||
1856 sv_setref_uv||5.007001|
1857 sv_setsv_cow|||
1858 sv_setsv_flags||5.007002|
1859 sv_setsv_mg|5.006000||p
1860 sv_setsv_nomg|5.007002||p
1861 sv_setsv|||
1862 sv_setuv_mg|5.006000||p
1863 sv_setuv|5.006000||p
1864 sv_tainted||5.004000|
1865 sv_taint||5.004000|
1866 sv_true||5.005000|
1867 sv_unglob|||
1868 sv_uni_display||5.007003|
1869 sv_unmagic|||
1870 sv_unref_flags||5.007001|
1871 sv_unref|||
1872 sv_untaint||5.004000|
1873 sv_upgrade|||
1874 sv_usepvn_mg|5.006000||p
1875 sv_usepvn|||
1876 sv_utf8_decode||5.006000|
1877 sv_utf8_downgrade||5.006000|
1878 sv_utf8_encode||5.006000|
1879 sv_utf8_upgrade_flags||5.007002|
1880 sv_utf8_upgrade||5.007001|
1881 sv_uv|5.006000||p
1882 sv_vcatpvf_mg|5.006000|5.004000|p
1883 sv_vcatpvfn||5.004000|
1884 sv_vcatpvf|5.006000|5.004000|p
1885 sv_vsetpvf_mg|5.006000|5.004000|p
1886 sv_vsetpvfn||5.004000|
1887 sv_vsetpvf|5.006000|5.004000|p
1888 svtype|||
1889 swallow_bom|||
1890 swash_fetch||5.007002|
1891 swash_init||5.006000|
1892 sys_intern_clear|||
1893 sys_intern_dup|||
1894 sys_intern_init|||
1895 taint_env|||
1896 taint_proper|||
1897 tmps_grow||5.006000|
1898 toLOWER|||
1899 toUPPER|||
1900 to_byte_substr|||
1901 to_uni_fold||5.007003|
1902 to_uni_lower_lc||5.006000|
1903 to_uni_lower||5.007003|
1904 to_uni_title_lc||5.006000|
1905 to_uni_title||5.007003|
1906 to_uni_upper_lc||5.006000|
1907 to_uni_upper||5.007003|
1908 to_utf8_case||5.007003|
1909 to_utf8_fold||5.007003|
1910 to_utf8_lower||5.007003|
1911 to_utf8_substr|||
1912 to_utf8_title||5.007003|
1913 to_utf8_upper||5.007003|
1914 tokeq|||
1915 tokereport|||
1916 too_few_arguments|||
1917 too_many_arguments|||
1918 unlnk|||
1919 unpack_rec|||
1920 unpack_str||5.007003|
1921 unpackstring||5.008001|
1922 unshare_hek_or_pvn|||
1923 unshare_hek|||
1924 unsharepvn||5.004000|
1925 upg_version||5.009000|
1926 usage|||
1927 utf16_textfilter|||
1928 utf16_to_utf8_reversed||5.006001|
1929 utf16_to_utf8||5.006001|
1930 utf16rev_textfilter|||
1931 utf8_distance||5.006000|
1932 utf8_hop||5.006000|
1933 utf8_length||5.007001|
1934 utf8_mg_pos_init|||
1935 utf8_mg_pos|||
1936 utf8_to_bytes||5.006001|
1937 utf8_to_uvchr||5.007001|
1938 utf8_to_uvuni||5.007001|
1939 utf8n_to_uvchr||5.007001|
1940 utf8n_to_uvuni||5.007001|
1941 utilize|||
1942 uvchr_to_utf8_flags||5.007003|
1943 uvchr_to_utf8||5.007001|
1944 uvuni_to_utf8_flags||5.007003|
1945 uvuni_to_utf8||5.007001|
1946 validate_suid|||
1947 vcmp||5.009000|
1948 vcroak||5.006000|
1949 vdeb||5.007003|
1950 vdie|||
1951 vform||5.006000|
1952 visit|||
1953 vivify_defelem|||
1954 vivify_ref|||
1955 vload_module||5.006000|
1956 vmess||5.006000|
1957 vnewSVpvf|5.006000|5.004000|p
1958 vnormal||5.009002|
1959 vnumify||5.009000|
1960 vstringify||5.009000|
1961 vwarner||5.006000|
1962 vwarn||5.006000|
1963 wait4pid|||
1964 warn_nocontext|||vn
1965 warner_nocontext|||vn
1966 warner||5.006000|v
1967 warn|||v
1968 watch|||
1969 whichsig|||
1970 write_to_stderr|||
1971 yyerror|||
1972 yylex|||
1973 yyparse|||
1974 yywarn|||
1975 );
1976
1977 if (exists $opt{'list-unsupported'}) {
1978 my $f;
1979 for $f (sort { lc $a cmp lc $b } keys %API) {
1980 next unless $API{$f}{todo};
1981 print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n";
1982 }
1983 exit 0;
1984 }
1985
1986 # Scan for possible replacement candidates
1987
1988 my(%replace, %need, %hints, %depends);
1989 my $replace = 0;
1990 my $hint = '';
1991
1992 while (<DATA>) {
1993 if ($hint) {
1994 if (m{^\s*\*\s(.*?)\s*$}) {
1995 $hints{$hint} ||= ''; # suppress warning with older perls
1996 $hints{$hint} .= "$1\n";
1997 }
1998 else {
1999 $hint = '';
2000 }
2001 }
2002 $hint = $1 if m{^\s*$rccs\sHint:\s+(\w+)\s*$};
2003
2004 $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$};
2005 $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)};
2006 $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce};
2007 $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$};
2008
2009 if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) {
2010 push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2;
2011 }
2012
2013 $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
2014 }
2015
2016 if (exists $opt{'api-info'}) {
2017 my $f;
2018 my $count = 0;
2019 my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
2020 for $f (sort { lc $a cmp lc $b } keys %API) {
2021 next unless $f =~ /$match/;
2022 print "\n=== $f ===\n\n";
2023 my $info = 0;
2024 if ($API{$f}{base} || $API{$f}{todo}) {
2025 my $base = format_version($API{$f}{base} || $API{$f}{todo});
2026 print "Supported at least starting from perl-$base.\n";
2027 $info++;
2028 }
2029 if ($API{$f}{provided}) {
2030 my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
2031 print "Support by $ppport provided back to perl-$todo.\n";
2032 print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
2033 print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
2034 print "$hints{$f}" if exists $hints{$f};
2035 $info++;
2036 }
2037 unless ($info) {
2038 print "No portability information available.\n";
2039 }
2040 $count++;
2041 }
2042 if ($count > 0) {
2043 print "\n";
2044 }
2045 else {
2046 print "Found no API matching '$opt{'api-info'}'.\n";
2047 }
2048 exit 0;
2049 }
2050
2051 if (exists $opt{'list-provided'}) {
2052 my $f;
2053 for $f (sort { lc $a cmp lc $b } keys %API) {
2054 next unless $API{$f}{provided};
2055 my @flags;
2056 push @flags, 'explicit' if exists $need{$f};
2057 push @flags, 'depend' if exists $depends{$f};
2058 push @flags, 'hint' if exists $hints{$f};
2059 my $flags = @flags ? ' ['.join(', ', @flags).']' : '';
2060 print "$f$flags\n";
2061 }
2062 exit 0;
2063 }
2064
2065 my(%files, %global, %revreplace);
2066 %revreplace = reverse %replace;
2067 my $filename;
2068 my $patch_opened = 0;
2069
2070 for $filename (@files) {
2071 unless (open IN, "<$filename") {
2072 warn "Unable to read from $filename: $!\n";
2073 next;
2074 }
2075
2076 info("Scanning $filename ...");
2077
2078 my $c = do { local $/; <IN> };
2079 close IN;
2080
2081 my %file = (orig => $c, changes => 0);
2082
2083 # temporarily remove C comments from the code
2084 my @ccom;
2085 $c =~ s{
2086 (
2087 [^"'/]+
2088 |
2089 (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+
2090 |
2091 (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+
2092 )
2093 |
2094 (/ (?:
2095 \*[^*]*\*+(?:[^$ccs][^*]*\*+)* /
2096 |
2097 /[^\r\n]*
2098 ))
2099 }{
2100 defined $2 and push @ccom, $2;
2101 defined $1 ? $1 : "$ccs$#ccom$cce";
2102 }egsx;
2103
2104 $file{ccom} = \@ccom;
2105 $file{code} = $c;
2106 $file{has_inc_ppport} = ($c =~ /#.*include.*\Q$ppport\E/);
2107
2108 my $func;
2109
2110 for $func (keys %API) {
2111 my $match = $func;
2112 $match .= "|$revreplace{$func}" if exists $revreplace{$func};
2113 if ($c =~ /\b(?:Perl_)?($match)\b/) {
2114 $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func};
2115 $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/;
2116 if (exists $API{$func}{provided}) {
2117 if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
2118 $file{uses}{$func}++;
2119 my @deps = rec_depend($func);
2120 if (@deps) {
2121 $file{uses_deps}{$func} = \@deps;
2122 for (@deps) {
2123 $file{uses}{$_} = 0 unless exists $file{uses}{$_};
2124 }
2125 }
2126 for ($func, @deps) {
2127 if (exists $need{$_}) {
2128 $file{needs}{$_} = 'static';
2129 }
2130 }
2131 }
2132 }
2133 if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
2134 if ($c =~ /\b$func\b/) {
2135 $file{uses_todo}{$func}++;
2136 }
2137 }
2138 }
2139 }
2140
2141 while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
2142 if (exists $need{$2}) {
2143 $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
2144 }
2145 else {
2146 warning("Possibly wrong #define $1 in $filename");
2147 }
2148 }
2149
2150 for (qw(uses needs uses_todo needed_global needed_static)) {
2151 for $func (keys %{$file{$_}}) {
2152 push @{$global{$_}{$func}}, $filename;
2153 }
2154 }
2155
2156 $files{$filename} = \%file;
2157 }
2158
2159 # Globally resolve NEED_'s
2160 my $need;
2161 for $need (keys %{$global{needs}}) {
2162 if (@{$global{needs}{$need}} > 1) {
2163 my @targets = @{$global{needs}{$need}};
2164 my @t = grep $files{$_}{needed_global}{$need}, @targets;
2165 @targets = @t if @t;
2166 @t = grep /\.xs$/i, @targets;
2167 @targets = @t if @t;
2168 my $target = shift @targets;
2169 $files{$target}{needs}{$need} = 'global';
2170 for (@{$global{needs}{$need}}) {
2171 $files{$_}{needs}{$need} = 'extern' if $_ ne $target;
2172 }
2173 }
2174 }
2175
2176 for $filename (@files) {
2177 exists $files{$filename} or next;
2178
2179 info("=== Analyzing $filename ===");
2180
2181 my %file = %{$files{$filename}};
2182 my $func;
2183 my $c = $file{code};
2184
2185 for $func (sort keys %{$file{uses_Perl}}) {
2186 if ($API{$func}{varargs}) {
2187 my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))}
2188 { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge);
2189 if ($changes) {
2190 warning("Doesn't pass interpreter argument aTHX to Perl_$func");
2191 $file{changes} += $changes;
2192 }
2193 }
2194 else {
2195 warning("Uses Perl_$func instead of $func");
2196 $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*}
2197 {$func$1(}g);
2198 }
2199 }
2200
2201 for $func (sort keys %{$file{uses_replace}}) {
2202 warning("Uses $func instead of $replace{$func}");
2203 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2204 }
2205
2206 for $func (sort keys %{$file{uses}}) {
2207 next unless $file{uses}{$func}; # if it's only a dependency
2208 if (exists $file{uses_deps}{$func}) {
2209 diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}}));
2210 }
2211 elsif (exists $replace{$func}) {
2212 warning("Uses $func instead of $replace{$func}");
2213 $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g);
2214 }
2215 else {
2216 diag("Uses $func");
2217 }
2218 hint($func);
2219 }
2220
2221 for $func (sort keys %{$file{uses_todo}}) {
2222 warning("Uses $func, which may not be portable below perl ",
2223 format_version($API{$func}{todo}));
2224 }
2225
2226 for $func (sort keys %{$file{needed_static}}) {
2227 my $message = '';
2228 if (not exists $file{uses}{$func}) {
2229 $message = "No need to define NEED_$func if $func is never used";
2230 }
2231 elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') {
2232 $message = "No need to define NEED_$func when already needed globally";
2233 }
2234 if ($message) {
2235 diag($message);
2236 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg);
2237 }
2238 }
2239
2240 for $func (sort keys %{$file{needed_global}}) {
2241 my $message = '';
2242 if (not exists $global{uses}{$func}) {
2243 $message = "No need to define NEED_${func}_GLOBAL if $func is never used";
2244 }
2245 elsif (exists $file{needs}{$func}) {
2246 if ($file{needs}{$func} eq 'extern') {
2247 $message = "No need to define NEED_${func}_GLOBAL when already needed globally";
2248 }
2249 elsif ($file{needs}{$func} eq 'static') {
2250 $message = "No need to define NEED_${func}_GLOBAL when only used in this file";
2251 }
2252 }
2253 if ($message) {
2254 diag($message);
2255 $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg);
2256 }
2257 }
2258
2259 $file{needs_inc_ppport} = keys %{$file{uses}};
2260
2261 if ($file{needs_inc_ppport}) {
2262 my $pp = '';
2263
2264 for $func (sort keys %{$file{needs}}) {
2265 my $type = $file{needs}{$func};
2266 next if $type eq 'extern';
2267 my $suffix = $type eq 'global' ? '_GLOBAL' : '';
2268 unless (exists $file{"needed_$type"}{$func}) {
2269 if ($type eq 'global') {
2270 diag("Files [@{$global{needs}{$func}}] need $func, adding global request");
2271 }
2272 else {
2273 diag("File needs $func, adding static request");
2274 }
2275 $pp .= "#define NEED_$func$suffix\n";
2276 }
2277 }
2278
2279 if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) {
2280 $pp = '';
2281 $file{changes}++;
2282 }
2283
2284 unless ($file{has_inc_ppport}) {
2285 diag("Needs to include '$ppport'");
2286 $pp .= qq(#include "$ppport"\n)
2287 }
2288
2289 if ($pp) {
2290 $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms)
2291 || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m)
2292 || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m)
2293 || ($c =~ s/^/$pp/);
2294 }
2295 }
2296 else {
2297 if ($file{has_inc_ppport}) {
2298 diag("No need to include '$ppport'");
2299 $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m);
2300 }
2301 }
2302
2303 # put back in our C comments
2304 my $ix;
2305 my $cppc = 0;
2306 my @ccom = @{$file{ccom}};
2307 for $ix (0 .. $#ccom) {
2308 if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) {
2309 $cppc++;
2310 $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/;
2311 }
2312 else {
2313 $c =~ s/$rccs$ix$rcce/$ccom[$ix]/;
2314 }
2315 }
2316
2317 if ($cppc) {
2318 my $s = $cppc != 1 ? 's' : '';
2319 warning("Uses $cppc C++ style comment$s, which is not portable");
2320 }
2321
2322 if ($file{changes}) {
2323 if (exists $opt{copy}) {
2324 my $newfile = "$filename$opt{copy}";
2325 if (-e $newfile) {
2326 error("'$newfile' already exists, refusing to write copy of '$filename'");
2327 }
2328 else {
2329 local *F;
2330 if (open F, ">$newfile") {
2331 info("Writing copy of '$filename' with changes to '$newfile'");
2332 print F $c;
2333 close F;
2334 }
2335 else {
2336 error("Cannot open '$newfile' for writing: $!");
2337 }
2338 }
2339 }
2340 elsif (exists $opt{patch} || $opt{changes}) {
2341 if (exists $opt{patch}) {
2342 unless ($patch_opened) {
2343 if (open PATCH, ">$opt{patch}") {
2344 $patch_opened = 1;
2345 }
2346 else {
2347 error("Cannot open '$opt{patch}' for writing: $!");
2348 delete $opt{patch};
2349 $opt{changes} = 1;
2350 goto fallback;
2351 }
2352 }
2353 mydiff(\*PATCH, $filename, $c);
2354 }
2355 else {
2356 fallback:
2357 info("Suggested changes:");
2358 mydiff(\*STDOUT, $filename, $c);
2359 }
2360 }
2361 else {
2362 my $s = $file{changes} == 1 ? '' : 's';
2363 info("$file{changes} potentially required change$s detected");
2364 }
2365 }
2366 else {
2367 info("Looks good");
2368 }
2369 }
2370
2371 close PATCH if $patch_opened;
2372
2373 exit 0;
2374
2375
2376 sub mydiff
2377 {
2378 local *F = shift;
2379 my($file, $str) = @_;
2380 my $diff;
2381
2382 if (exists $opt{diff}) {
2383 $diff = run_diff($opt{diff}, $file, $str);
2384 }
2385
2386 if (!defined $diff and can_use('Text::Diff')) {
2387 $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' });
2388 $diff = <<HEADER . $diff;
2389 --- $file
2390 +++ $file.patched
2391 HEADER
2392 }
2393
2394 if (!defined $diff) {
2395 $diff = run_diff('diff -u', $file, $str);
2396 }
2397
2398 if (!defined $diff) {
2399 $diff = run_diff('diff', $file, $str);
2400 }
2401
2402 if (!defined $diff) {
2403 error("Cannot generate a diff. Please install Text::Diff or use --copy.");
2404 return;
2405 }
2406
2407 print F $diff;
2408
2409 }
2410
2411 sub run_diff
2412 {
2413 my($prog, $file, $str) = @_;
2414 my $tmp = 'dppptemp';
2415 my $suf = 'aaa';
2416 my $diff = '';
2417 local *F;
2418
2419 while (-e "$tmp.$suf") { $suf++ }
2420 $tmp = "$tmp.$suf";
2421
2422 if (open F, ">$tmp") {
2423 print F $str;
2424 close F;
2425
2426 if (open F, "$prog $file $tmp |") {
2427 while (<F>) {
2428 s/\Q$tmp\E/$file.patched/;
2429 $diff .= $_;
2430 }
2431 close F;
2432 unlink $tmp;
2433 return $diff;
2434 }
2435
2436 unlink $tmp;
2437 }
2438 else {
2439 error("Cannot open '$tmp' for writing: $!");
2440 }
2441
2442 return undef;
2443 }
2444
2445 sub can_use
2446 {
2447 eval "use @_;";
2448 return $@ eq '';
2449 }
2450
2451 sub rec_depend
2452 {
2453 my $func = shift;
2454 my %seen;
2455 return () unless exists $depends{$func};
2456 grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}};
2457 }
2458
2459 sub parse_version
2460 {
2461 my $ver = shift;
2462
2463 if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) {
2464 return ($1, $2, $3);
2465 }
2466 elsif ($ver !~ /^\d+\.[\d_]+$/) {
2467 die "cannot parse version '$ver'\n";
2468 }
2469
2470 $ver =~ s/_//g;
2471 $ver =~ s/$/000000/;
2472
2473 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
2474
2475 $v = int $v;
2476 $s = int $s;
2477
2478 if ($r < 5 || ($r == 5 && $v < 6)) {
2479 if ($s % 10) {
2480 die "cannot parse version '$ver'\n";
2481 }
2482 }
2483
2484 return ($r, $v, $s);
2485 }
2486
2487 sub format_version
2488 {
2489 my $ver = shift;
2490
2491 $ver =~ s/$/000000/;
2492 my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/;
2493
2494 $v = int $v;
2495 $s = int $s;
2496
2497 if ($r < 5 || ($r == 5 && $v < 6)) {
2498 if ($s % 10) {
2499 die "invalid version '$ver'\n";
2500 }
2501 $s /= 10;
2502
2503 $ver = sprintf "%d.%03d", $r, $v;
2504 $s > 0 and $ver .= sprintf "_%02d", $s;
2505
2506 return $ver;
2507 }
2508
2509 return sprintf "%d.%d.%d", $r, $v, $s;
2510 }
2511
2512 sub info
2513 {
2514 $opt{quiet} and return;
2515 print @_, "\n";
2516 }
2517
2518 sub diag
2519 {
2520 $opt{quiet} and return;
2521 $opt{diag} and print @_, "\n";
2522 }
2523
2524 sub warning
2525 {
2526 $opt{quiet} and return;
2527 print "*** ", @_, "\n";
2528 }
2529
2530 sub error
2531 {
2532 print "*** ERROR: ", @_, "\n";
2533 }
2534
2535 my %given_hints;
2536 sub hint
2537 {
2538 $opt{quiet} and return;
2539 $opt{hints} or return;
2540 my $func = shift;
2541 exists $hints{$func} or return;
2542 $given_hints{$func}++ and return;
2543 my $hint = $hints{$func};
2544 $hint =~ s/^/ /mg;
2545 print " --- hint for $func ---\n", $hint;
2546 }
2547
2548 sub usage
2549 {
2550 my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms;
2551 my %M = ( 'I' => '*' );
2552 $usage =~ s/^\s*perl\s+\S+/$^X $0/;
2553 $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g;
2554
2555 print <<ENDUSAGE;
2556
2557 Usage: $usage
2558
2559 See perldoc $0 for details.
2560
2561 ENDUSAGE
2562
2563 exit 2;
2564 }
2565
2566 __DATA__
2567 */
2568
2569 #ifndef _P_P_PORTABILITY_H_
2570 #define _P_P_PORTABILITY_H_
2571
2572 #ifndef DPPP_NAMESPACE
2573 # define DPPP_NAMESPACE DPPP_
2574 #endif
2575
2576 #define DPPP_CAT2(x,y) CAT2(x,y)
2577 #define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
2578
2579 #ifndef PERL_REVISION
2580 # if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
2581 # define PERL_PATCHLEVEL_H_IMPLICIT
2582 # include <patchlevel.h>
2583 # endif
2584 # if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL)))
2585 # include <could_not_find_Perl_patchlevel.h>
2586 # endif
2587 # ifndef PERL_REVISION
2588 # define PERL_REVISION (5)
2589 /* Replace: 1 */
2590 # define PERL_VERSION PATCHLEVEL
2591 # define PERL_SUBVERSION SUBVERSION
2592 /* Replace PERL_PATCHLEVEL with PERL_VERSION */
2593 /* Replace: 0 */
2594 # endif
2595 #endif
2596
2597 #define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION)
2598
2599 /* It is very unlikely that anyone will try to use this with Perl 6
2600 (or greater), but who knows.
2601 */
2602 #if PERL_REVISION != 5
2603 # error ppport.h only works with Perl version 5
2604 #endif /* PERL_REVISION != 5 */
2605
2606 #ifdef I_LIMITS
2607 # include <limits.h>
2608 #endif
2609
2610 #ifndef PERL_UCHAR_MIN
2611 # define PERL_UCHAR_MIN ((unsigned char)0)
2612 #endif
2613
2614 #ifndef PERL_UCHAR_MAX
2615 # ifdef UCHAR_MAX
2616 # define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX)
2617 # else
2618 # ifdef MAXUCHAR
2619 # define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR)
2620 # else
2621 # define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0)
2622 # endif
2623 # endif
2624 #endif
2625
2626 #ifndef PERL_USHORT_MIN
2627 # define PERL_USHORT_MIN ((unsigned short)0)
2628 #endif
2629
2630 #ifndef PERL_USHORT_MAX
2631 # ifdef USHORT_MAX
2632 # define PERL_USHORT_MAX ((unsigned short)USHORT_MAX)
2633 # else
2634 # ifdef MAXUSHORT
2635 # define PERL_USHORT_MAX ((unsigned short)MAXUSHORT)
2636 # else
2637 # ifdef USHRT_MAX
2638 # define PERL_USHORT_MAX ((unsigned short)USHRT_MAX)
2639 # else
2640 # define PERL_USHORT_MAX ((unsigned short)~(unsigned)0)
2641 # endif
2642 # endif
2643 # endif
2644 #endif
2645
2646 #ifndef PERL_SHORT_MAX
2647 # ifdef SHORT_MAX
2648 # define PERL_SHORT_MAX ((short)SHORT_MAX)
2649 # else
2650 # ifdef MAXSHORT /* Often used in <values.h> */
2651 # define PERL_SHORT_MAX ((short)MAXSHORT)
2652 # else
2653 # ifdef SHRT_MAX
2654 # define PERL_SHORT_MAX ((short)SHRT_MAX)
2655 # else
2656 # define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1))
2657 # endif
2658 # endif
2659 # endif
2660 #endif
2661
2662 #ifndef PERL_SHORT_MIN
2663 # ifdef SHORT_MIN
2664 # define PERL_SHORT_MIN ((short)SHORT_MIN)
2665 # else
2666 # ifdef MINSHORT
2667 # define PERL_SHORT_MIN ((short)MINSHORT)
2668 # else
2669 # ifdef SHRT_MIN
2670 # define PERL_SHORT_MIN ((short)SHRT_MIN)
2671 # else
2672 # define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3))
2673 # endif
2674 # endif
2675 # endif
2676 #endif
2677
2678 #ifndef PERL_UINT_MAX
2679 # ifdef UINT_MAX
2680 # define PERL_UINT_MAX ((unsigned int)UINT_MAX)
2681 # else
2682 # ifdef MAXUINT
2683 # define PERL_UINT_MAX ((unsigned int)MAXUINT)
2684 # else
2685 # define PERL_UINT_MAX (~(unsigned int)0)
2686 # endif
2687 # endif
2688 #endif
2689
2690 #ifndef PERL_UINT_MIN
2691 # define PERL_UINT_MIN ((unsigned int)0)
2692 #endif
2693
2694 #ifndef PERL_INT_MAX
2695 # ifdef INT_MAX
2696 # define PERL_INT_MAX ((int)INT_MAX)
2697 # else
2698 # ifdef MAXINT /* Often used in <values.h> */
2699 # define PERL_INT_MAX ((int)MAXINT)
2700 # else
2701 # define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1))
2702 # endif
2703 # endif
2704 #endif
2705
2706 #ifndef PERL_INT_MIN
2707 # ifdef INT_MIN
2708 # define PERL_INT_MIN ((int)INT_MIN)
2709 # else
2710 # ifdef MININT
2711 # define PERL_INT_MIN ((int)MININT)
2712 # else
2713 # define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3))
2714 # endif
2715 # endif
2716 #endif
2717
2718 #ifndef PERL_ULONG_MAX
2719 # ifdef ULONG_MAX
2720 # define PERL_ULONG_MAX ((unsigned long)ULONG_MAX)
2721 # else
2722 # ifdef MAXULONG
2723 # define PERL_ULONG_MAX ((unsigned long)MAXULONG)
2724 # else
2725 # define PERL_ULONG_MAX (~(unsigned long)0)
2726 # endif
2727 # endif
2728 #endif
2729
2730 #ifndef PERL_ULONG_MIN
2731 # define PERL_ULONG_MIN ((unsigned long)0L)
2732 #endif
2733
2734 #ifndef PERL_LONG_MAX
2735 # ifdef LONG_MAX
2736 # define PERL_LONG_MAX ((long)LONG_MAX)
2737 # else
2738 # ifdef MAXLONG
2739 # define PERL_LONG_MAX ((long)MAXLONG)
2740 # else
2741 # define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1))
2742 # endif
2743 # endif
2744 #endif
2745
2746 #ifndef PERL_LONG_MIN
2747 # ifdef LONG_MIN
2748 # define PERL_LONG_MIN ((long)LONG_MIN)
2749 # else
2750 # ifdef MINLONG
2751 # define PERL_LONG_MIN ((long)MINLONG)
2752 # else
2753 # define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3))
2754 # endif
2755 # endif
2756 #endif
2757
2758 #if defined(HAS_QUAD) && (defined(convex) || defined(uts))
2759 # ifndef PERL_UQUAD_MAX
2760 # ifdef ULONGLONG_MAX
2761 # define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX)
2762 # else
2763 # ifdef MAXULONGLONG
2764 # define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG)
2765 # else
2766 # define PERL_UQUAD_MAX (~(unsigned long long)0)
2767 # endif
2768 # endif
2769 # endif
2770
2771 # ifndef PERL_UQUAD_MIN
2772 # define PERL_UQUAD_MIN ((unsigned long long)0L)
2773 # endif
2774
2775 # ifndef PERL_QUAD_MAX
2776 # ifdef LONGLONG_MAX
2777 # define PERL_QUAD_MAX ((long long)LONGLONG_MAX)
2778 # else
2779 # ifdef MAXLONGLONG
2780 # define PERL_QUAD_MAX ((long long)MAXLONGLONG)
2781 # else
2782 # define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1))
2783 # endif
2784 # endif
2785 # endif
2786
2787 # ifndef PERL_QUAD_MIN
2788 # ifdef LONGLONG_MIN
2789 # define PERL_QUAD_MIN ((long long)LONGLONG_MIN)
2790 # else
2791 # ifdef MINLONGLONG
2792 # define PERL_QUAD_MIN ((long long)MINLONGLONG)
2793 # else
2794 # define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3))
2795 # endif
2796 # endif
2797 # endif
2798 #endif
2799
2800 /* This is based on code from 5.003 perl.h */
2801 #ifdef HAS_QUAD
2802 # ifdef cray
2803 #ifndef IVTYPE
2804 # define IVTYPE int
2805 #endif
2806
2807 #ifndef IV_MIN
2808 # define IV_MIN PERL_INT_MIN
2809 #endif
2810
2811 #ifndef IV_MAX
2812 # define IV_MAX PERL_INT_MAX
2813 #endif
2814
2815 #ifndef UV_MIN
2816 # define UV_MIN PERL_UINT_MIN
2817 #endif
2818
2819 #ifndef UV_MAX
2820 # define UV_MAX PERL_UINT_MAX
2821 #endif
2822
2823 # ifdef INTSIZE
2824 #ifndef IVSIZE
2825 # define IVSIZE INTSIZE
2826 #endif
2827
2828 # endif
2829 # else
2830 # if defined(convex) || defined(uts)
2831 #ifndef IVTYPE
2832 # define IVTYPE long long
2833 #endif
2834
2835 #ifndef IV_MIN
2836 # define IV_MIN PERL_QUAD_MIN
2837 #endif
2838
2839 #ifndef IV_MAX
2840 # define IV_MAX PERL_QUAD_MAX
2841 #endif
2842
2843 #ifndef UV_MIN
2844 # define UV_MIN PERL_UQUAD_MIN
2845 #endif
2846
2847 #ifndef UV_MAX
2848 # define UV_MAX PERL_UQUAD_MAX
2849 #endif
2850
2851 # ifdef LONGLONGSIZE
2852 #ifndef IVSIZE
2853 # define IVSIZE LONGLONGSIZE
2854 #endif
2855
2856 # endif
2857 # else
2858 #ifndef IVTYPE
2859 # define IVTYPE long
2860 #endif
2861
2862 #ifndef IV_MIN
2863 # define IV_MIN PERL_LONG_MIN
2864 #endif
2865
2866 #ifndef IV_MAX
2867 # define IV_MAX PERL_LONG_MAX
2868 #endif
2869
2870 #ifndef UV_MIN
2871 # define UV_MIN PERL_ULONG_MIN
2872 #endif
2873
2874 #ifndef UV_MAX
2875 # define UV_MAX PERL_ULONG_MAX
2876 #endif
2877
2878 # ifdef LONGSIZE
2879 #ifndef IVSIZE
2880 # define IVSIZE LONGSIZE
2881 #endif
2882
2883 # endif
2884 # endif
2885 # endif
2886 #ifndef IVSIZE
2887 # define IVSIZE 8
2888 #endif
2889
2890 #ifndef PERL_QUAD_MIN
2891 # define PERL_QUAD_MIN IV_MIN
2892 #endif
2893
2894 #ifndef PERL_QUAD_MAX
2895 # define PERL_QUAD_MAX IV_MAX
2896 #endif
2897
2898 #ifndef PERL_UQUAD_MIN
2899 # define PERL_UQUAD_MIN UV_MIN
2900 #endif
2901
2902 #ifndef PERL_UQUAD_MAX
2903 # define PERL_UQUAD_MAX UV_MAX
2904 #endif
2905
2906 #else
2907 #ifndef IVTYPE
2908 # define IVTYPE long
2909 #endif
2910
2911 #ifndef IV_MIN
2912 # define IV_MIN PERL_LONG_MIN
2913 #endif
2914
2915 #ifndef IV_MAX
2916 # define IV_MAX PERL_LONG_MAX
2917 #endif
2918
2919 #ifndef UV_MIN
2920 # define UV_MIN PERL_ULONG_MIN
2921 #endif
2922
2923 #ifndef UV_MAX
2924 # define UV_MAX PERL_ULONG_MAX
2925 #endif
2926
2927 #endif
2928
2929 #ifndef IVSIZE
2930 # ifdef LONGSIZE
2931 # define IVSIZE LONGSIZE
2932 # else
2933 # define IVSIZE 4 /* A bold guess, but the best we can make. */
2934 # endif
2935 #endif
2936 #ifndef UVTYPE
2937 # define UVTYPE unsigned IVTYPE
2938 #endif
2939
2940 #ifndef UVSIZE
2941 # define UVSIZE IVSIZE
2942 #endif
2943
2944 #ifndef sv_setuv
2945 # define sv_setuv(sv, uv) \
2946 STMT_START { \
2947 UV TeMpUv = uv; \
2948 if (TeMpUv <= IV_MAX) \
2949 sv_setiv(sv, TeMpUv); \
2950 else \
2951 sv_setnv(sv, (double)TeMpUv); \
2952 } STMT_END
2953 #endif
2954
2955 #ifndef newSVuv
2956 # define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
2957 #endif
2958 #ifndef sv_2uv
2959 # define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
2960 #endif
2961
2962 #ifndef SvUVX
2963 # define SvUVX(sv) ((UV)SvIVX(sv))
2964 #endif
2965
2966 #ifndef SvUVXx
2967 # define SvUVXx(sv) SvUVX(sv)
2968 #endif
2969
2970 #ifndef SvUV
2971 # define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
2972 #endif
2973
2974 #ifndef SvUVx
2975 # define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
2976 #endif
2977
2978 /* Hint: sv_uv
2979 * Always use the SvUVx() macro instead of sv_uv().
2980 */
2981 #ifndef sv_uv
2982 # define sv_uv(sv) SvUVx(sv)
2983 #endif
2984 #ifndef XST_mUV
2985 # define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) )
2986 #endif
2987
2988 #ifndef XSRETURN_UV
2989 # define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
2990 #endif
2991 #ifndef PUSHu
2992 # define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
2993 #endif
2994
2995 #ifndef XPUSHu
2996 # define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
2997 #endif
2998
2999 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
3000 /* Replace: 1 */
3001 # define PL_DBsingle DBsingle
3002 # define PL_DBsub DBsub
3003 # define PL_Sv Sv
3004 # define PL_compiling compiling
3005 # define PL_copline copline
3006 # define PL_curcop curcop
3007 # define PL_curstash curstash
3008 # define PL_debstash debstash
3009 # define PL_defgv defgv
3010 # define PL_diehook diehook
3011 # define PL_dirty dirty
3012 # define PL_dowarn dowarn
3013 # define PL_errgv errgv
3014 # define PL_hexdigit hexdigit
3015 # define PL_hints hints
3016 # define PL_na na
3017 # define PL_no_modify no_modify
3018 # define PL_perl_destruct_level perl_destruct_level
3019 # define PL_perldb perldb
3020 # define PL_ppaddr ppaddr
3021 # define PL_rsfp_filters rsfp_filters
3022 # define PL_rsfp rsfp
3023 # define PL_stack_base stack_base
3024 # define PL_stack_sp stack_sp
3025 # define PL_stdingv stdingv
3026 # define PL_sv_arenaroot sv_arenaroot
3027 # define PL_sv_no sv_no
3028 # define PL_sv_undef sv_undef
3029 # define PL_sv_yes sv_yes
3030 # define PL_tainted tainted
3031 # define PL_tainting tainting
3032 /* Replace: 0 */
3033 #endif
3034
3035 #ifndef PERL_UNUSED_DECL
3036 # ifdef HASATTRIBUTE
3037 # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
3038 # define PERL_UNUSED_DECL
3039 # else
3040 # define PERL_UNUSED_DECL __attribute__((unused))
3041 # endif
3042 # else
3043 # define PERL_UNUSED_DECL
3044 # endif
3045 #endif
3046 #ifndef NOOP
3047 # define NOOP (void)0
3048 #endif
3049
3050 #ifndef dNOOP
3051 # define dNOOP extern int Perl___notused PERL_UNUSED_DECL
3052 #endif
3053
3054 #ifndef NVTYPE
3055 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
3056 # define NVTYPE long double
3057 # else
3058 # define NVTYPE double
3059 # endif
3060 typedef NVTYPE NV;
3061 #endif
3062
3063 #ifndef INT2PTR
3064
3065 # if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
3066 # define PTRV UV
3067 # define INT2PTR(any,d) (any)(d)
3068 # else
3069 # if PTRSIZE == LONGSIZE
3070 # define PTRV unsigned long
3071 # else
3072 # define PTRV unsigned
3073 # endif
3074 # define INT2PTR(any,d) (any)(PTRV)(d)
3075 # endif
3076
3077 # define NUM2PTR(any,d) (any)(PTRV)(d)
3078 # define PTR2IV(p) INT2PTR(IV,p)
3079 # define PTR2UV(p) INT2PTR(UV,p)
3080 # define PTR2NV(p) NUM2PTR(NV,p)
3081
3082 # if PTRSIZE == LONGSIZE
3083 # define PTR2ul(p) (unsigned long)(p)
3084 # else
3085 # define PTR2ul(p) INT2PTR(unsigned long,p)
3086 # endif
3087
3088 #endif /* !INT2PTR */
3089
3090 #undef START_EXTERN_C
3091 #undef END_EXTERN_C
3092 #undef EXTERN_C
3093 #ifdef __cplusplus
3094 # define START_EXTERN_C extern "C" {
3095 # define END_EXTERN_C }
3096 # define EXTERN_C extern "C"
3097 #else
3098 # define START_EXTERN_C
3099 # define END_EXTERN_C
3100 # define EXTERN_C extern
3101 #endif
3102
3103 #ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
3104 # if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
3105 # define PERL_GCC_BRACE_GROUPS_FORBIDDEN
3106 # endif
3107 #endif
3108
3109 #undef STMT_START
3110 #undef STMT_END
3111 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
3112 # define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
3113 # define STMT_END )
3114 #else
3115 # if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
3116 # define STMT_START if (1)
3117 # define STMT_END else (void)0
3118 # else
3119 # define STMT_START do
3120 # define STMT_END while (0)
3121 # endif
3122 #endif
3123 #ifndef boolSV
3124 # define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
3125 #endif
3126
3127 /* DEFSV appears first in 5.004_56 */
3128 #ifndef DEFSV
3129 # define DEFSV GvSV(PL_defgv)
3130 #endif
3131
3132 #ifndef SAVE_DEFSV
3133 # define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
3134 #endif
3135
3136 /* Older perls (<=5.003) lack AvFILLp */
3137 #ifndef AvFILLp
3138 # define AvFILLp AvFILL
3139 #endif
3140 #ifndef ERRSV
3141 # define ERRSV get_sv("@",FALSE)
3142 #endif
3143 #ifndef newSVpvn
3144 # define newSVpvn(data,len) ((data) \
3145 ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
3146 : newSV(0))
3147 #endif
3148
3149 /* Hint: gv_stashpvn
3150 * This function's backport doesn't support the length parameter, but
3151 * rather ignores it. Portability can only be ensured if the length
3152 * parameter is used for speed reasons, but the length can always be
3153 * correctly computed from the string argument.
3154 */
3155 #ifndef gv_stashpvn
3156 # define gv_stashpvn(str,len,create) gv_stashpv(str,create)
3157 #endif
3158
3159 /* Replace: 1 */
3160 #ifndef get_cv
3161 # define get_cv perl_get_cv
3162 #endif
3163
3164 #ifndef get_sv
3165 # define get_sv perl_get_sv
3166 #endif
3167
3168 #ifndef get_av
3169 # define get_av perl_get_av
3170 #endif
3171
3172 #ifndef get_hv
3173 # define get_hv perl_get_hv
3174 #endif
3175
3176 /* Replace: 0 */
3177
3178 #ifdef HAS_MEMCMP
3179 #ifndef memNE
3180 # define memNE(s1,s2,l) (memcmp(s1,s2,l))
3181 #endif
3182
3183 #ifndef memEQ
3184 # define memEQ(s1,s2,l) (!memcmp(s1,s2,l))
3185 #endif
3186
3187 #else
3188 #ifndef memNE
3189 # define memNE(s1,s2,l) (bcmp(s1,s2,l))
3190 #endif
3191
3192 #ifndef memEQ
3193 # define memEQ(s1,s2,l) (!bcmp(s1,s2,l))
3194 #endif
3195
3196 #endif
3197 #ifndef MoveD
3198 # define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t))
3199 #endif
3200
3201 #ifndef CopyD
3202 # define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t))
3203 #endif
3204
3205 #ifdef HAS_MEMSET
3206 #ifndef ZeroD
3207 # define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t))
3208 #endif
3209
3210 #else
3211 #ifndef ZeroD
3212 # define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)),d)
3213 #endif
3214
3215 #endif
3216 #ifndef Poison
3217 # define Poison(d,n,t) (void)memset((char*)(d), 0xAB, (n) * sizeof(t))
3218 #endif
3219 #ifndef dUNDERBAR
3220 # define dUNDERBAR dNOOP
3221 #endif
3222
3223 #ifndef UNDERBAR
3224 # define UNDERBAR DEFSV
3225 #endif
3226 #ifndef dAX
3227 # define dAX I32 ax = MARK - PL_stack_base + 1
3228 #endif
3229
3230 #ifndef dITEMS
3231 # define dITEMS I32 items = SP - MARK
3232 #endif
3233 #ifndef dXSTARG
3234 # define dXSTARG SV * targ = sv_newmortal()
3235 #endif
3236 #ifndef dTHR
3237 # define dTHR dNOOP
3238 #endif
3239 #ifndef dTHX
3240 # define dTHX dNOOP
3241 #endif
3242
3243 #ifndef dTHXa
3244 # define dTHXa(x) dNOOP
3245 #endif
3246 #ifndef pTHX
3247 # define pTHX void
3248 #endif
3249
3250 #ifndef pTHX_
3251 # define pTHX_
3252 #endif
3253
3254 #ifndef aTHX
3255 # define aTHX
3256 #endif
3257
3258 #ifndef aTHX_
3259 # define aTHX_
3260 #endif
3261 #ifndef dTHXoa
3262 # define dTHXoa(x) dTHXa(x)
3263 #endif
3264 #ifndef PUSHmortal
3265 # define PUSHmortal PUSHs(sv_newmortal())
3266 #endif
3267
3268 #ifndef mPUSHp
3269 # define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l))
3270 #endif
3271
3272 #ifndef mPUSHn
3273 # define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n))
3274 #endif
3275
3276 #ifndef mPUSHi
3277 # define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i))
3278 #endif
3279
3280 #ifndef mPUSHu
3281 # define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u))
3282 #endif
3283 #ifndef XPUSHmortal
3284 # define XPUSHmortal XPUSHs(sv_newmortal())
3285 #endif
3286
3287 #ifndef mXPUSHp
3288 # define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END
3289 #endif
3290
3291 #ifndef mXPUSHn
3292 # define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END
3293 #endif
3294
3295 #ifndef mXPUSHi
3296 # define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END
3297 #endif
3298
3299 #ifndef mXPUSHu
3300 # define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END
3301 #endif
3302
3303 /* Replace: 1 */
3304 #ifndef call_sv
3305 # define call_sv perl_call_sv
3306 #endif
3307
3308 #ifndef call_pv
3309 # define call_pv perl_call_pv
3310 #endif
3311
3312 #ifndef call_argv
3313 # define call_argv perl_call_argv
3314 #endif
3315
3316 #ifndef call_method
3317 # define call_method perl_call_method
3318 #endif
3319 #ifndef eval_sv
3320 # define eval_sv perl_eval_sv
3321 #endif
3322
3323 /* Replace: 0 */
3324
3325 /* Replace perl_eval_pv with eval_pv */
3326 /* eval_pv depends on eval_sv */
3327
3328 #ifndef eval_pv
3329 #if defined(NEED_eval_pv)
3330 static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
3331 static
3332 #else
3333 extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
3334 #endif
3335
3336 #ifdef eval_pv
3337 # undef eval_pv
3338 #endif
3339 #define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
3340 #define Perl_eval_pv DPPP_(my_eval_pv)
3341
3342 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
3343
3344 SV*
DPPP_(my_eval_pv)3345 DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
3346 {
3347 dSP;
3348 SV* sv = newSVpv(p, 0);
3349
3350 PUSHMARK(sp);
3351 eval_sv(sv, G_SCALAR);
3352 SvREFCNT_dec(sv);
3353
3354 SPAGAIN;
3355 sv = POPs;
3356 PUTBACK;
3357
3358 if (croak_on_error && SvTRUE(GvSV(errgv)))
3359 croak(SvPVx(GvSV(errgv), na));
3360
3361 return sv;
3362 }
3363
3364 #endif
3365 #endif
3366 #ifndef newRV_inc
3367 # define newRV_inc(sv) newRV(sv) /* Replace */
3368 #endif
3369
3370 #ifndef newRV_noinc
3371 #if defined(NEED_newRV_noinc)
3372 static SV * DPPP_(my_newRV_noinc)(SV *sv);
3373 static
3374 #else
3375 extern SV * DPPP_(my_newRV_noinc)(SV *sv);
3376 #endif
3377
3378 #ifdef newRV_noinc
3379 # undef newRV_noinc
3380 #endif
3381 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
3382 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
3383
3384 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
3385 SV *
DPPP_(my_newRV_noinc)3386 DPPP_(my_newRV_noinc)(SV *sv)
3387 {
3388 SV *rv = (SV *)newRV(sv);
3389 SvREFCNT_dec(sv);
3390 return rv;
3391 }
3392 #endif
3393 #endif
3394
3395 /* Hint: newCONSTSUB
3396 * Returns a CV* as of perl-5.7.1. This return value is not supported
3397 * by Devel::PPPort.
3398 */
3399
3400 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
3401 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
3402 #if defined(NEED_newCONSTSUB)
3403 static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
3404 static
3405 #else
3406 extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
3407 #endif
3408
3409 #ifdef newCONSTSUB
3410 # undef newCONSTSUB
3411 #endif
3412 #define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
3413 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
3414
3415 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
3416
3417 void
DPPP_(my_newCONSTSUB)3418 DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
3419 {
3420 U32 oldhints = PL_hints;
3421 HV *old_cop_stash = PL_curcop->cop_stash;
3422 HV *old_curstash = PL_curstash;
3423 line_t oldline = PL_curcop->cop_line;
3424 PL_curcop->cop_line = PL_copline;
3425
3426 PL_hints &= ~HINT_BLOCK_SCOPE;
3427 if (stash)
3428 PL_curstash = PL_curcop->cop_stash = stash;
3429
3430 newSUB(
3431
3432 #if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)))
3433 start_subparse(),
3434 #elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22))
3435 start_subparse(0),
3436 #else /* 5.003_23 onwards */
3437 start_subparse(FALSE, 0),
3438 #endif
3439
3440 newSVOP(OP_CONST, 0, newSVpv(name,0)),
3441 newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
3442 newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
3443 );
3444
3445 PL_hints = oldhints;
3446 PL_curcop->cop_stash = old_cop_stash;
3447 PL_curstash = old_curstash;
3448 PL_curcop->cop_line = oldline;
3449 }
3450 #endif
3451 #endif
3452
3453 /*
3454 * Boilerplate macros for initializing and accessing interpreter-local
3455 * data from C. All statics in extensions should be reworked to use
3456 * this, if you want to make the extension thread-safe. See ext/re/re.xs
3457 * for an example of the use of these macros.
3458 *
3459 * Code that uses these macros is responsible for the following:
3460 * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
3461 * 2. Declare a typedef named my_cxt_t that is a structure that contains
3462 * all the data that needs to be interpreter-local.
3463 * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
3464 * 4. Use the MY_CXT_INIT macro such that it is called exactly once
3465 * (typically put in the BOOT: section).
3466 * 5. Use the members of the my_cxt_t structure everywhere as
3467 * MY_CXT.member.
3468 * 6. Use the dMY_CXT macro (a declaration) in all the functions that
3469 * access MY_CXT.
3470 */
3471
3472 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
3473 defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
3474
3475 #ifndef START_MY_CXT
3476
3477 /* This must appear in all extensions that define a my_cxt_t structure,
3478 * right after the definition (i.e. at file scope). The non-threads
3479 * case below uses it to declare the data as static. */
3480 #define START_MY_CXT
3481
3482 #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68 ))
3483 /* Fetches the SV that keeps the per-interpreter data. */
3484 #define dMY_CXT_SV \
3485 SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
3486 #else /* >= perl5.004_68 */
3487 #define dMY_CXT_SV \
3488 SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
3489 sizeof(MY_CXT_KEY)-1, TRUE)
3490 #endif /* < perl5.004_68 */
3491
3492 /* This declaration should be used within all functions that use the
3493 * interpreter-local data. */
3494 #define dMY_CXT \
3495 dMY_CXT_SV; \
3496 my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
3497
3498 /* Creates and zeroes the per-interpreter data.
3499 * (We allocate my_cxtp in a Perl SV so that it will be released when
3500 * the interpreter goes away.) */
3501 #define MY_CXT_INIT \
3502 dMY_CXT_SV; \
3503 /* newSV() allocates one more than needed */ \
3504 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
3505 Zero(my_cxtp, 1, my_cxt_t); \
3506 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
3507
3508 /* This macro must be used to access members of the my_cxt_t structure.
3509 * e.g. MYCXT.some_data */
3510 #define MY_CXT (*my_cxtp)
3511
3512 /* Judicious use of these macros can reduce the number of times dMY_CXT
3513 * is used. Use is similar to pTHX, aTHX etc. */
3514 #define pMY_CXT my_cxt_t *my_cxtp
3515 #define pMY_CXT_ pMY_CXT,
3516 #define _pMY_CXT ,pMY_CXT
3517 #define aMY_CXT my_cxtp
3518 #define aMY_CXT_ aMY_CXT,
3519 #define _aMY_CXT ,aMY_CXT
3520
3521 #endif /* START_MY_CXT */
3522
3523 #ifndef MY_CXT_CLONE
3524 /* Clones the per-interpreter data. */
3525 #define MY_CXT_CLONE \
3526 dMY_CXT_SV; \
3527 my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
3528 Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
3529 sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
3530 #endif
3531
3532 #else /* single interpreter */
3533
3534 #ifndef START_MY_CXT
3535
3536 #define START_MY_CXT static my_cxt_t my_cxt;
3537 #define dMY_CXT_SV dNOOP
3538 #define dMY_CXT dNOOP
3539 #define MY_CXT_INIT NOOP
3540 #define MY_CXT my_cxt
3541
3542 #define pMY_CXT void
3543 #define pMY_CXT_
3544 #define _pMY_CXT
3545 #define aMY_CXT
3546 #define aMY_CXT_
3547 #define _aMY_CXT
3548
3549 #endif /* START_MY_CXT */
3550
3551 #ifndef MY_CXT_CLONE
3552 #define MY_CXT_CLONE NOOP
3553 #endif
3554
3555 #endif
3556
3557 #ifndef IVdf
3558 # if IVSIZE == LONGSIZE
3559 # define IVdf "ld"
3560 # define UVuf "lu"
3561 # define UVof "lo"
3562 # define UVxf "lx"
3563 # define UVXf "lX"
3564 # else
3565 # if IVSIZE == INTSIZE
3566 # define IVdf "d"
3567 # define UVuf "u"
3568 # define UVof "o"
3569 # define UVxf "x"
3570 # define UVXf "X"
3571 # endif
3572 # endif
3573 #endif
3574
3575 #ifndef NVef
3576 # if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
3577 defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
3578 # define NVef PERL_PRIeldbl
3579 # define NVff PERL_PRIfldbl
3580 # define NVgf PERL_PRIgldbl
3581 # else
3582 # define NVef "e"
3583 # define NVff "f"
3584 # define NVgf "g"
3585 # endif
3586 #endif
3587
3588 #ifndef SvPV_nolen
3589
3590 #if defined(NEED_sv_2pv_nolen)
3591 static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
3592 static
3593 #else
3594 extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
3595 #endif
3596
3597 #ifdef sv_2pv_nolen
3598 # undef sv_2pv_nolen
3599 #endif
3600 #define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a)
3601 #define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
3602
3603 #if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
3604
3605 char *
DPPP_(my_sv_2pv_nolen)3606 DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv)
3607 {
3608 STRLEN n_a;
3609 return sv_2pv(sv, &n_a);
3610 }
3611
3612 #endif
3613
3614 /* Hint: sv_2pv_nolen
3615 * Use the SvPV_nolen() macro instead of sv_2pv_nolen().
3616 */
3617
3618 /* SvPV_nolen depends on sv_2pv_nolen */
3619 #define SvPV_nolen(sv) \
3620 ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
3621 ? SvPVX(sv) : sv_2pv_nolen(sv))
3622
3623 #endif
3624
3625 #ifdef SvPVbyte
3626
3627 /* Hint: SvPVbyte
3628 * Does not work in perl-5.6.1, ppport.h implements a version
3629 * borrowed from perl-5.7.3.
3630 */
3631
3632 #if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
3633
3634 #if defined(NEED_sv_2pvbyte)
3635 static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
3636 static
3637 #else
3638 extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
3639 #endif
3640
3641 #ifdef sv_2pvbyte
3642 # undef sv_2pvbyte
3643 #endif
3644 #define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
3645 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
3646
3647 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
3648
3649 char *
DPPP_(my_sv_2pvbyte)3650 DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
3651 {
3652 sv_utf8_downgrade(sv,0);
3653 return SvPV(sv,*lp);
3654 }
3655
3656 #endif
3657
3658 /* Hint: sv_2pvbyte
3659 * Use the SvPVbyte() macro instead of sv_2pvbyte().
3660 */
3661
3662 #undef SvPVbyte
3663
3664 /* SvPVbyte depends on sv_2pvbyte */
3665 #define SvPVbyte(sv, lp) \
3666 ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
3667 ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
3668
3669 #endif
3670
3671 #else
3672
3673 # define SvPVbyte SvPV
3674 # define sv_2pvbyte sv_2pv
3675
3676 #endif
3677
3678 /* sv_2pvbyte_nolen depends on sv_2pv_nolen */
3679 #ifndef sv_2pvbyte_nolen
3680 # define sv_2pvbyte_nolen sv_2pv_nolen
3681 #endif
3682
3683 /* Hint: sv_pvn
3684 * Always use the SvPV() macro instead of sv_pvn().
3685 */
3686 #ifndef sv_pvn
3687 # define sv_pvn(sv, len) SvPV(sv, len)
3688 #endif
3689
3690 /* Hint: sv_pvn_force
3691 * Always use the SvPV_force() macro instead of sv_pvn_force().
3692 */
3693 #ifndef sv_pvn_force
3694 # define sv_pvn_force(sv, len) SvPV_force(sv, len)
3695 #endif
3696
3697 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf)
3698 #if defined(NEED_vnewSVpvf)
3699 static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
3700 static
3701 #else
3702 extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
3703 #endif
3704
3705 #ifdef vnewSVpvf
3706 # undef vnewSVpvf
3707 #endif
3708 #define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
3709 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
3710
3711 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
3712
3713 SV *
DPPP_(my_vnewSVpvf)3714 DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
3715 {
3716 register SV *sv = newSV(0);
3717 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
3718 return sv;
3719 }
3720
3721 #endif
3722 #endif
3723
3724 /* sv_vcatpvf depends on sv_vcatpvfn */
3725 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf)
3726 # define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
3727 #endif
3728
3729 /* sv_vsetpvf depends on sv_vsetpvfn */
3730 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf)
3731 # define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
3732 #endif
3733
3734 /* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
3735 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg)
3736 #if defined(NEED_sv_catpvf_mg)
3737 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3738 static
3739 #else
3740 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3741 #endif
3742
3743 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
3744
3745 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
3746
3747 void
DPPP_(my_sv_catpvf_mg)3748 DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
3749 {
3750 va_list args;
3751 va_start(args, pat);
3752 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3753 SvSETMAGIC(sv);
3754 va_end(args);
3755 }
3756
3757 #endif
3758 #endif
3759
3760 /* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
3761 #ifdef PERL_IMPLICIT_CONTEXT
3762 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext)
3763 #if defined(NEED_sv_catpvf_mg_nocontext)
3764 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3765 static
3766 #else
3767 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3768 #endif
3769
3770 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
3771 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
3772
3773 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
3774
3775 void
DPPP_(my_sv_catpvf_mg_nocontext)3776 DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
3777 {
3778 dTHX;
3779 va_list args;
3780 va_start(args, pat);
3781 sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3782 SvSETMAGIC(sv);
3783 va_end(args);
3784 }
3785
3786 #endif
3787 #endif
3788 #endif
3789
3790 #ifndef sv_catpvf_mg
3791 # ifdef PERL_IMPLICIT_CONTEXT
3792 # define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
3793 # else
3794 # define sv_catpvf_mg Perl_sv_catpvf_mg
3795 # endif
3796 #endif
3797
3798 /* sv_vcatpvf_mg depends on sv_vcatpvfn */
3799 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg)
3800 # define sv_vcatpvf_mg(sv, pat, args) \
3801 STMT_START { \
3802 sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
3803 SvSETMAGIC(sv); \
3804 } STMT_END
3805 #endif
3806
3807 /* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
3808 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg)
3809 #if defined(NEED_sv_setpvf_mg)
3810 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3811 static
3812 #else
3813 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
3814 #endif
3815
3816 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
3817
3818 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
3819
3820 void
DPPP_(my_sv_setpvf_mg)3821 DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
3822 {
3823 va_list args;
3824 va_start(args, pat);
3825 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3826 SvSETMAGIC(sv);
3827 va_end(args);
3828 }
3829
3830 #endif
3831 #endif
3832
3833 /* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
3834 #ifdef PERL_IMPLICIT_CONTEXT
3835 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext)
3836 #if defined(NEED_sv_setpvf_mg_nocontext)
3837 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3838 static
3839 #else
3840 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
3841 #endif
3842
3843 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
3844 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
3845
3846 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
3847
3848 void
DPPP_(my_sv_setpvf_mg_nocontext)3849 DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
3850 {
3851 dTHX;
3852 va_list args;
3853 va_start(args, pat);
3854 sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
3855 SvSETMAGIC(sv);
3856 va_end(args);
3857 }
3858
3859 #endif
3860 #endif
3861 #endif
3862
3863 #ifndef sv_setpvf_mg
3864 # ifdef PERL_IMPLICIT_CONTEXT
3865 # define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
3866 # else
3867 # define sv_setpvf_mg Perl_sv_setpvf_mg
3868 # endif
3869 #endif
3870
3871 /* sv_vsetpvf_mg depends on sv_vsetpvfn */
3872 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg)
3873 # define sv_vsetpvf_mg(sv, pat, args) \
3874 STMT_START { \
3875 sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
3876 SvSETMAGIC(sv); \
3877 } STMT_END
3878 #endif
3879 #ifndef SvGETMAGIC
3880 # define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
3881 #endif
3882 #ifndef PERL_MAGIC_sv
3883 # define PERL_MAGIC_sv '\0'
3884 #endif
3885
3886 #ifndef PERL_MAGIC_overload
3887 # define PERL_MAGIC_overload 'A'
3888 #endif
3889
3890 #ifndef PERL_MAGIC_overload_elem
3891 # define PERL_MAGIC_overload_elem 'a'
3892 #endif
3893
3894 #ifndef PERL_MAGIC_overload_table
3895 # define PERL_MAGIC_overload_table 'c'
3896 #endif
3897
3898 #ifndef PERL_MAGIC_bm
3899 # define PERL_MAGIC_bm 'B'
3900 #endif
3901
3902 #ifndef PERL_MAGIC_regdata
3903 # define PERL_MAGIC_regdata 'D'
3904 #endif
3905
3906 #ifndef PERL_MAGIC_regdatum
3907 # define PERL_MAGIC_regdatum 'd'
3908 #endif
3909
3910 #ifndef PERL_MAGIC_env
3911 # define PERL_MAGIC_env 'E'
3912 #endif
3913
3914 #ifndef PERL_MAGIC_envelem
3915 # define PERL_MAGIC_envelem 'e'
3916 #endif
3917
3918 #ifndef PERL_MAGIC_fm
3919 # define PERL_MAGIC_fm 'f'
3920 #endif
3921
3922 #ifndef PERL_MAGIC_regex_global
3923 # define PERL_MAGIC_regex_global 'g'
3924 #endif
3925
3926 #ifndef PERL_MAGIC_isa
3927 # define PERL_MAGIC_isa 'I'
3928 #endif
3929
3930 #ifndef PERL_MAGIC_isaelem
3931 # define PERL_MAGIC_isaelem 'i'
3932 #endif
3933
3934 #ifndef PERL_MAGIC_nkeys
3935 # define PERL_MAGIC_nkeys 'k'
3936 #endif
3937
3938 #ifndef PERL_MAGIC_dbfile
3939 # define PERL_MAGIC_dbfile 'L'
3940 #endif
3941
3942 #ifndef PERL_MAGIC_dbline
3943 # define PERL_MAGIC_dbline 'l'
3944 #endif
3945
3946 #ifndef PERL_MAGIC_mutex
3947 # define PERL_MAGIC_mutex 'm'
3948 #endif
3949
3950 #ifndef PERL_MAGIC_shared
3951 # define PERL_MAGIC_shared 'N'
3952 #endif
3953
3954 #ifndef PERL_MAGIC_shared_scalar
3955 # define PERL_MAGIC_shared_scalar 'n'
3956 #endif
3957
3958 #ifndef PERL_MAGIC_collxfrm
3959 # define PERL_MAGIC_collxfrm 'o'
3960 #endif
3961
3962 #ifndef PERL_MAGIC_tied
3963 # define PERL_MAGIC_tied 'P'
3964 #endif
3965
3966 #ifndef PERL_MAGIC_tiedelem
3967 # define PERL_MAGIC_tiedelem 'p'
3968 #endif
3969
3970 #ifndef PERL_MAGIC_tiedscalar
3971 # define PERL_MAGIC_tiedscalar 'q'
3972 #endif
3973
3974 #ifndef PERL_MAGIC_qr
3975 # define PERL_MAGIC_qr 'r'
3976 #endif
3977
3978 #ifndef PERL_MAGIC_sig
3979 # define PERL_MAGIC_sig 'S'
3980 #endif
3981
3982 #ifndef PERL_MAGIC_sigelem
3983 # define PERL_MAGIC_sigelem 's'
3984 #endif
3985
3986 #ifndef PERL_MAGIC_taint
3987 # define PERL_MAGIC_taint 't'
3988 #endif
3989
3990 #ifndef PERL_MAGIC_uvar
3991 # define PERL_MAGIC_uvar 'U'
3992 #endif
3993
3994 #ifndef PERL_MAGIC_uvar_elem
3995 # define PERL_MAGIC_uvar_elem 'u'
3996 #endif
3997
3998 #ifndef PERL_MAGIC_vstring
3999 # define PERL_MAGIC_vstring 'V'
4000 #endif
4001
4002 #ifndef PERL_MAGIC_vec
4003 # define PERL_MAGIC_vec 'v'
4004 #endif
4005
4006 #ifndef PERL_MAGIC_utf8
4007 # define PERL_MAGIC_utf8 'w'
4008 #endif
4009
4010 #ifndef PERL_MAGIC_substr
4011 # define PERL_MAGIC_substr 'x'
4012 #endif
4013
4014 #ifndef PERL_MAGIC_defelem
4015 # define PERL_MAGIC_defelem 'y'
4016 #endif
4017
4018 #ifndef PERL_MAGIC_glob
4019 # define PERL_MAGIC_glob '*'
4020 #endif
4021
4022 #ifndef PERL_MAGIC_arylen
4023 # define PERL_MAGIC_arylen '#'
4024 #endif
4025
4026 #ifndef PERL_MAGIC_pos
4027 # define PERL_MAGIC_pos '.'
4028 #endif
4029
4030 #ifndef PERL_MAGIC_backref
4031 # define PERL_MAGIC_backref '<'
4032 #endif
4033
4034 #ifndef PERL_MAGIC_ext
4035 # define PERL_MAGIC_ext '~'
4036 #endif
4037
4038 /* That's the best we can do... */
4039 #ifndef SvPV_force_nomg
4040 # define SvPV_force_nomg SvPV_force
4041 #endif
4042
4043 #ifndef SvPV_nomg
4044 # define SvPV_nomg SvPV
4045 #endif
4046
4047 #ifndef sv_catpvn_nomg
4048 # define sv_catpvn_nomg sv_catpvn
4049 #endif
4050
4051 #ifndef sv_catsv_nomg
4052 # define sv_catsv_nomg sv_catsv
4053 #endif
4054
4055 #ifndef sv_setsv_nomg
4056 # define sv_setsv_nomg sv_setsv
4057 #endif
4058
4059 #ifndef sv_pvn_nomg
4060 # define sv_pvn_nomg sv_pvn
4061 #endif
4062
4063 #ifndef SvIV_nomg
4064 # define SvIV_nomg SvIV
4065 #endif
4066
4067 #ifndef SvUV_nomg
4068 # define SvUV_nomg SvUV
4069 #endif
4070
4071 #ifndef sv_catpv_mg
4072 # define sv_catpv_mg(sv, ptr) \
4073 STMT_START { \
4074 SV *TeMpSv = sv; \
4075 sv_catpv(TeMpSv,ptr); \
4076 SvSETMAGIC(TeMpSv); \
4077 } STMT_END
4078 #endif
4079
4080 #ifndef sv_catpvn_mg
4081 # define sv_catpvn_mg(sv, ptr, len) \
4082 STMT_START { \
4083 SV *TeMpSv = sv; \
4084 sv_catpvn(TeMpSv,ptr,len); \
4085 SvSETMAGIC(TeMpSv); \
4086 } STMT_END
4087 #endif
4088
4089 #ifndef sv_catsv_mg
4090 # define sv_catsv_mg(dsv, ssv) \
4091 STMT_START { \
4092 SV *TeMpSv = dsv; \
4093 sv_catsv(TeMpSv,ssv); \
4094 SvSETMAGIC(TeMpSv); \
4095 } STMT_END
4096 #endif
4097
4098 #ifndef sv_setiv_mg
4099 # define sv_setiv_mg(sv, i) \
4100 STMT_START { \
4101 SV *TeMpSv = sv; \
4102 sv_setiv(TeMpSv,i); \
4103 SvSETMAGIC(TeMpSv); \
4104 } STMT_END
4105 #endif
4106
4107 #ifndef sv_setnv_mg
4108 # define sv_setnv_mg(sv, num) \
4109 STMT_START { \
4110 SV *TeMpSv = sv; \
4111 sv_setnv(TeMpSv,num); \
4112 SvSETMAGIC(TeMpSv); \
4113 } STMT_END
4114 #endif
4115
4116 #ifndef sv_setpv_mg
4117 # define sv_setpv_mg(sv, ptr) \
4118 STMT_START { \
4119 SV *TeMpSv = sv; \
4120 sv_setpv(TeMpSv,ptr); \
4121 SvSETMAGIC(TeMpSv); \
4122 } STMT_END
4123 #endif
4124
4125 #ifndef sv_setpvn_mg
4126 # define sv_setpvn_mg(sv, ptr, len) \
4127 STMT_START { \
4128 SV *TeMpSv = sv; \
4129 sv_setpvn(TeMpSv,ptr,len); \
4130 SvSETMAGIC(TeMpSv); \
4131 } STMT_END
4132 #endif
4133
4134 #ifndef sv_setsv_mg
4135 # define sv_setsv_mg(dsv, ssv) \
4136 STMT_START { \
4137 SV *TeMpSv = dsv; \
4138 sv_setsv(TeMpSv,ssv); \
4139 SvSETMAGIC(TeMpSv); \
4140 } STMT_END
4141 #endif
4142
4143 #ifndef sv_setuv_mg
4144 # define sv_setuv_mg(sv, i) \
4145 STMT_START { \
4146 SV *TeMpSv = sv; \
4147 sv_setuv(TeMpSv,i); \
4148 SvSETMAGIC(TeMpSv); \
4149 } STMT_END
4150 #endif
4151
4152 #ifndef sv_usepvn_mg
4153 # define sv_usepvn_mg(sv, ptr, len) \
4154 STMT_START { \
4155 SV *TeMpSv = sv; \
4156 sv_usepvn(TeMpSv,ptr,len); \
4157 SvSETMAGIC(TeMpSv); \
4158 } STMT_END
4159 #endif
4160
4161 #ifdef USE_ITHREADS
4162 #ifndef CopFILE
4163 # define CopFILE(c) ((c)->cop_file)
4164 #endif
4165
4166 #ifndef CopFILEGV
4167 # define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
4168 #endif
4169
4170 #ifndef CopFILE_set
4171 # define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
4172 #endif
4173
4174 #ifndef CopFILESV
4175 # define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
4176 #endif
4177
4178 #ifndef CopFILEAV
4179 # define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
4180 #endif
4181
4182 #ifndef CopSTASHPV
4183 # define CopSTASHPV(c) ((c)->cop_stashpv)
4184 #endif
4185
4186 #ifndef CopSTASHPV_set
4187 # define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
4188 #endif
4189
4190 #ifndef CopSTASH
4191 # define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
4192 #endif
4193
4194 #ifndef CopSTASH_set
4195 # define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
4196 #endif
4197
4198 #ifndef CopSTASH_eq
4199 # define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \
4200 || (CopSTASHPV(c) && HvNAME(hv) \
4201 && strEQ(CopSTASHPV(c), HvNAME(hv)))))
4202 #endif
4203
4204 #else
4205 #ifndef CopFILEGV
4206 # define CopFILEGV(c) ((c)->cop_filegv)
4207 #endif
4208
4209 #ifndef CopFILEGV_set
4210 # define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
4211 #endif
4212
4213 #ifndef CopFILE_set
4214 # define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
4215 #endif
4216
4217 #ifndef CopFILESV
4218 # define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
4219 #endif
4220
4221 #ifndef CopFILEAV
4222 # define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
4223 #endif
4224
4225 #ifndef CopFILE
4226 # define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
4227 #endif
4228
4229 #ifndef CopSTASH
4230 # define CopSTASH(c) ((c)->cop_stash)
4231 #endif
4232
4233 #ifndef CopSTASH_set
4234 # define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
4235 #endif
4236
4237 #ifndef CopSTASHPV
4238 # define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
4239 #endif
4240
4241 #ifndef CopSTASHPV_set
4242 # define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
4243 #endif
4244
4245 #ifndef CopSTASH_eq
4246 # define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
4247 #endif
4248
4249 #endif /* USE_ITHREADS */
4250 #ifndef IN_PERL_COMPILETIME
4251 # define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
4252 #endif
4253
4254 #ifndef IN_LOCALE_RUNTIME
4255 # define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
4256 #endif
4257
4258 #ifndef IN_LOCALE_COMPILETIME
4259 # define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
4260 #endif
4261
4262 #ifndef IN_LOCALE
4263 # define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
4264 #endif
4265 #ifndef IS_NUMBER_IN_UV
4266 # define IS_NUMBER_IN_UV 0x01
4267 #endif
4268
4269 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
4270 # define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
4271 #endif
4272
4273 #ifndef IS_NUMBER_NOT_INT
4274 # define IS_NUMBER_NOT_INT 0x04
4275 #endif
4276
4277 #ifndef IS_NUMBER_NEG
4278 # define IS_NUMBER_NEG 0x08
4279 #endif
4280
4281 #ifndef IS_NUMBER_INFINITY
4282 # define IS_NUMBER_INFINITY 0x10
4283 #endif
4284
4285 #ifndef IS_NUMBER_NAN
4286 # define IS_NUMBER_NAN 0x20
4287 #endif
4288
4289 /* GROK_NUMERIC_RADIX depends on grok_numeric_radix */
4290 #ifndef GROK_NUMERIC_RADIX
4291 # define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
4292 #endif
4293 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
4294 # define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
4295 #endif
4296
4297 #ifndef PERL_SCAN_SILENT_ILLDIGIT
4298 # define PERL_SCAN_SILENT_ILLDIGIT 0x04
4299 #endif
4300
4301 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
4302 # define PERL_SCAN_ALLOW_UNDERSCORES 0x01
4303 #endif
4304
4305 #ifndef PERL_SCAN_DISALLOW_PREFIX
4306 # define PERL_SCAN_DISALLOW_PREFIX 0x02
4307 #endif
4308
4309 #ifndef grok_numeric_radix
4310 #if defined(NEED_grok_numeric_radix)
4311 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
4312 static
4313 #else
4314 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
4315 #endif
4316
4317 #ifdef grok_numeric_radix
4318 # undef grok_numeric_radix
4319 #endif
4320 #define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
4321 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
4322
4323 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
4324 bool
DPPP_(my_grok_numeric_radix)4325 DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
4326 {
4327 #ifdef USE_LOCALE_NUMERIC
4328 #ifdef PL_numeric_radix_sv
4329 if (PL_numeric_radix_sv && IN_LOCALE) {
4330 STRLEN len;
4331 char* radix = SvPV(PL_numeric_radix_sv, len);
4332 if (*sp + len <= send && memEQ(*sp, radix, len)) {
4333 *sp += len;
4334 return TRUE;
4335 }
4336 }
4337 #else
4338 /* older perls don't have PL_numeric_radix_sv so the radix
4339 * must manually be requested from locale.h
4340 */
4341 #include <locale.h>
4342 dTHR; /* needed for older threaded perls */
4343 struct lconv *lc = localeconv();
4344 char *radix = lc->decimal_point;
4345 if (radix && IN_LOCALE) {
4346 STRLEN len = strlen(radix);
4347 if (*sp + len <= send && memEQ(*sp, radix, len)) {
4348 *sp += len;
4349 return TRUE;
4350 }
4351 }
4352 #endif /* PERL_VERSION */
4353 #endif /* USE_LOCALE_NUMERIC */
4354 /* always try "." if numeric radix didn't match because
4355 * we may have data from different locales mixed */
4356 if (*sp < send && **sp == '.') {
4357 ++*sp;
4358 return TRUE;
4359 }
4360 return FALSE;
4361 }
4362 #endif
4363 #endif
4364
4365 /* grok_number depends on grok_numeric_radix */
4366
4367 #ifndef grok_number
4368 #if defined(NEED_grok_number)
4369 static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
4370 static
4371 #else
4372 extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
4373 #endif
4374
4375 #ifdef grok_number
4376 # undef grok_number
4377 #endif
4378 #define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
4379 #define Perl_grok_number DPPP_(my_grok_number)
4380
4381 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
4382 int
DPPP_(my_grok_number)4383 DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
4384 {
4385 const char *s = pv;
4386 const char *send = pv + len;
4387 const UV max_div_10 = UV_MAX / 10;
4388 const char max_mod_10 = UV_MAX % 10;
4389 int numtype = 0;
4390 int sawinf = 0;
4391 int sawnan = 0;
4392
4393 while (s < send && isSPACE(*s))
4394 s++;
4395 if (s == send) {
4396 return 0;
4397 } else if (*s == '-') {
4398 s++;
4399 numtype = IS_NUMBER_NEG;
4400 }
4401 else if (*s == '+')
4402 s++;
4403
4404 if (s == send)
4405 return 0;
4406
4407 /* next must be digit or the radix separator or beginning of infinity */
4408 if (isDIGIT(*s)) {
4409 /* UVs are at least 32 bits, so the first 9 decimal digits cannot
4410 overflow. */
4411 UV value = *s - '0';
4412 /* This construction seems to be more optimiser friendly.
4413 (without it gcc does the isDIGIT test and the *s - '0' separately)
4414 With it gcc on arm is managing 6 instructions (6 cycles) per digit.
4415 In theory the optimiser could deduce how far to unroll the loop
4416 before checking for overflow. */
4417 if (++s < send) {
4418 int digit = *s - '0';
4419 if (digit >= 0 && digit <= 9) {
4420 value = value * 10 + digit;
4421 if (++s < send) {
4422 digit = *s - '0';
4423 if (digit >= 0 && digit <= 9) {
4424 value = value * 10 + digit;
4425 if (++s < send) {
4426 digit = *s - '0';
4427 if (digit >= 0 && digit <= 9) {
4428 value = value * 10 + digit;
4429 if (++s < send) {
4430 digit = *s - '0';
4431 if (digit >= 0 && digit <= 9) {
4432 value = value * 10 + digit;
4433 if (++s < send) {
4434 digit = *s - '0';
4435 if (digit >= 0 && digit <= 9) {
4436 value = value * 10 + digit;
4437 if (++s < send) {
4438 digit = *s - '0';
4439 if (digit >= 0 && digit <= 9) {
4440 value = value * 10 + digit;
4441 if (++s < send) {
4442 digit = *s - '0';
4443 if (digit >= 0 && digit <= 9) {
4444 value = value * 10 + digit;
4445 if (++s < send) {
4446 digit = *s - '0';
4447 if (digit >= 0 && digit <= 9) {
4448 value = value * 10 + digit;
4449 if (++s < send) {
4450 /* Now got 9 digits, so need to check
4451 each time for overflow. */
4452 digit = *s - '0';
4453 while (digit >= 0 && digit <= 9
4454 && (value < max_div_10
4455 || (value == max_div_10
4456 && digit <= max_mod_10))) {
4457 value = value * 10 + digit;
4458 if (++s < send)
4459 digit = *s - '0';
4460 else
4461 break;
4462 }
4463 if (digit >= 0 && digit <= 9
4464 && (s < send)) {
4465 /* value overflowed.
4466 skip the remaining digits, don't
4467 worry about setting *valuep. */
4468 do {
4469 s++;
4470 } while (s < send && isDIGIT(*s));
4471 numtype |=
4472 IS_NUMBER_GREATER_THAN_UV_MAX;
4473 goto skip_value;
4474 }
4475 }
4476 }
4477 }
4478 }
4479 }
4480 }
4481 }
4482 }
4483 }
4484 }
4485 }
4486 }
4487 }
4488 }
4489 }
4490 }
4491 }
4492 numtype |= IS_NUMBER_IN_UV;
4493 if (valuep)
4494 *valuep = value;
4495
4496 skip_value:
4497 if (GROK_NUMERIC_RADIX(&s, send)) {
4498 numtype |= IS_NUMBER_NOT_INT;
4499 while (s < send && isDIGIT(*s)) /* optional digits after the radix */
4500 s++;
4501 }
4502 }
4503 else if (GROK_NUMERIC_RADIX(&s, send)) {
4504 numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
4505 /* no digits before the radix means we need digits after it */
4506 if (s < send && isDIGIT(*s)) {
4507 do {
4508 s++;
4509 } while (s < send && isDIGIT(*s));
4510 if (valuep) {
4511 /* integer approximation is valid - it's 0. */
4512 *valuep = 0;
4513 }
4514 }
4515 else
4516 return 0;
4517 } else if (*s == 'I' || *s == 'i') {
4518 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
4519 s++; if (s == send || (*s != 'F' && *s != 'f')) return 0;
4520 s++; if (s < send && (*s == 'I' || *s == 'i')) {
4521 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
4522 s++; if (s == send || (*s != 'I' && *s != 'i')) return 0;
4523 s++; if (s == send || (*s != 'T' && *s != 't')) return 0;
4524 s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0;
4525 s++;
4526 }
4527 sawinf = 1;
4528 } else if (*s == 'N' || *s == 'n') {
4529 /* XXX TODO: There are signaling NaNs and quiet NaNs. */
4530 s++; if (s == send || (*s != 'A' && *s != 'a')) return 0;
4531 s++; if (s == send || (*s != 'N' && *s != 'n')) return 0;
4532 s++;
4533 sawnan = 1;
4534 } else
4535 return 0;
4536
4537 if (sawinf) {
4538 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
4539 numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
4540 } else if (sawnan) {
4541 numtype &= IS_NUMBER_NEG; /* Keep track of sign */
4542 numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
4543 } else if (s < send) {
4544 /* we can have an optional exponent part */
4545 if (*s == 'e' || *s == 'E') {
4546 /* The only flag we keep is sign. Blow away any "it's UV" */
4547 numtype &= IS_NUMBER_NEG;
4548 numtype |= IS_NUMBER_NOT_INT;
4549 s++;
4550 if (s < send && (*s == '-' || *s == '+'))
4551 s++;
4552 if (s < send && isDIGIT(*s)) {
4553 do {
4554 s++;
4555 } while (s < send && isDIGIT(*s));
4556 }
4557 else
4558 return 0;
4559 }
4560 }
4561 while (s < send && isSPACE(*s))
4562 s++;
4563 if (s >= send)
4564 return numtype;
4565 if (len == 10 && memEQ(pv, "0 but true", 10)) {
4566 if (valuep)
4567 *valuep = 0;
4568 return IS_NUMBER_IN_UV;
4569 }
4570 return 0;
4571 }
4572 #endif
4573 #endif
4574
4575 /*
4576 * The grok_* routines have been modified to use warn() instead of
4577 * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
4578 * which is why the stack variable has been renamed to 'xdigit'.
4579 */
4580
4581 #ifndef grok_bin
4582 #if defined(NEED_grok_bin)
4583 static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4584 static
4585 #else
4586 extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4587 #endif
4588
4589 #ifdef grok_bin
4590 # undef grok_bin
4591 #endif
4592 #define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
4593 #define Perl_grok_bin DPPP_(my_grok_bin)
4594
4595 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
4596 UV
DPPP_(my_grok_bin)4597 DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4598 {
4599 const char *s = start;
4600 STRLEN len = *len_p;
4601 UV value = 0;
4602 NV value_nv = 0;
4603
4604 const UV max_div_2 = UV_MAX / 2;
4605 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4606 bool overflowed = FALSE;
4607
4608 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
4609 /* strip off leading b or 0b.
4610 for compatibility silently suffer "b" and "0b" as valid binary
4611 numbers. */
4612 if (len >= 1) {
4613 if (s[0] == 'b') {
4614 s++;
4615 len--;
4616 }
4617 else if (len >= 2 && s[0] == '0' && s[1] == 'b') {
4618 s+=2;
4619 len-=2;
4620 }
4621 }
4622 }
4623
4624 for (; len-- && *s; s++) {
4625 char bit = *s;
4626 if (bit == '0' || bit == '1') {
4627 /* Write it in this wonky order with a goto to attempt to get the
4628 compiler to make the common case integer-only loop pretty tight.
4629 With gcc seems to be much straighter code than old scan_bin. */
4630 redo:
4631 if (!overflowed) {
4632 if (value <= max_div_2) {
4633 value = (value << 1) | (bit - '0');
4634 continue;
4635 }
4636 /* Bah. We're just overflowed. */
4637 warn("Integer overflow in binary number");
4638 overflowed = TRUE;
4639 value_nv = (NV) value;
4640 }
4641 value_nv *= 2.0;
4642 /* If an NV has not enough bits in its mantissa to
4643 * represent a UV this summing of small low-order numbers
4644 * is a waste of time (because the NV cannot preserve
4645 * the low-order bits anyway): we could just remember when
4646 * did we overflow and in the end just multiply value_nv by the
4647 * right amount. */
4648 value_nv += (NV)(bit - '0');
4649 continue;
4650 }
4651 if (bit == '_' && len && allow_underscores && (bit = s[1])
4652 && (bit == '0' || bit == '1'))
4653 {
4654 --len;
4655 ++s;
4656 goto redo;
4657 }
4658 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4659 warn("Illegal binary digit '%c' ignored", *s);
4660 break;
4661 }
4662
4663 if ( ( overflowed && value_nv > 4294967295.0)
4664 #if UVSIZE > 4
4665 || (!overflowed && value > 0xffffffff )
4666 #endif
4667 ) {
4668 warn("Binary number > 0b11111111111111111111111111111111 non-portable");
4669 }
4670 *len_p = s - start;
4671 if (!overflowed) {
4672 *flags = 0;
4673 return value;
4674 }
4675 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4676 if (result)
4677 *result = value_nv;
4678 return UV_MAX;
4679 }
4680 #endif
4681 #endif
4682
4683 #ifndef grok_hex
4684 #if defined(NEED_grok_hex)
4685 static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4686 static
4687 #else
4688 extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4689 #endif
4690
4691 #ifdef grok_hex
4692 # undef grok_hex
4693 #endif
4694 #define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
4695 #define Perl_grok_hex DPPP_(my_grok_hex)
4696
4697 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
4698 UV
DPPP_(my_grok_hex)4699 DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4700 {
4701 const char *s = start;
4702 STRLEN len = *len_p;
4703 UV value = 0;
4704 NV value_nv = 0;
4705
4706 const UV max_div_16 = UV_MAX / 16;
4707 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4708 bool overflowed = FALSE;
4709 const char *xdigit;
4710
4711 if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) {
4712 /* strip off leading x or 0x.
4713 for compatibility silently suffer "x" and "0x" as valid hex numbers.
4714 */
4715 if (len >= 1) {
4716 if (s[0] == 'x') {
4717 s++;
4718 len--;
4719 }
4720 else if (len >= 2 && s[0] == '0' && s[1] == 'x') {
4721 s+=2;
4722 len-=2;
4723 }
4724 }
4725 }
4726
4727 for (; len-- && *s; s++) {
4728 xdigit = strchr((char *) PL_hexdigit, *s);
4729 if (xdigit) {
4730 /* Write it in this wonky order with a goto to attempt to get the
4731 compiler to make the common case integer-only loop pretty tight.
4732 With gcc seems to be much straighter code than old scan_hex. */
4733 redo:
4734 if (!overflowed) {
4735 if (value <= max_div_16) {
4736 value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
4737 continue;
4738 }
4739 warn("Integer overflow in hexadecimal number");
4740 overflowed = TRUE;
4741 value_nv = (NV) value;
4742 }
4743 value_nv *= 16.0;
4744 /* If an NV has not enough bits in its mantissa to
4745 * represent a UV this summing of small low-order numbers
4746 * is a waste of time (because the NV cannot preserve
4747 * the low-order bits anyway): we could just remember when
4748 * did we overflow and in the end just multiply value_nv by the
4749 * right amount of 16-tuples. */
4750 value_nv += (NV)((xdigit - PL_hexdigit) & 15);
4751 continue;
4752 }
4753 if (*s == '_' && len && allow_underscores && s[1]
4754 && (xdigit = strchr((char *) PL_hexdigit, s[1])))
4755 {
4756 --len;
4757 ++s;
4758 goto redo;
4759 }
4760 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4761 warn("Illegal hexadecimal digit '%c' ignored", *s);
4762 break;
4763 }
4764
4765 if ( ( overflowed && value_nv > 4294967295.0)
4766 #if UVSIZE > 4
4767 || (!overflowed && value > 0xffffffff )
4768 #endif
4769 ) {
4770 warn("Hexadecimal number > 0xffffffff non-portable");
4771 }
4772 *len_p = s - start;
4773 if (!overflowed) {
4774 *flags = 0;
4775 return value;
4776 }
4777 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4778 if (result)
4779 *result = value_nv;
4780 return UV_MAX;
4781 }
4782 #endif
4783 #endif
4784
4785 #ifndef grok_oct
4786 #if defined(NEED_grok_oct)
4787 static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4788 static
4789 #else
4790 extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4791 #endif
4792
4793 #ifdef grok_oct
4794 # undef grok_oct
4795 #endif
4796 #define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
4797 #define Perl_grok_oct DPPP_(my_grok_oct)
4798
4799 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
4800 UV
DPPP_(my_grok_oct)4801 DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4802 {
4803 const char *s = start;
4804 STRLEN len = *len_p;
4805 UV value = 0;
4806 NV value_nv = 0;
4807
4808 const UV max_div_8 = UV_MAX / 8;
4809 bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4810 bool overflowed = FALSE;
4811
4812 for (; len-- && *s; s++) {
4813 /* gcc 2.95 optimiser not smart enough to figure that this subtraction
4814 out front allows slicker code. */
4815 int digit = *s - '0';
4816 if (digit >= 0 && digit <= 7) {
4817 /* Write it in this wonky order with a goto to attempt to get the
4818 compiler to make the common case integer-only loop pretty tight.
4819 */
4820 redo:
4821 if (!overflowed) {
4822 if (value <= max_div_8) {
4823 value = (value << 3) | digit;
4824 continue;
4825 }
4826 /* Bah. We're just overflowed. */
4827 warn("Integer overflow in octal number");
4828 overflowed = TRUE;
4829 value_nv = (NV) value;
4830 }
4831 value_nv *= 8.0;
4832 /* If an NV has not enough bits in its mantissa to
4833 * represent a UV this summing of small low-order numbers
4834 * is a waste of time (because the NV cannot preserve
4835 * the low-order bits anyway): we could just remember when
4836 * did we overflow and in the end just multiply value_nv by the
4837 * right amount of 8-tuples. */
4838 value_nv += (NV)digit;
4839 continue;
4840 }
4841 if (digit == ('_' - '0') && len && allow_underscores
4842 && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
4843 {
4844 --len;
4845 ++s;
4846 goto redo;
4847 }
4848 /* Allow \octal to work the DWIM way (that is, stop scanning
4849 * as soon as non-octal characters are seen, complain only iff
4850 * someone seems to want to use the digits eight and nine). */
4851 if (digit == 8 || digit == 9) {
4852 if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4853 warn("Illegal octal digit '%c' ignored", *s);
4854 }
4855 break;
4856 }
4857
4858 if ( ( overflowed && value_nv > 4294967295.0)
4859 #if UVSIZE > 4
4860 || (!overflowed && value > 0xffffffff )
4861 #endif
4862 ) {
4863 warn("Octal number > 037777777777 non-portable");
4864 }
4865 *len_p = s - start;
4866 if (!overflowed) {
4867 *flags = 0;
4868 return value;
4869 }
4870 *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4871 if (result)
4872 *result = value_nv;
4873 return UV_MAX;
4874 }
4875 #endif
4876 #endif
4877
4878 #ifdef NO_XSLOCKS
4879 # ifdef dJMPENV
4880 # define dXCPT dJMPENV; int rEtV = 0
4881 # define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
4882 # define XCPT_TRY_END JMPENV_POP;
4883 # define XCPT_CATCH if (rEtV != 0)
4884 # define XCPT_RETHROW JMPENV_JUMP(rEtV)
4885 # else
4886 # define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
4887 # define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
4888 # define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
4889 # define XCPT_CATCH if (rEtV != 0)
4890 # define XCPT_RETHROW Siglongjmp(top_env, rEtV)
4891 # endif
4892 #endif
4893
4894 #endif /* _P_P_PORTABILITY_H_ */
4895
4896 /* End of File ppport.h */
4897