/[VRac]/ppport.h
This is repository of my old source code which isn't updated any more. Go to git.rot13.org for current projects!
ViewVC logotype

Annotation of /ppport.h

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.26