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