]> git.imager.perl.org - imager.git/blame - ppport.h
projects / imager.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
PNG re-work: handle libpng 1.5 correctly
[imager.git] / ppport.h
CommitLineData
7a6cd05b
TC		 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 Tue Jul 4 22:01:23 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 */
02d1d628 3382
7a6cd05b
TC		 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.
e18f39b3 3516 *
7a6cd05b
TC		 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().
e18f39b3 3750 */
7a6cd05b
TC		 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)
02d1d628 3768
7a6cd05b 3769#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
02d1d628 3770
7a6cd05b
TC		 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}
02d1d628 3778
7a6cd05b
TC		 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
02d1d628 3786
7a6cd05b
TC		 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
02d1d628 3791
7a6cd05b
TC		 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);
02d1d628 3813}
02d1d628 3814
7a6cd05b
TC		 3815#endif
3816#endif
02d1d628 3817
7a6cd05b
TC		 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);
02d1d628 3842}
02d1d628 3843
7a6cd05b
TC		 3844#endif
3845#endif
3846#endif
e18f39b3 3847
7a6cd05b
TC		 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
02d1d628
AMH		 3854#endif
3855
7a6cd05b
TC		 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
02d1d628 3864
7a6cd05b
TC		 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
e18f39b3 3873
7a6cd05b
TC		 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
02d1d628
AMH		 3889#endif
3890
7a6cd05b
TC		 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, ...);
02d1d628
AMH		 3899#endif
3900
7a6cd05b
TC		 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
e18f39b3 3924# else
7a6cd05b 3925# define sv_setpvf_mg Perl_sv_setpvf_mg
e18f39b3 3926# endif
e18f39b3
TC		 3927#endif
3928
7a6cd05b
TC		 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'
e18f39b3
TC		 3942#endif
3943
7a6cd05b
TC		 3944#ifndef PERL_MAGIC_overload
3945# define PERL_MAGIC_overload 'A'
e18f39b3
TC		 3946#endif
3947
7a6cd05b
TC		 3948#ifndef PERL_MAGIC_overload_elem
3949# define PERL_MAGIC_overload_elem 'a'
e18f39b3
TC		 3950#endif
3951
7a6cd05b
TC		 3952#ifndef PERL_MAGIC_overload_table
3953# define PERL_MAGIC_overload_table 'c'
3954#endif
e18f39b3 3955
7a6cd05b
TC		 3956#ifndef PERL_MAGIC_bm
3957# define PERL_MAGIC_bm 'B'
e18f39b3 3958#endif
7a6cd05b
TC		 3959
3960#ifndef PERL_MAGIC_regdata
3961# define PERL_MAGIC_regdata 'D'
e18f39b3
TC		 3962#endif
3963
7a6cd05b
TC		 3964#ifndef PERL_MAGIC_regdatum
3965# define PERL_MAGIC_regdatum 'd'
e18f39b3 3966#endif
7a6cd05b
TC		 3967
3968#ifndef PERL_MAGIC_env
3969# define PERL_MAGIC_env 'E'
e18f39b3
TC		 3970#endif
3971
7a6cd05b
TC		 3972#ifndef PERL_MAGIC_envelem
3973# define PERL_MAGIC_envelem 'e'
e18f39b3
TC		 3974#endif
3975
7a6cd05b
TC		 3976#ifndef PERL_MAGIC_fm
3977# define PERL_MAGIC_fm 'f'
e18f39b3
TC		 3978#endif
3979
7a6cd05b
TC		 3980#ifndef PERL_MAGIC_regex_global
3981# define PERL_MAGIC_regex_global 'g'
3982#endif
e18f39b3 3983
7a6cd05b
TC		 3984#ifndef PERL_MAGIC_isa
3985# define PERL_MAGIC_isa 'I'
02d1d628
AMH		 3986#endif
3987
7a6cd05b
TC		 3988#ifndef PERL_MAGIC_isaelem
3989# define PERL_MAGIC_isaelem 'i'
3990#endif
e18f39b3 3991
7a6cd05b
TC		 3992#ifndef PERL_MAGIC_nkeys
3993# define PERL_MAGIC_nkeys 'k'
02d1d628
AMH		 3994#endif
3995
7a6cd05b
TC		 3996#ifndef PERL_MAGIC_dbfile
3997# define PERL_MAGIC_dbfile 'L'
02d1d628
AMH		 3998#endif
3999
7a6cd05b
TC		 4000#ifndef PERL_MAGIC_dbline
4001# define PERL_MAGIC_dbline 'l'
02d1d628
AMH		 4002#endif
4003
7a6cd05b
TC		 4004#ifndef PERL_MAGIC_mutex
4005# define PERL_MAGIC_mutex 'm'
02d1d628
AMH		 4006#endif
4007
7a6cd05b
TC		 4008#ifndef PERL_MAGIC_shared
4009# define PERL_MAGIC_shared 'N'
e18f39b3
TC		 4010#endif
4011
7a6cd05b
TC		 4012#ifndef PERL_MAGIC_shared_scalar
4013# define PERL_MAGIC_shared_scalar 'n'
e18f39b3
TC		 4014#endif
4015
7a6cd05b
TC		 4016#ifndef PERL_MAGIC_collxfrm
4017# define PERL_MAGIC_collxfrm 'o'
02d1d628
AMH		 4018#endif
4019
7a6cd05b
TC		 4020#ifndef PERL_MAGIC_tied
4021# define PERL_MAGIC_tied 'P'
4022#endif
02d1d628 4023
7a6cd05b
TC		 4024#ifndef PERL_MAGIC_tiedelem
4025# define PERL_MAGIC_tiedelem 'p'
4026#endif
02d1d628 4027
7a6cd05b
TC		 4028#ifndef PERL_MAGIC_tiedscalar
4029# define PERL_MAGIC_tiedscalar 'q'
02d1d628
AMH		 4030#endif
4031
7a6cd05b
TC		 4032#ifndef PERL_MAGIC_qr
4033# define PERL_MAGIC_qr 'r'
4034#endif
02d1d628 4035
7a6cd05b
TC		 4036#ifndef PERL_MAGIC_sig
4037# define PERL_MAGIC_sig 'S'
4038#endif
02d1d628 4039
7a6cd05b
TC		 4040#ifndef PERL_MAGIC_sigelem
4041# define PERL_MAGIC_sigelem 's'
4042#endif
02d1d628 4043
7a6cd05b
TC		 4044#ifndef PERL_MAGIC_taint
4045# define PERL_MAGIC_taint 't'
02d1d628
AMH		 4046#endif
4047
7a6cd05b
TC		 4048#ifndef PERL_MAGIC_uvar
4049# define PERL_MAGIC_uvar 'U'
4050#endif
02d1d628 4051
7a6cd05b
TC		 4052#ifndef PERL_MAGIC_uvar_elem
4053# define PERL_MAGIC_uvar_elem 'u'
02d1d628
AMH		 4054#endif
4055
7a6cd05b
TC		 4056#ifndef PERL_MAGIC_vstring
4057# define PERL_MAGIC_vstring 'V'
4058#endif
02d1d628 4059
7a6cd05b
TC		 4060#ifndef PERL_MAGIC_vec
4061# define PERL_MAGIC_vec 'v'
4062#endif
e18f39b3 4063
7a6cd05b
TC		 4064#ifndef PERL_MAGIC_utf8
4065# define PERL_MAGIC_utf8 'w'
4066#endif
e18f39b3 4067
7a6cd05b
TC		 4068#ifndef PERL_MAGIC_substr
4069# define PERL_MAGIC_substr 'x'
4070#endif
e18f39b3 4071
7a6cd05b
TC		 4072#ifndef PERL_MAGIC_defelem
4073# define PERL_MAGIC_defelem 'y'
4074#endif
e18f39b3 4075
7a6cd05b
TC		 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
e18f39b3 4116
7a6cd05b
TC		 4117#ifndef sv_pvn_nomg
4118# define sv_pvn_nomg sv_pvn
4119#endif
e18f39b3 4120
7a6cd05b
TC		 4121#ifndef SvIV_nomg
4122# define SvIV_nomg SvIV
4123#endif
e18f39b3 4124
7a6cd05b
TC		 4125#ifndef SvUV_nomg
4126# define SvUV_nomg SvUV
4127#endif
e18f39b3 4128
7a6cd05b
TC		 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
e18f39b3 4137
7a6cd05b
TC		 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
e18f39b3 4146
7a6cd05b
TC		 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
e18f39b3 4155
7a6cd05b
TC		 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
e18f39b3 4164
7a6cd05b
TC		 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
e18f39b3 4173
7a6cd05b
TC		 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
e18f39b3 4182
7a6cd05b
TC		 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
e18f39b3
TC		 4190#endif
4191
7a6cd05b
TC		 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
e18f39b3
TC		 4199#endif
4200
7a6cd05b
TC		 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
e18f39b3
TC		 4208#endif
4209
7a6cd05b
TC		 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
e18f39b3
TC		 4217#endif
4218
7a6cd05b
TC		 4219#ifdef USE_ITHREADS
4220#ifndef CopFILE
4221# define CopFILE(c) ((c)->cop_file)
e18f39b3
TC		 4222#endif
4223
7a6cd05b
TC		 4224#ifndef CopFILEGV
4225# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
e18f39b3
TC		 4226#endif
4227
7a6cd05b
TC		 4228#ifndef CopFILE_set
4229# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv))
e18f39b3
TC		 4230#endif
4231
7a6cd05b
TC		 4232#ifndef CopFILESV
4233# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
e18f39b3
TC		 4234#endif
4235
7a6cd05b
TC		 4236#ifndef CopFILEAV
4237# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
e18f39b3
TC		 4238#endif
4239
7a6cd05b
TC		 4240#ifndef CopSTASHPV
4241# define CopSTASHPV(c) ((c)->cop_stashpv)
e18f39b3
TC		 4242#endif
4243
7a6cd05b
TC		 4244#ifndef CopSTASHPV_set
4245# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
e18f39b3
TC		 4246#endif
4247
7a6cd05b
TC		 4248#ifndef CopSTASH
4249# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv)
e18f39b3
TC		 4250#endif
4251
7a6cd05b
TC		 4252#ifndef CopSTASH_set
4253# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
e18f39b3
TC		 4254#endif
4255
7a6cd05b
TC		 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)))))
e18f39b3
TC		 4260#endif
4261
7a6cd05b
TC		 4262#else
4263#ifndef CopFILEGV
4264# define CopFILEGV(c) ((c)->cop_filegv)
e18f39b3
TC		 4265#endif
4266
7a6cd05b
TC		 4267#ifndef CopFILEGV_set
4268# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv))
e18f39b3
TC		 4269#endif
4270
7a6cd05b
TC		 4271#ifndef CopFILE_set
4272# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv))
e18f39b3
TC		 4273#endif
4274
7a6cd05b
TC		 4275#ifndef CopFILESV
4276# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
e18f39b3
TC		 4277#endif
4278
7a6cd05b
TC		 4279#ifndef CopFILEAV
4280# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
e18f39b3
TC		 4281#endif
4282
7a6cd05b
TC		 4283#ifndef CopFILE
4284# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
e18f39b3
TC		 4285#endif
4286
7a6cd05b
TC		 4287#ifndef CopSTASH
4288# define CopSTASH(c) ((c)->cop_stash)
4289#endif
e18f39b3 4290
7a6cd05b
TC		 4291#ifndef CopSTASH_set
4292# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv))
4293#endif
e18f39b3 4294
7a6cd05b
TC		 4295#ifndef CopSTASHPV
4296# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
e18f39b3
TC		 4297#endif
4298
7a6cd05b
TC		 4299#ifndef CopSTASHPV_set
4300# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD))
4301#endif
e18f39b3 4302
7a6cd05b
TC		 4303#ifndef CopSTASH_eq
4304# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv))
e18f39b3
TC		 4305#endif
4306
7a6cd05b
TC		 4307#endif /* USE_ITHREADS */
4308#ifndef IN_PERL_COMPILETIME
4309# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
e18f39b3
TC		 4310#endif
4311
4312#ifndef IN_LOCALE_RUNTIME
7a6cd05b 4313# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
e18f39b3
TC		 4314#endif
4315
4316#ifndef IN_LOCALE_COMPILETIME
7a6cd05b 4317# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
e18f39b3
TC		 4318#endif
4319
7a6cd05b
TC		 4320#ifndef IN_LOCALE
4321# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
4322#endif
e18f39b3 4323#ifndef IS_NUMBER_IN_UV
7a6cd05b
TC		 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
e18f39b3 4367#ifndef grok_numeric_radix
7a6cd05b
TC		 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)
e18f39b3 4380
7a6cd05b 4381#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
e18f39b3 4382bool
7a6cd05b 4383DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
e18f39b3
TC		 4384{
4385#ifdef USE_LOCALE_NUMERIC
7a6cd05b
TC		 4386#ifdef PL_numeric_radix_sv
4387 if (PL_numeric_radix_sv && IN_LOCALE) {
e18f39b3
TC		 4388 STRLEN len;
4389 char* radix = SvPV(PL_numeric_radix_sv, len);
4390 if (*sp + len <= send && memEQ(*sp, radix, len)) {
4391 *sp += len;
7a6cd05b 4392 return TRUE;
e18f39b3
TC		 4393 }
4394 }
4395#else
7a6cd05b
TC		 4396 /* older perls don't have PL_numeric_radix_sv so the radix
4397 * must manually be requested from locale.h
4398 */
e18f39b3 4399#include <locale.h>
7a6cd05b 4400 dTHR; /* needed for older threaded perls */
e18f39b3
TC		 4401 struct lconv *lc = localeconv();
4402 char *radix = lc->decimal_point;
7a6cd05b 4403 if (radix && IN_LOCALE) {
e18f39b3
TC		 4404 STRLEN len = strlen(radix);
4405 if (*sp + len <= send && memEQ(*sp, radix, len)) {
4406 *sp += len;
7a6cd05b 4407 return TRUE;
e18f39b3
TC		 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}
7a6cd05b
TC		 4420#endif
4421#endif
4422
4423/* grok_number depends on grok_numeric_radix */
e18f39b3
TC		 4424
4425#ifndef grok_number
7a6cd05b
TC		 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
e18f39b3 4432
7a6cd05b
TC		 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)
e18f39b3 4438
7a6cd05b 4439#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
e18f39b3 4440int
7a6cd05b 4441DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
e18f39b3
TC		 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;
7a6cd05b 4487 if (++s < send) {
e18f39b3
TC		 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 }
7a6cd05b 4535 }
e18f39b3
TC		 4536 }
4537 }
4538 }
4539 }
4540 }
4541 }
4542 }
4543 }
4544 }
4545 }
4546 }
7a6cd05b 4547 }
e18f39b3
TC		 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}
e18f39b3 4630#endif
e18f39b3
TC		 4631#endif
4632
7a6cd05b
TC		 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 */
e18f39b3 4638
7a6cd05b
TC		 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);
e18f39b3
TC		 4645#endif
4646
7a6cd05b
TC		 4647#ifdef grok_bin
4648# undef grok_bin
e18f39b3 4649#endif
7a6cd05b
TC		 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)
e18f39b3 4652
7a6cd05b
TC		 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 }
e18f39b3 4681
7a6cd05b
TC		 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 }
e18f39b3 4720
7a6cd05b
TC		 4721 if ( ( overflowed && value_nv > 4294967295.0)
4722#if UVSIZE > 4
4723 || (!overflowed && value > 0xffffffff )
e18f39b3 4724#endif
7a6cd05b
TC		 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}
e18f39b3 4738#endif
e18f39b3
TC		 4739#endif
4740
7a6cd05b
TC		 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);
e18f39b3
TC		 4747#endif
4748
7a6cd05b
TC		 4749#ifdef grok_hex
4750# undef grok_hex
e18f39b3 4751#endif
7a6cd05b
TC		 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)
e18f39b3 4754
7a6cd05b
TC		 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 }
e18f39b3 4784
7a6cd05b
TC		 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 }
e18f39b3 4822
7a6cd05b
TC		 4823 if ( ( overflowed && value_nv > 4294967295.0)
4824#if UVSIZE > 4
4825 || (!overflowed && value > 0xffffffff )
e18f39b3 4826#endif
7a6cd05b
TC		 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}
e18f39b3 4840#endif
e18f39b3
TC		 4841#endif
4842
7a6cd05b
TC		 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);
e18f39b3
TC		 4849#endif
4850
7a6cd05b
TC		 4851#ifdef grok_oct
4852# undef grok_oct
e18f39b3 4853#endif
7a6cd05b
TC		 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)
e18f39b3 4856
7a6cd05b
TC		 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 }
e18f39b3 4915
7a6cd05b
TC		 4916 if ( ( overflowed && value_nv > 4294967295.0)
4917#if UVSIZE > 4
4918 || (!overflowed && value > 0xffffffff )
e18f39b3 4919#endif
7a6cd05b
TC		 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}
e18f39b3 4933#endif
e18f39b3
TC		 4934#endif
4935
7a6cd05b
TC		 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
e18f39b3 4950#endif
02d1d628
AMH		 4951
4952#endif /* _P_P_PORTABILITY_H_ */
e18f39b3
TC		 4953
4954/* End of File ppport.h */
Image manipulation for perl