source: trunk/lang/perl/ppport.h @ 4503

Last change on this file since 4503 was 481, checked in by nkissebe, 14 years ago

Initial revision of Perl binding for Rappture

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