Kstars

ppport.h
1 #if 0
2  <<'SKIP';
3 #endif
4 /*
5 ----------------------------------------------------------------------
6 
7  ppport.h -- Perl/Pollution/Portability Version 3.06_01
8 
9  Automatically created by Devel::PPPort running under
10  perl 5.008008 on Sat May 27 20:29:12 2006.
11 
12  Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
13  includes in parts/inc/ instead.
14 
15  Use 'perldoc ppport.h' to view the documentation below.
16 
17 ----------------------------------------------------------------------
18 
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 ([email protected] 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 ([email protected]) {
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 ([email protected]) {
2102  @files = map { glob "*.$_" } @srcext;
2103  }
2104 }
2105 
2106 if ([email protected] || $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 [email protected] 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  { \
3006  UV TeMpUv = uv; \
3007  if (TeMpUv <= IV_MAX) \
3008  sv_setiv(sv, TeMpUv); \
3009  else \
3010  sv_setnv(sv, (double)TeMpUv); \
3011  } \
3012  STMT_END
3013 #endif
3014 
3015 #ifndef newSVuv
3016 #define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv))
3017 #endif
3018 #ifndef sv_2uv
3019 #define sv_2uv(sv) ((PL_Sv = (sv)), (UV)(SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv)))
3020 #endif
3021 
3022 #ifndef SvUVX
3023 #define SvUVX(sv) ((UV)SvIVX(sv))
3024 #endif
3025 
3026 #ifndef SvUVXx
3027 #define SvUVXx(sv) SvUVX(sv)
3028 #endif
3029 
3030 #ifndef SvUV
3031 #define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
3032 #endif
3033 
3034 #ifndef SvUVx
3035 #define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
3036 #endif
3037 
3038 /* Hint: sv_uv
3039  * Always use the SvUVx() macro instead of sv_uv().
3040  */
3041 #ifndef sv_uv
3042 #define sv_uv(sv) SvUVx(sv)
3043 #endif
3044 #ifndef XST_mUV
3045 #define XST_mUV(i, v) (ST(i) = sv_2mortal(newSVuv(v)))
3046 #endif
3047 
3048 #ifndef XSRETURN_UV
3049 #define XSRETURN_UV(v) \
3050  STMT_START \
3051  { \
3052  XST_mUV(0, v); \
3053  XSRETURN(1); \
3054  } \
3055  STMT_END
3056 #endif
3057 #ifndef PUSHu
3058 #define PUSHu(u) \
3059  STMT_START \
3060  { \
3061  sv_setuv(TARG, (UV)(u)); \
3062  PUSHTARG; \
3063  } \
3064  STMT_END
3065 #endif
3066 
3067 #ifndef XPUSHu
3068 #define XPUSHu(u) \
3069  STMT_START \
3070  { \
3071  sv_setuv(TARG, (UV)(u)); \
3072  XPUSHTARG; \
3073  } \
3074  STMT_END
3075 #endif
3076 
3077 #if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
3078 /* Replace: 1 */
3079 #define PL_DBsingle DBsingle
3080 #define PL_DBsub DBsub
3081 #define PL_Sv Sv
3082 #define PL_compiling compiling
3083 #define PL_copline copline
3084 #define PL_curcop curcop
3085 #define PL_curstash curstash
3086 #define PL_debstash debstash
3087 #define PL_defgv defgv
3088 #define PL_diehook diehook
3089 #define PL_dirty dirty
3090 #define PL_dowarn dowarn
3091 #define PL_errgv errgv
3092 #define PL_hexdigit hexdigit
3093 #define PL_hints hints
3094 #define PL_na na
3095 #define PL_no_modify no_modify
3096 #define PL_perl_destruct_level perl_destruct_level
3097 #define PL_perldb perldb
3098 #define PL_ppaddr ppaddr
3099 #define PL_rsfp_filters rsfp_filters
3100 #define PL_rsfp rsfp
3101 #define PL_stack_base stack_base
3102 #define PL_stack_sp stack_sp
3103 #define PL_stdingv stdingv
3104 #define PL_sv_arenaroot sv_arenaroot
3105 #define PL_sv_no sv_no
3106 #define PL_sv_undef sv_undef
3107 #define PL_sv_yes sv_yes
3108 #define PL_tainted tainted
3109 #define PL_tainting tainting
3110 /* Replace: 0 */
3111 #endif
3112 
3113 #ifndef PERL_UNUSED_DECL
3114 #ifdef HASATTRIBUTE
3115 #if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
3116 #define PERL_UNUSED_DECL
3117 #else
3118 #define PERL_UNUSED_DECL __attribute__((unused))
3119 #endif
3120 #else
3121 #define PERL_UNUSED_DECL
3122 #endif
3123 #endif
3124 #ifndef NOOP
3125 #define NOOP (void)0
3126 #endif
3127 
3128 #ifndef dNOOP
3129 #define dNOOP extern int Perl___notused PERL_UNUSED_DECL
3130 #endif
3131 
3132 #ifndef NVTYPE
3133 #if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
3134 #define NVTYPE long double
3135 #else
3136 #define NVTYPE double
3137 #endif
3138 typedef NVTYPE NV;
3139 #endif
3140 
3141 #ifndef INT2PTR
3142 
3143 #if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
3144 #define PTRV UV
3145 #define INT2PTR(any, d) (any)(d)
3146 #else
3147 #if PTRSIZE == LONGSIZE
3148 #define PTRV unsigned long
3149 #else
3150 #define PTRV unsigned
3151 #endif
3152 #define INT2PTR(any, d) (any)(PTRV)(d)
3153 #endif
3154 
3155 #define NUM2PTR(any, d) (any)(PTRV)(d)
3156 #define PTR2IV(p) INT2PTR(IV, p)
3157 #define PTR2UV(p) INT2PTR(UV, p)
3158 #define PTR2NV(p) NUM2PTR(NV, p)
3159 
3160 #if PTRSIZE == LONGSIZE
3161 #define PTR2ul(p) (unsigned long)(p)
3162 #else
3163 #define PTR2ul(p) INT2PTR(unsigned long, p)
3164 #endif
3165 
3166 #endif /* !INT2PTR */
3167 
3168 #undef START_EXTERN_C
3169 #undef END_EXTERN_C
3170 #undef EXTERN_C
3171 #ifdef __cplusplus
3172 #define START_EXTERN_C extern "C" {
3173 #define END_EXTERN_C }
3174 #define EXTERN_C extern "C"
3175 #else
3176 #define START_EXTERN_C
3177 #define END_EXTERN_C
3178 #define EXTERN_C extern
3179 #endif
3180 
3181 #ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
3182 #if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
3183 #define PERL_GCC_BRACE_GROUPS_FORBIDDEN
3184 #endif
3185 #endif
3186 
3187 #undef STMT_START
3188 #undef STMT_END
3189 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
3190 #define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
3191 #define STMT_END )
3192 #else
3193 #if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
3194 #define STMT_START if (1)
3195 #define STMT_END else(void) 0
3196 #else
3197 #define STMT_START do
3198 #define STMT_END while (0)
3199 #endif
3200 #endif
3201 #ifndef boolSV
3202 #define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
3203 #endif
3204 
3205 /* DEFSV appears first in 5.004_56 */
3206 #ifndef DEFSV
3207 #define DEFSV GvSV(PL_defgv)
3208 #endif
3209 
3210 #ifndef SAVE_DEFSV
3211 #define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
3212 #endif
3213 
3214 /* Older perls (<=5.003) lack AvFILLp */
3215 #ifndef AvFILLp
3216 #define AvFILLp AvFILL
3217 #endif
3218 #ifndef ERRSV
3219 #define ERRSV get_sv("@", FALSE)
3220 #endif
3221 #ifndef newSVpvn
3222 #define newSVpvn(data, len) ((data) ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) : newSV(0))
3223 #endif
3224 
3225 /* Hint: gv_stashpvn
3226  * This function's backport doesn't support the length parameter, but
3227  * rather ignores it. Portability can only be ensured if the length
3228  * parameter is used for speed reasons, but the length can always be
3229  * correctly computed from the string argument.
3230  */
3231 #ifndef gv_stashpvn
3232 #define gv_stashpvn(str, len, create) gv_stashpv(str, create)
3233 #endif
3234 
3235 /* Replace: 1 */
3236 #ifndef get_cv
3237 #define get_cv perl_get_cv
3238 #endif
3239 
3240 #ifndef get_sv
3241 #define get_sv perl_get_sv
3242 #endif
3243 
3244 #ifndef get_av
3245 #define get_av perl_get_av
3246 #endif
3247 
3248 #ifndef get_hv
3249 #define get_hv perl_get_hv
3250 #endif
3251 
3252 /* Replace: 0 */
3253 
3254 #ifdef HAS_MEMCMP
3255 #ifndef memNE
3256 #define memNE(s1, s2, l) (memcmp(s1, s2, l))
3257 #endif
3258 
3259 #ifndef memEQ
3260 #define memEQ(s1, s2, l) (!memcmp(s1, s2, l))
3261 #endif
3262 
3263 #else
3264 #ifndef memNE
3265 #define memNE(s1, s2, l) (bcmp(s1, s2, l))
3266 #endif
3267 
3268 #ifndef memEQ
3269 #define memEQ(s1, s2, l) (!bcmp(s1, s2, l))
3270 #endif
3271 
3272 #endif
3273 #ifndef MoveD
3274 #define MoveD(s, d, n, t) memmove((char *)(d), (char *)(s), (n) * sizeof(t))
3275 #endif
3276 
3277 #ifndef CopyD
3278 #define CopyD(s, d, n, t) memcpy((char *)(d), (char *)(s), (n) * sizeof(t))
3279 #endif
3280 
3281 #ifdef HAS_MEMSET
3282 #ifndef ZeroD
3283 #define ZeroD(d, n, t) memzero((char *)(d), (n) * sizeof(t))
3284 #endif
3285 
3286 #else
3287 #ifndef ZeroD
3288 #define ZeroD(d, n, t) ((void)memzero((char *)(d), (n) * sizeof(t)), d)
3289 #endif
3290 
3291 #endif
3292 #ifndef Poison
3293 #define Poison(d, n, t) (void)memset((char *)(d), 0xAB, (n) * sizeof(t))
3294 #endif
3295 #ifndef dUNDERBAR
3296 #define dUNDERBAR dNOOP
3297 #endif
3298 
3299 #ifndef UNDERBAR
3300 #define UNDERBAR DEFSV
3301 #endif
3302 #ifndef dAX
3303 #define dAX I32 ax = MARK - PL_stack_base + 1
3304 #endif
3305 
3306 #ifndef dITEMS
3307 #define dITEMS I32 items = SP - MARK
3308 #endif
3309 #ifndef dXSTARG
3310 #define dXSTARG SV *targ = sv_newmortal()
3311 #endif
3312 #ifndef dTHR
3313 #define dTHR dNOOP
3314 #endif
3315 #ifndef dTHX
3316 #define dTHX dNOOP
3317 #endif
3318 
3319 #ifndef dTHXa
3320 #define dTHXa(x) dNOOP
3321 #endif
3322 #ifndef pTHX
3323 #define pTHX void
3324 #endif
3325 
3326 #ifndef pTHX_
3327 #define pTHX_
3328 #endif
3329 
3330 #ifndef aTHX
3331 #define aTHX
3332 #endif
3333 
3334 #ifndef aTHX_
3335 #define aTHX_
3336 #endif
3337 #ifndef dTHXoa
3338 #define dTHXoa(x) dTHXa(x)
3339 #endif
3340 #ifndef PUSHmortal
3341 #define PUSHmortal PUSHs(sv_newmortal())
3342 #endif
3343 
3344 #ifndef mPUSHp
3345 #define mPUSHp(p, l) sv_setpvn_mg(PUSHmortal, (p), (l))
3346 #endif
3347 
3348 #ifndef mPUSHn
3349 #define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n))
3350 #endif
3351 
3352 #ifndef mPUSHi
3353 #define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i))
3354 #endif
3355 
3356 #ifndef mPUSHu
3357 #define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u))
3358 #endif
3359 #ifndef XPUSHmortal
3360 #define XPUSHmortal XPUSHs(sv_newmortal())
3361 #endif
3362 
3363 #ifndef mXPUSHp
3364 #define mXPUSHp(p, l) \
3365  STMT_START \
3366  { \
3367  EXTEND(sp, 1); \
3368  sv_setpvn_mg(PUSHmortal, (p), (l)); \
3369  } \
3370  STMT_END
3371 #endif
3372 
3373 #ifndef mXPUSHn
3374 #define mXPUSHn(n) \
3375  STMT_START \
3376  { \
3377  EXTEND(sp, 1); \
3378  sv_setnv_mg(PUSHmortal, (NV)(n)); \
3379  } \
3380  STMT_END
3381 #endif
3382 
3383 #ifndef mXPUSHi
3384 #define mXPUSHi(i) \
3385  STMT_START \
3386  { \
3387  EXTEND(sp, 1); \
3388  sv_setiv_mg(PUSHmortal, (IV)(i)); \
3389  } \
3390  STMT_END
3391 #endif
3392 
3393 #ifndef mXPUSHu
3394 #define mXPUSHu(u) \
3395  STMT_START \
3396  { \
3397  EXTEND(sp, 1); \
3398  sv_setuv_mg(PUSHmortal, (UV)(u)); \
3399  } \
3400  STMT_END
3401 #endif
3402 
3403 /* Replace: 1 */
3404 #ifndef call_sv
3405 #define call_sv perl_call_sv
3406 #endif
3407 
3408 #ifndef call_pv
3409 #define call_pv perl_call_pv
3410 #endif
3411 
3412 #ifndef call_argv
3413 #define call_argv perl_call_argv
3414 #endif
3415 
3416 #ifndef call_method
3417 #define call_method perl_call_method
3418 #endif
3419 #ifndef eval_sv
3420 #define eval_sv perl_eval_sv
3421 #endif
3422 
3423 /* Replace: 0 */
3424 
3425 /* Replace perl_eval_pv with eval_pv */
3426 /* eval_pv depends on eval_sv */
3427 
3428 #ifndef eval_pv
3429 #if defined(NEED_eval_pv)
3430 static SV *DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
3431 static
3432 #else
3433 extern SV *DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
3434 #endif
3435 
3436 #ifdef eval_pv
3437 #undef eval_pv
3438 #endif
3439 #define eval_pv(a, b) DPPP_(my_eval_pv)(aTHX_ a, b)
3440 #define Perl_eval_pv DPPP_(my_eval_pv)
3441 
3442 #if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
3443 
3444  SV *DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
3445 {
3446  dSP;
3447  SV *sv = newSVpv(p, 0);
3448 
3449  PUSHMARK(sp);
3450  eval_sv(sv, G_SCALAR);
3451  SvREFCNT_dec(sv);
3452 
3453  SPAGAIN;
3454  sv = POPs;
3455  PUTBACK;
3456 
3457  if (croak_on_error && SvTRUE(GvSV(errgv)))
3458  croak(SvPVx(GvSV(errgv), na));
3459 
3460  return sv;
3461 }
3462 
3463 #endif
3464 #endif
3465 #ifndef newRV_inc
3466 #define newRV_inc(sv) newRV(sv) /* Replace */
3467 #endif
3468 
3469 #ifndef newRV_noinc
3470 #if defined(NEED_newRV_noinc)
3471 static SV *DPPP_(my_newRV_noinc)(SV *sv);
3472 static
3473 #else
3474 extern SV *DPPP_(my_newRV_noinc)(SV *sv);
3475 #endif
3476 
3477 #ifdef newRV_noinc
3478 #undef newRV_noinc
3479 #endif
3480 #define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
3481 #define Perl_newRV_noinc DPPP_(my_newRV_noinc)
3482 
3483 #if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
3484  SV *DPPP_(my_newRV_noinc)(SV *sv)
3485 {
3486  SV *rv = (SV *)newRV(sv);
3487  SvREFCNT_dec(sv);
3488  return rv;
3489 }
3490 #endif
3491 #endif
3492 
3493 /* Hint: newCONSTSUB
3494  * Returns a CV* as of perl-5.7.1. This return value is not supported
3495  * by Devel::PPPort.
3496  */
3497 
3498 /* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
3499 #if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && \
3500  ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
3501 #if defined(NEED_newCONSTSUB)
3502 static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
3503 static
3504 #else
3505 extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
3506 #endif
3507 
3508 #ifdef newCONSTSUB
3509 #undef newCONSTSUB
3510 #endif
3511 #define newCONSTSUB(a, b, c) DPPP_(my_newCONSTSUB)(aTHX_ a, b, c)
3512 #define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
3513 
3514 #if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
3515 
3516  void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
3517 {
3518  U32 oldhints = PL_hints;
3519  HV *old_cop_stash = PL_curcop->cop_stash;
3520  HV *old_curstash = PL_curstash;
3521  line_t oldline = PL_curcop->cop_line;
3522  PL_curcop->cop_line = PL_copline;
3523 
3524  PL_hints &= ~HINT_BLOCK_SCOPE;
3525  if (stash)
3526  PL_curstash = PL_curcop->cop_stash = stash;
3527 
3528  newSUB(
3529 
3530 #if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22)))
3531  start_subparse(),
3532 #elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22))
3533  start_subparse(0),
3534 #else /* 5.003_23 onwards */
3535  start_subparse(FALSE, 0),
3536 #endif
3537 
3538  newSVOP(OP_CONST, 0, newSVpv(name, 0)), newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
3539  newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv)));
3540 
3541  PL_hints = oldhints;
3542  PL_curcop->cop_stash = old_cop_stash;
3543  PL_curstash = old_curstash;
3544  PL_curcop->cop_line = oldline;
3545 }
3546 #endif
3547 #endif
3548 
3549 /*
3550  * Boilerplate macros for initializing and accessing interpreter-local
3551  * data from C. All statics in extensions should be reworked to use
3552  * this, if you want to make the extension thread-safe. See ext/re/re.xs
3553  * for an example of the use of these macros.
3554  *
3555  * Code that uses these macros is responsible for the following:
3556  * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
3557  * 2. Declare a typedef named my_cxt_t that is a structure that contains
3558  * all the data that needs to be interpreter-local.
3559  * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
3560  * 4. Use the MY_CXT_INIT macro such that it is called exactly once
3561  * (typically put in the BOOT: section).
3562  * 5. Use the members of the my_cxt_t structure everywhere as
3563  * MY_CXT.member.
3564  * 6. Use the dMY_CXT macro (a declaration) in all the functions that
3565  * access MY_CXT.
3566  */
3567 
3568 #if defined(MULTIPLICITY) || defined(PERL_OBJECT) || defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
3569 
3570 #ifndef START_MY_CXT
3571 
3572 /* This must appear in all extensions that define a my_cxt_t structure,
3573  * right after the definition (i.e. at file scope). The non-threads
3574  * case below uses it to declare the data as static. */
3575 #define START_MY_CXT
3576 
3577 #if (PERL_VERSION < 4 || (PERL_VERSION == 4 && PERL_SUBVERSION < 68))
3578 /* Fetches the SV that keeps the per-interpreter data. */
3579 #define dMY_CXT_SV SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
3580 #else /* >= perl5.004_68 */
3581 #define dMY_CXT_SV SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, sizeof(MY_CXT_KEY) - 1, TRUE)
3582 #endif /* < perl5.004_68 */
3583 
3584 /* This declaration should be used within all functions that use the
3585  * interpreter-local data. */
3586 #define dMY_CXT \
3587  dMY_CXT_SV; \
3588  my_cxt_t *my_cxtp = INT2PTR(my_cxt_t *, SvUV(my_cxt_sv))
3589 
3590 /* Creates and zeroes the per-interpreter data.
3591  * (We allocate my_cxtp in a Perl SV so that it will be released when
3592  * the interpreter goes away.) */
3593 #define MY_CXT_INIT \
3594  dMY_CXT_SV; \
3595  /* newSV() allocates one more than needed */ \
3596  my_cxt_t *my_cxtp = (my_cxt_t *)SvPVX(newSV(sizeof(my_cxt_t) - 1)); \
3597  Zero(my_cxtp, 1, my_cxt_t); \
3598  sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
3599 
3600 /* This macro must be used to access members of the my_cxt_t structure.
3601  * e.g. MYCXT.some_data */
3602 #define MY_CXT (*my_cxtp)
3603 
3604 /* Judicious use of these macros can reduce the number of times dMY_CXT
3605  * is used. Use is similar to pTHX, aTHX etc. */
3606 #define pMY_CXT my_cxt_t *my_cxtp
3607 #define pMY_CXT_ pMY_CXT,
3608 #define _pMY_CXT , pMY_CXT
3609 #define aMY_CXT my_cxtp
3610 #define aMY_CXT_ aMY_CXT,
3611 #define _aMY_CXT , aMY_CXT
3612 
3613 #endif /* START_MY_CXT */
3614 
3615 #ifndef MY_CXT_CLONE
3616 /* Clones the per-interpreter data. */
3617 #define MY_CXT_CLONE \
3618  dMY_CXT_SV; \
3619  my_cxt_t *my_cxtp = (my_cxt_t *)SvPVX(newSV(sizeof(my_cxt_t) - 1)); \
3620  Copy(INT2PTR(my_cxt_t *, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t); \
3621  sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
3622 #endif
3623 
3624 #else /* single interpreter */
3625 
3626 #ifndef START_MY_CXT
3627 
3628 #define START_MY_CXT static my_cxt_t my_cxt;
3629 #define dMY_CXT_SV dNOOP
3630 #define dMY_CXT dNOOP
3631 #define MY_CXT_INIT NOOP
3632 #define MY_CXT my_cxt
3633 
3634 #define pMY_CXT void
3635 #define pMY_CXT_
3636 #define _pMY_CXT
3637 #define aMY_CXT
3638 #define aMY_CXT_
3639 #define _aMY_CXT
3640 
3641 #endif /* START_MY_CXT */
3642 
3643 #ifndef MY_CXT_CLONE
3644 #define MY_CXT_CLONE NOOP
3645 #endif
3646 
3647 #endif
3648 
3649 #ifndef IVdf
3650 #if IVSIZE == LONGSIZE
3651 #define IVdf "ld"
3652 #define UVuf "lu"
3653 #define UVof "lo"
3654 #define UVxf "lx"
3655 #define UVXf "lX"
3656 #else
3657 #if IVSIZE == INTSIZE
3658 #define IVdf "d"
3659 #define UVuf "u"
3660 #define UVof "o"
3661 #define UVxf "x"
3662 #define UVXf "X"
3663 #endif
3664 #endif
3665 #endif
3666 
3667 #ifndef NVef
3668 #if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \
3669  defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */
3670 #define NVef PERL_PRIeldbl
3671 #define NVff PERL_PRIfldbl
3672 #define NVgf PERL_PRIgldbl
3673 #else
3674 #define NVef "e"
3675 #define NVff "f"
3676 #define NVgf "g"
3677 #endif
3678 #endif
3679 
3680 #ifndef SvPV_nolen
3681 
3682 #if defined(NEED_sv_2pv_nolen)
3683 static char *DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
3684 static
3685 #else
3686 extern char *DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
3687 #endif
3688 
3689 #ifdef sv_2pv_nolen
3690 #undef sv_2pv_nolen
3691 #endif
3692 #define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a)
3693 #define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
3694 
3695 #if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
3696 
3697  char *DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv)
3698 {
3699  STRLEN n_a;
3700  return sv_2pv(sv, &n_a);
3701 }
3702 
3703 #endif
3704 
3705 /* Hint: sv_2pv_nolen
3706  * Use the SvPV_nolen() macro instead of sv_2pv_nolen().
3707  */
3708 
3709 /* SvPV_nolen depends on sv_2pv_nolen */
3710 #define SvPV_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK ? SvPVX(sv) : sv_2pv_nolen(sv))
3711 
3712 #endif
3713 
3714 #ifdef SvPVbyte
3715 
3716 /* Hint: SvPVbyte
3717  * Does not work in perl-5.6.1, ppport.h implements a version
3718  * borrowed from perl-5.7.3.
3719  */
3720 
3721 #if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
3722 
3723 #if defined(NEED_sv_2pvbyte)
3724 static char *DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
3725 static
3726 #else
3727 extern char *DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
3728 #endif
3729 
3730 #ifdef sv_2pvbyte
3731 #undef sv_2pvbyte
3732 #endif
3733 #define sv_2pvbyte(a, b) DPPP_(my_sv_2pvbyte)(aTHX_ a, b)
3734 #define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
3735 
3736 #if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
3737 
3738  char *DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
3739 {
3740  sv_utf8_downgrade(sv, 0);
3741  return SvPV(sv, *lp);
3742 }
3743 
3744 #endif
3745 
3746 /* Hint: sv_2pvbyte
3747  * Use the SvPVbyte() macro instead of sv_2pvbyte().
3748  */
3749 
3750 #undef SvPVbyte
3751 
3752 /* SvPVbyte depends on sv_2pvbyte */
3753 #define SvPVbyte(sv, lp) \
3754  ((SvFLAGS(sv) & (SVf_POK | SVf_UTF8)) == (SVf_POK) ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
3755 
3756 #endif
3757 
3758 #else
3759 
3760 #define SvPVbyte SvPV
3761 #define sv_2pvbyte sv_2pv
3762 
3763 #endif
3764 
3765 /* sv_2pvbyte_nolen depends on sv_2pv_nolen */
3766 #ifndef sv_2pvbyte_nolen
3767 #define sv_2pvbyte_nolen sv_2pv_nolen
3768 #endif
3769 
3770 /* Hint: sv_pvn
3771  * Always use the SvPV() macro instead of sv_pvn().
3772  */
3773 #ifndef sv_pvn
3774 #define sv_pvn(sv, len) SvPV(sv, len)
3775 #endif
3776 
3777 /* Hint: sv_pvn_force
3778  * Always use the SvPV_force() macro instead of sv_pvn_force().
3779  */
3780 #ifndef sv_pvn_force
3781 #define sv_pvn_force(sv, len) SvPV_force(sv, len)
3782 #endif
3783 
3784 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf)
3785 #if defined(NEED_vnewSVpvf)
3786 static SV *DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
3787 static
3788 #else
3789 extern SV *DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
3790 #endif
3791 
3792 #ifdef vnewSVpvf
3793 #undef vnewSVpvf
3794 #endif
3795 #define vnewSVpvf(a, b) DPPP_(my_vnewSVpvf)(aTHX_ a, b)
3796 #define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
3797 
3798 #if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
3799 
3800  SV *DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
3801 {
3802  register SV *sv = newSV(0);
3803  sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *));
3804  return sv;
3805 }
3806 
3807 #endif
3808 #endif
3809 
3810 /* sv_vcatpvf depends on sv_vcatpvfn */
3811 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf)
3812 #define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *))
3813 #endif
3814 
3815 /* sv_vsetpvf depends on sv_vsetpvfn */
3816 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf)
3817 #define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *))
3818 #endif
3819 
3820 /* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
3821 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg)
3822 #if defined(NEED_sv_catpvf_mg)
3823 static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
3824 static
3825 #else
3826 extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
3827 #endif
3828 
3829 #define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
3830 
3831 #if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
3832 
3833  void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
3834 {
3835  va_list args;
3836  va_start(args, pat);
3837  sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *));
3838  SvSETMAGIC(sv);
3839  va_end(args);
3840 }
3841 
3842 #endif
3843 #endif
3844 
3845 /* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
3846 #ifdef PERL_IMPLICIT_CONTEXT
3847 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext)
3848 #if defined(NEED_sv_catpvf_mg_nocontext)
3849 static void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
3850 static
3851 #else
3852 extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
3853 #endif
3854 
3855 #define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
3856 #define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
3857 
3858 #if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
3859 
3860  void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
3861 {
3862  dTHX;
3863  va_list args;
3864  va_start(args, pat);
3865  sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *));
3866  SvSETMAGIC(sv);
3867  va_end(args);
3868 }
3869 
3870 #endif
3871 #endif
3872 #endif
3873 
3874 #ifndef sv_catpvf_mg
3875 #ifdef PERL_IMPLICIT_CONTEXT
3876 #define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
3877 #else
3878 #define sv_catpvf_mg Perl_sv_catpvf_mg
3879 #endif
3880 #endif
3881 
3882 /* sv_vcatpvf_mg depends on sv_vcatpvfn */
3883 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg)
3884 #define sv_vcatpvf_mg(sv, pat, args) \
3885  STMT_START \
3886  { \
3887  sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)); \
3888  SvSETMAGIC(sv); \
3889  } \
3890  STMT_END
3891 #endif
3892 
3893 /* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
3894 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg)
3895 #if defined(NEED_sv_setpvf_mg)
3896 static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
3897 static
3898 #else
3899 extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
3900 #endif
3901 
3902 #define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
3903 
3904 #if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
3905 
3906  void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
3907 {
3908  va_list args;
3909  va_start(args, pat);
3910  sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *));
3911  SvSETMAGIC(sv);
3912  va_end(args);
3913 }
3914 
3915 #endif
3916 #endif
3917 
3918 /* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
3919 #ifdef PERL_IMPLICIT_CONTEXT
3920 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext)
3921 #if defined(NEED_sv_setpvf_mg_nocontext)
3922 static void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
3923 static
3924 #else
3925 extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
3926 #endif
3927 
3928 #define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
3929 #define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
3930 
3931 #if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
3932 
3933  void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
3934 {
3935  dTHX;
3936  va_list args;
3937  va_start(args, pat);
3938  sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV **), 0, Null(bool *));
3939  SvSETMAGIC(sv);
3940  va_end(args);
3941 }
3942 
3943 #endif
3944 #endif
3945 #endif
3946 
3947 #ifndef sv_setpvf_mg
3948 #ifdef PERL_IMPLICIT_CONTEXT
3949 #define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
3950 #else
3951 #define sv_setpvf_mg Perl_sv_setpvf_mg
3952 #endif
3953 #endif
3954 
3955 /* sv_vsetpvf_mg depends on sv_vsetpvfn */
3956 #if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg)
3957 #define sv_vsetpvf_mg(sv, pat, args) \
3958  STMT_START \
3959  { \
3960  sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV **), 0, Null(bool *)); \
3961  SvSETMAGIC(sv); \
3962  } \
3963  STMT_END
3964 #endif
3965 #ifndef SvGETMAGIC
3966 #define SvGETMAGIC(x) \
3967  STMT_START \
3968  { \
3969  if (SvGMAGICAL(x)) \
3970  mg_get(x); \
3971  } \
3972  STMT_END
3973 #endif
3974 #ifndef PERL_MAGIC_sv
3975 #define PERL_MAGIC_sv '\0'
3976 #endif
3977 
3978 #ifndef PERL_MAGIC_overload
3979 #define PERL_MAGIC_overload 'A'
3980 #endif
3981 
3982 #ifndef PERL_MAGIC_overload_elem
3983 #define PERL_MAGIC_overload_elem 'a'
3984 #endif
3985 
3986 #ifndef PERL_MAGIC_overload_table
3987 #define PERL_MAGIC_overload_table 'c'
3988 #endif
3989 
3990 #ifndef PERL_MAGIC_bm
3991 #define PERL_MAGIC_bm 'B'
3992 #endif
3993 
3994 #ifndef PERL_MAGIC_regdata
3995 #define PERL_MAGIC_regdata 'D'
3996 #endif
3997 
3998 #ifndef PERL_MAGIC_regdatum
3999 #define PERL_MAGIC_regdatum 'd'
4000 #endif
4001 
4002 #ifndef PERL_MAGIC_env
4003 #define PERL_MAGIC_env 'E'
4004 #endif
4005 
4006 #ifndef PERL_MAGIC_envelem
4007 #define PERL_MAGIC_envelem 'e'
4008 #endif
4009 
4010 #ifndef PERL_MAGIC_fm
4011 #define PERL_MAGIC_fm 'f'
4012 #endif
4013 
4014 #ifndef PERL_MAGIC_regex_global
4015 #define PERL_MAGIC_regex_global 'g'
4016 #endif
4017 
4018 #ifndef PERL_MAGIC_isa
4019 #define PERL_MAGIC_isa 'I'
4020 #endif
4021 
4022 #ifndef PERL_MAGIC_isaelem
4023 #define PERL_MAGIC_isaelem 'i'
4024 #endif
4025 
4026 #ifndef PERL_MAGIC_nkeys
4027 #define PERL_MAGIC_nkeys 'k'
4028 #endif
4029 
4030 #ifndef PERL_MAGIC_dbfile
4031 #define PERL_MAGIC_dbfile 'L'
4032 #endif
4033 
4034 #ifndef PERL_MAGIC_dbline
4035 #define PERL_MAGIC_dbline 'l'
4036 #endif
4037 
4038 #ifndef PERL_MAGIC_mutex
4039 #define PERL_MAGIC_mutex 'm'
4040 #endif
4041 
4042 #ifndef PERL_MAGIC_shared
4043 #define PERL_MAGIC_shared 'N'
4044 #endif
4045 
4046 #ifndef PERL_MAGIC_shared_scalar
4047 #define PERL_MAGIC_shared_scalar 'n'
4048 #endif
4049 
4050 #ifndef PERL_MAGIC_collxfrm
4051 #define PERL_MAGIC_collxfrm 'o'
4052 #endif
4053 
4054 #ifndef PERL_MAGIC_tied
4055 #define PERL_MAGIC_tied 'P'
4056 #endif
4057 
4058 #ifndef PERL_MAGIC_tiedelem
4059 #define PERL_MAGIC_tiedelem 'p'
4060 #endif
4061 
4062 #ifndef PERL_MAGIC_tiedscalar
4063 #define PERL_MAGIC_tiedscalar 'q'
4064 #endif
4065 
4066 #ifndef PERL_MAGIC_qr
4067 #define PERL_MAGIC_qr 'r'
4068 #endif
4069 
4070 #ifndef PERL_MAGIC_sig
4071 #define PERL_MAGIC_sig 'S'
4072 #endif
4073 
4074 #ifndef PERL_MAGIC_sigelem
4075 #define PERL_MAGIC_sigelem 's'
4076 #endif
4077 
4078 #ifndef PERL_MAGIC_taint
4079 #define PERL_MAGIC_taint 't'
4080 #endif
4081 
4082 #ifndef PERL_MAGIC_uvar
4083 #define PERL_MAGIC_uvar 'U'
4084 #endif
4085 
4086 #ifndef PERL_MAGIC_uvar_elem
4087 #define PERL_MAGIC_uvar_elem 'u'
4088 #endif
4089 
4090 #ifndef PERL_MAGIC_vstring
4091 #define PERL_MAGIC_vstring 'V'
4092 #endif
4093 
4094 #ifndef PERL_MAGIC_vec
4095 #define PERL_MAGIC_vec 'v'
4096 #endif
4097 
4098 #ifndef PERL_MAGIC_utf8
4099 #define PERL_MAGIC_utf8 'w'
4100 #endif
4101 
4102 #ifndef PERL_MAGIC_substr
4103 #define PERL_MAGIC_substr 'x'
4104 #endif
4105 
4106 #ifndef PERL_MAGIC_defelem
4107 #define PERL_MAGIC_defelem 'y'
4108 #endif
4109 
4110 #ifndef PERL_MAGIC_glob
4111 #define PERL_MAGIC_glob '*'
4112 #endif
4113 
4114 #ifndef PERL_MAGIC_arylen
4115 #define PERL_MAGIC_arylen '#'
4116 #endif
4117 
4118 #ifndef PERL_MAGIC_pos
4119 #define PERL_MAGIC_pos '.'
4120 #endif
4121 
4122 #ifndef PERL_MAGIC_backref
4123 #define PERL_MAGIC_backref '<'
4124 #endif
4125 
4126 #ifndef PERL_MAGIC_ext
4127 #define PERL_MAGIC_ext '~'
4128 #endif
4129 
4130 /* That's the best we can do... */
4131 #ifndef SvPV_force_nomg
4132 #define SvPV_force_nomg SvPV_force
4133 #endif
4134 
4135 #ifndef SvPV_nomg
4136 #define SvPV_nomg SvPV
4137 #endif
4138 
4139 #ifndef sv_catpvn_nomg
4140 #define sv_catpvn_nomg sv_catpvn
4141 #endif
4142 
4143 #ifndef sv_catsv_nomg
4144 #define sv_catsv_nomg sv_catsv
4145 #endif
4146 
4147 #ifndef sv_setsv_nomg
4148 #define sv_setsv_nomg sv_setsv
4149 #endif
4150 
4151 #ifndef sv_pvn_nomg
4152 #define sv_pvn_nomg sv_pvn
4153 #endif
4154 
4155 #ifndef SvIV_nomg
4156 #define SvIV_nomg SvIV
4157 #endif
4158 
4159 #ifndef SvUV_nomg
4160 #define SvUV_nomg SvUV
4161 #endif
4162 
4163 #ifndef sv_catpv_mg
4164 #define sv_catpv_mg(sv, ptr) \
4165  STMT_START \
4166  { \
4167  SV *TeMpSv = sv; \
4168  sv_catpv(TeMpSv, ptr); \
4169  SvSETMAGIC(TeMpSv); \
4170  } \
4171  STMT_END
4172 #endif
4173 
4174 #ifndef sv_catpvn_mg
4175 #define sv_catpvn_mg(sv, ptr, len) \
4176  STMT_START \
4177  { \
4178  SV *TeMpSv = sv; \
4179  sv_catpvn(TeMpSv, ptr, len); \
4180  SvSETMAGIC(TeMpSv); \
4181  } \
4182  STMT_END
4183 #endif
4184 
4185 #ifndef sv_catsv_mg
4186 #define sv_catsv_mg(dsv, ssv) \
4187  STMT_START \
4188  { \
4189  SV *TeMpSv = dsv; \
4190  sv_catsv(TeMpSv, ssv); \
4191  SvSETMAGIC(TeMpSv); \
4192  } \
4193  STMT_END
4194 #endif
4195 
4196 #ifndef sv_setiv_mg
4197 #define sv_setiv_mg(sv, i) \
4198  STMT_START \
4199  { \
4200  SV *TeMpSv = sv; \
4201  sv_setiv(TeMpSv, i); \
4202  SvSETMAGIC(TeMpSv); \
4203  } \
4204  STMT_END
4205 #endif
4206 
4207 #ifndef sv_setnv_mg
4208 #define sv_setnv_mg(sv, num) \
4209  STMT_START \
4210  { \
4211  SV *TeMpSv = sv; \
4212  sv_setnv(TeMpSv, num); \
4213  SvSETMAGIC(TeMpSv); \
4214  } \
4215  STMT_END
4216 #endif
4217 
4218 #ifndef sv_setpv_mg
4219 #define sv_setpv_mg(sv, ptr) \
4220  STMT_START \
4221  { \
4222  SV *TeMpSv = sv; \
4223  sv_setpv(TeMpSv, ptr); \
4224  SvSETMAGIC(TeMpSv); \
4225  } \
4226  STMT_END
4227 #endif
4228 
4229 #ifndef sv_setpvn_mg
4230 #define sv_setpvn_mg(sv, ptr, len) \
4231  STMT_START \
4232  { \
4233  SV *TeMpSv = sv; \
4234  sv_setpvn(TeMpSv, ptr, len); \
4235  SvSETMAGIC(TeMpSv); \
4236  } \
4237  STMT_END
4238 #endif
4239 
4240 #ifndef sv_setsv_mg
4241 #define sv_setsv_mg(dsv, ssv) \
4242  STMT_START \
4243  { \
4244  SV *TeMpSv = dsv; \
4245  sv_setsv(TeMpSv, ssv); \
4246  SvSETMAGIC(TeMpSv); \
4247  } \
4248  STMT_END
4249 #endif
4250 
4251 #ifndef sv_setuv_mg
4252 #define sv_setuv_mg(sv, i) \
4253  STMT_START \
4254  { \
4255  SV *TeMpSv = sv; \
4256  sv_setuv(TeMpSv, i); \
4257  SvSETMAGIC(TeMpSv); \
4258  } \
4259  STMT_END
4260 #endif
4261 
4262 #ifndef sv_usepvn_mg
4263 #define sv_usepvn_mg(sv, ptr, len) \
4264  STMT_START \
4265  { \
4266  SV *TeMpSv = sv; \
4267  sv_usepvn(TeMpSv, ptr, len); \
4268  SvSETMAGIC(TeMpSv); \
4269  } \
4270  STMT_END
4271 #endif
4272 
4273 #ifdef USE_ITHREADS
4274 #ifndef CopFILE
4275 #define CopFILE(c) ((c)->cop_file)
4276 #endif
4277 
4278 #ifndef CopFILEGV
4279 #define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv)
4280 #endif
4281 
4282 #ifndef CopFILE_set
4283 #define CopFILE_set(c, pv) ((c)->cop_file = savepv(pv))
4284 #endif
4285 
4286 #ifndef CopFILESV
4287 #define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv)
4288 #endif
4289 
4290 #ifndef CopFILEAV
4291 #define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav)
4292 #endif
4293 
4294 #ifndef CopSTASHPV
4295 #define CopSTASHPV(c) ((c)->cop_stashpv)
4296 #endif
4297 
4298 #ifndef CopSTASHPV_set
4299 #define CopSTASHPV_set(c, pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch))
4300 #endif
4301 
4302 #ifndef CopSTASH
4303 #define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c), GV_ADD) : Nullhv)
4304 #endif
4305 
4306 #ifndef CopSTASH_set
4307 #define CopSTASH_set(c, hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch)
4308 #endif
4309 
4310 #ifndef CopSTASH_eq
4311 #define CopSTASH_eq(c, hv) \
4312  ((hv) && (CopSTASHPV(c) == HvNAME(hv) || (CopSTASHPV(c) && HvNAME(hv) && strEQ(CopSTASHPV(c), HvNAME(hv)))))
4313 #endif
4314 
4315 #else
4316 #ifndef CopFILEGV
4317 #define CopFILEGV(c) ((c)->cop_filegv)
4318 #endif
4319 
4320 #ifndef CopFILEGV_set
4321 #define CopFILEGV_set(c, gv) ((c)->cop_filegv = (GV *)SvREFCNT_inc(gv))
4322 #endif
4323 
4324 #ifndef CopFILE_set
4325 #define CopFILE_set(c, pv) CopFILEGV_set((c), gv_fetchfile(pv))
4326 #endif
4327 
4328 #ifndef CopFILESV
4329 #define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv)
4330 #endif
4331 
4332 #ifndef CopFILEAV
4333 #define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav)
4334 #endif
4335 
4336 #ifndef CopFILE
4337 #define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch)
4338 #endif
4339 
4340 #ifndef CopSTASH
4341 #define CopSTASH(c) ((c)->cop_stash)
4342 #endif
4343 
4344 #ifndef CopSTASH_set
4345 #define CopSTASH_set(c, hv) ((c)->cop_stash = (hv))
4346 #endif
4347 
4348 #ifndef CopSTASHPV
4349 #define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch)
4350 #endif
4351 
4352 #ifndef CopSTASHPV_set
4353 #define CopSTASHPV_set(c, pv) CopSTASH_set((c), gv_stashpv(pv, GV_ADD))
4354 #endif
4355 
4356 #ifndef CopSTASH_eq
4357 #define CopSTASH_eq(c, hv) (CopSTASH(c) == (hv))
4358 #endif
4359 
4360 #endif /* USE_ITHREADS */
4361 #ifndef IN_PERL_COMPILETIME
4362 #define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling)
4363 #endif
4364 
4365 #ifndef IN_LOCALE_RUNTIME
4366 #define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE)
4367 #endif
4368 
4369 #ifndef IN_LOCALE_COMPILETIME
4370 #define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE)
4371 #endif
4372 
4373 #ifndef IN_LOCALE
4374 #define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME)
4375 #endif
4376 #ifndef IS_NUMBER_IN_UV
4377 #define IS_NUMBER_IN_UV 0x01
4378 #endif
4379 
4380 #ifndef IS_NUMBER_GREATER_THAN_UV_MAX
4381 #define IS_NUMBER_GREATER_THAN_UV_MAX 0x02
4382 #endif
4383 
4384 #ifndef IS_NUMBER_NOT_INT
4385 #define IS_NUMBER_NOT_INT 0x04
4386 #endif
4387 
4388 #ifndef IS_NUMBER_NEG
4389 #define IS_NUMBER_NEG 0x08
4390 #endif
4391 
4392 #ifndef IS_NUMBER_INFINITY
4393 #define IS_NUMBER_INFINITY 0x10
4394 #endif
4395 
4396 #ifndef IS_NUMBER_NAN
4397 #define IS_NUMBER_NAN 0x20
4398 #endif
4399 
4400 /* GROK_NUMERIC_RADIX depends on grok_numeric_radix */
4401 #ifndef GROK_NUMERIC_RADIX
4402 #define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
4403 #endif
4404 #ifndef PERL_SCAN_GREATER_THAN_UV_MAX
4405 #define PERL_SCAN_GREATER_THAN_UV_MAX 0x02
4406 #endif
4407 
4408 #ifndef PERL_SCAN_SILENT_ILLDIGIT
4409 #define PERL_SCAN_SILENT_ILLDIGIT 0x04
4410 #endif
4411 
4412 #ifndef PERL_SCAN_ALLOW_UNDERSCORES
4413 #define PERL_SCAN_ALLOW_UNDERSCORES 0x01
4414 #endif
4415 
4416 #ifndef PERL_SCAN_DISALLOW_PREFIX
4417 #define PERL_SCAN_DISALLOW_PREFIX 0x02
4418 #endif
4419 
4420 #ifndef grok_numeric_radix
4421 #if defined(NEED_grok_numeric_radix)
4422 static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send);
4423 static
4424 #else
4425 extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send);
4426 #endif
4427 
4428 #ifdef grok_numeric_radix
4429 #undef grok_numeric_radix
4430 #endif
4431 #define grok_numeric_radix(a, b) DPPP_(my_grok_numeric_radix)(aTHX_ a, b)
4432 #define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
4433 
4434 #if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
4435  bool DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
4436 {
4437 #ifdef USE_LOCALE_NUMERIC
4438 #ifdef PL_numeric_radix_sv
4439  if (PL_numeric_radix_sv && IN_LOCALE)
4440  {
4441  STRLEN len;
4442  char *radix = SvPV(PL_numeric_radix_sv, len);
4443  if (*sp + len <= send && memEQ(*sp, radix, len))
4444  {
4445  *sp += len;
4446  return TRUE;
4447  }
4448  }
4449 #else
4450 /* older perls don't have PL_numeric_radix_sv so the radix
4451  * must manually be requested from locale.h
4452  */
4453 #include <locale.h>
4454  dTHR; /* needed for older threaded perls */
4455  struct lconv *lc = localeconv();
4456  char *radix = lc->decimal_point;
4457  if (radix && IN_LOCALE)
4458  {
4459  STRLEN len = strlen(radix);
4460  if (*sp + len <= send && memEQ(*sp, radix, len))
4461  {
4462  *sp += len;
4463  return TRUE;
4464  }
4465  }
4466 #endif /* PERL_VERSION */
4467 #endif /* USE_LOCALE_NUMERIC */
4468  /* always try "." if numeric radix didn't match because
4469  * we may have data from different locales mixed */
4470  if (*sp < send && **sp == '.')
4471  {
4472  ++*sp;
4473  return TRUE;
4474  }
4475  return FALSE;
4476 }
4477 #endif
4478 #endif
4479 
4480 /* grok_number depends on grok_numeric_radix */
4481 
4482 #ifndef grok_number
4483 #if defined(NEED_grok_number)
4484 static int DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep);
4485 static
4486 #else
4487 extern int DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep);
4488 #endif
4489 
4490 #ifdef grok_number
4491 #undef grok_number
4492 #endif
4493 #define grok_number(a, b, c) DPPP_(my_grok_number)(aTHX_ a, b, c)
4494 #define Perl_grok_number DPPP_(my_grok_number)
4495 
4496 #if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
4497  int DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
4498 {
4499  const char *s = pv;
4500  const char *send = pv + len;
4501  const UV max_div_10 = UV_MAX / 10;
4502  const char max_mod_10 = UV_MAX % 10;
4503  int numtype = 0;
4504  int sawinf = 0;
4505  int sawnan = 0;
4506 
4507  while (s < send && isSPACE(*s))
4508  s++;
4509  if (s == send)
4510  {
4511  return 0;
4512  }
4513  else if (*s == '-')
4514  {
4515  s++;
4516  numtype = IS_NUMBER_NEG;
4517  }
4518  else if (*s == '+')
4519  s++;
4520 
4521  if (s == send)
4522  return 0;
4523 
4524  /* next must be digit or the radix separator or beginning of infinity */
4525  if (isDIGIT(*s))
4526  {
4527  /* UVs are at least 32 bits, so the first 9 decimal digits cannot
4528  overflow. */
4529  UV value = *s - '0';
4530  /* This construction seems to be more optimiser friendly.
4531  (without it gcc does the isDIGIT test and the *s - '0' separately)
4532  With it gcc on arm is managing 6 instructions (6 cycles) per digit.
4533  In theory the optimiser could deduce how far to unroll the loop
4534  before checking for overflow. */
4535  if (++s < send)
4536  {
4537  int digit = *s - '0';
4538  if (digit >= 0 && digit <= 9)
4539  {
4540  value = value * 10 + digit;
4541  if (++s < send)
4542  {
4543  digit = *s - '0';
4544  if (digit >= 0 && digit <= 9)
4545  {
4546  value = value * 10 + digit;
4547  if (++s < send)
4548  {
4549  digit = *s - '0';
4550  if (digit >= 0 && digit <= 9)
4551  {
4552  value = value * 10 + digit;
4553  if (++s < send)
4554  {
4555  digit = *s - '0';
4556  if (digit >= 0 && digit <= 9)
4557  {
4558  value = value * 10 + digit;
4559  if (++s < send)
4560  {
4561  digit = *s - '0';
4562  if (digit >= 0 && digit <= 9)
4563  {
4564  value = value * 10 + digit;
4565  if (++s < send)
4566  {
4567  digit = *s - '0';
4568  if (digit >= 0 && digit <= 9)
4569  {
4570  value = value * 10 + digit;
4571  if (++s < send)
4572  {
4573  digit = *s - '0';
4574  if (digit >= 0 && digit <= 9)
4575  {
4576  value = value * 10 + digit;
4577  if (++s < send)
4578  {
4579  digit = *s - '0';
4580  if (digit >= 0 && digit <= 9)
4581  {
4582  value = value * 10 + digit;
4583  if (++s < send)
4584  {
4585  /* Now got 9 digits, so need to check
4586  each time for overflow. */
4587  digit = *s - '0';
4588  while (digit >= 0 && digit <= 9 &&
4589  (value < max_div_10 ||
4590  (value == max_div_10 &&
4591  digit <= max_mod_10)))
4592  {
4593  value = value * 10 + digit;
4594  if (++s < send)
4595  digit = *s - '0';
4596  else
4597  break;
4598  }
4599  if (digit >= 0 && digit <= 9 && (s < send))
4600  {
4601  /* value overflowed.
4602  skip the remaining digits, don't
4603  worry about setting *valuep. */
4604  do
4605  {
4606  s++;
4607  } while (s < send && isDIGIT(*s));
4608  numtype |=
4609  IS_NUMBER_GREATER_THAN_UV_MAX;
4610  goto skip_value;
4611  }
4612  }
4613  }
4614  }
4615  }
4616  }
4617  }
4618  }
4619  }
4620  }
4621  }
4622  }
4623  }
4624  }
4625  }
4626  }
4627  }
4628  }
4629  numtype |= IS_NUMBER_IN_UV;
4630  if (valuep)
4631  *valuep = value;
4632 
4633  skip_value:
4634  if (GROK_NUMERIC_RADIX(&s, send))
4635  {
4636  numtype |= IS_NUMBER_NOT_INT;
4637  while (s < send && isDIGIT(*s)) /* optional digits after the radix */
4638  s++;
4639  }
4640  }
4641  else if (GROK_NUMERIC_RADIX(&s, send))
4642  {
4643  numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */
4644  /* no digits before the radix means we need digits after it */
4645  if (s < send && isDIGIT(*s))
4646  {
4647  do
4648  {
4649  s++;
4650  } while (s < send && isDIGIT(*s));
4651  if (valuep)
4652  {
4653  /* integer approximation is valid - it's 0. */
4654  *valuep = 0;
4655  }
4656  }
4657  else
4658  return 0;
4659  }
4660  else if (*s == 'I' || *s == 'i')
4661  {
4662  s++;
4663  if (s == send || (*s != 'N' && *s != 'n'))
4664  return 0;
4665  s++;
4666  if (s == send || (*s != 'F' && *s != 'f'))
4667  return 0;
4668  s++;
4669  if (s < send && (*s == 'I' || *s == 'i'))
4670  {
4671  s++;
4672  if (s == send || (*s != 'N' && *s != 'n'))
4673  return 0;
4674  s++;
4675  if (s == send || (*s != 'I' && *s != 'i'))
4676  return 0;
4677  s++;
4678  if (s == send || (*s != 'T' && *s != 't'))
4679  return 0;
4680  s++;
4681  if (s == send || (*s != 'Y' && *s != 'y'))
4682  return 0;
4683  s++;
4684  }
4685  sawinf = 1;
4686  }
4687  else if (*s == 'N' || *s == 'n')
4688  {
4689  /* XXX TODO: There are signaling NaNs and quiet NaNs. */
4690  s++;
4691  if (s == send || (*s != 'A' && *s != 'a'))
4692  return 0;
4693  s++;
4694  if (s == send || (*s != 'N' && *s != 'n'))
4695  return 0;
4696  s++;
4697  sawnan = 1;
4698  }
4699  else
4700  return 0;
4701 
4702  if (sawinf)
4703  {
4704  numtype &= IS_NUMBER_NEG; /* Keep track of sign */
4705  numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT;
4706  }
4707  else if (sawnan)
4708  {
4709  numtype &= IS_NUMBER_NEG; /* Keep track of sign */
4710  numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
4711  }
4712  else if (s < send)
4713  {
4714  /* we can have an optional exponent part */
4715  if (*s == 'e' || *s == 'E')
4716  {
4717  /* The only flag we keep is sign. Blow away any "it's UV" */
4718  numtype &= IS_NUMBER_NEG;
4719  numtype |= IS_NUMBER_NOT_INT;
4720  s++;
4721  if (s < send && (*s == '-' || *s == '+'))
4722  s++;
4723  if (s < send && isDIGIT(*s))
4724  {
4725  do
4726  {
4727  s++;
4728  } while (s < send && isDIGIT(*s));
4729  }
4730  else
4731  return 0;
4732  }
4733  }
4734  while (s < send && isSPACE(*s))
4735  s++;
4736  if (s >= send)
4737  return numtype;
4738  if (len == 10 && memEQ(pv, "0 but true", 10))
4739  {
4740  if (valuep)
4741  *valuep = 0;
4742  return IS_NUMBER_IN_UV;
4743  }
4744  return 0;
4745 }
4746 #endif
4747 #endif
4748 
4749 /*
4750  * The grok_* routines have been modified to use warn() instead of
4751  * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit,
4752  * which is why the stack variable has been renamed to 'xdigit'.
4753  */
4754 
4755 #ifndef grok_bin
4756 #if defined(NEED_grok_bin)
4757 static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4758 static
4759 #else
4760 extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4761 #endif
4762 
4763 #ifdef grok_bin
4764 #undef grok_bin
4765 #endif
4766 #define grok_bin(a, b, c, d) DPPP_(my_grok_bin)(aTHX_ a, b, c, d)
4767 #define Perl_grok_bin DPPP_(my_grok_bin)
4768 
4769 #if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
4770  UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4771 {
4772  const char *s = start;
4773  STRLEN len = *len_p;
4774  UV value = 0;
4775  NV value_nv = 0;
4776 
4777  const UV max_div_2 = UV_MAX / 2;
4778  bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4779  bool overflowed = FALSE;
4780 
4781  if (!(*flags & PERL_SCAN_DISALLOW_PREFIX))
4782  {
4783  /* strip off leading b or 0b.
4784  for compatibility silently suffer "b" and "0b" as valid binary
4785  numbers. */
4786  if (len >= 1)
4787  {
4788  if (s[0] == 'b')
4789  {
4790  s++;
4791  len--;
4792  }
4793  else if (len >= 2 && s[0] == '0' && s[1] == 'b')
4794  {
4795  s += 2;
4796  len -= 2;
4797  }
4798  }
4799  }
4800 
4801  for (; len-- && *s; s++)
4802  {
4803  char bit = *s;
4804  if (bit == '0' || bit == '1')
4805  {
4806  /* Write it in this wonky order with a goto to attempt to get the
4807  compiler to make the common case integer-only loop pretty tight.
4808  With gcc seems to be much straighter code than old scan_bin. */
4809  redo:
4810  if (!overflowed)
4811  {
4812  if (value <= max_div_2)
4813  {
4814  value = (value << 1) | (bit - '0');
4815  continue;
4816  }
4817  /* Bah. We're just overflowed. */
4818  warn("Integer overflow in binary number");
4819  overflowed = TRUE;
4820  value_nv = (NV)value;
4821  }
4822  value_nv *= 2.0;
4823  /* If an NV has not enough bits in its mantissa to
4824  * represent a UV this summing of small low-order numbers
4825  * is a waste of time (because the NV cannot preserve
4826  * the low-order bits anyway): we could just remember when
4827  * did we overflow and in the end just multiply value_nv by the
4828  * right amount. */
4829  value_nv += (NV)(bit - '0');
4830  continue;
4831  }
4832  if (bit == '_' && len && allow_underscores && (bit = s[1]) && (bit == '0' || bit == '1'))
4833  {
4834  --len;
4835  ++s;
4836  goto redo;
4837  }
4838  if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4839  warn("Illegal binary digit '%c' ignored", *s);
4840  break;
4841  }
4842 
4843  if ((overflowed && value_nv > 4294967295.0)
4844 #if UVSIZE > 4
4845  || (!overflowed && value > 0xffffffff)
4846 #endif
4847  )
4848  {
4849  warn("Binary number > 0b11111111111111111111111111111111 non-portable");
4850  }
4851  *len_p = s - start;
4852  if (!overflowed)
4853  {
4854  *flags = 0;
4855  return value;
4856  }
4857  *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4858  if (result)
4859  *result = value_nv;
4860  return UV_MAX;
4861 }
4862 #endif
4863 #endif
4864 
4865 #ifndef grok_hex
4866 #if defined(NEED_grok_hex)
4867 static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4868 static
4869 #else
4870 extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4871 #endif
4872 
4873 #ifdef grok_hex
4874 #undef grok_hex
4875 #endif
4876 #define grok_hex(a, b, c, d) DPPP_(my_grok_hex)(aTHX_ a, b, c, d)
4877 #define Perl_grok_hex DPPP_(my_grok_hex)
4878 
4879 #if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
4880  UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4881 {
4882  const char *s = start;
4883  STRLEN len = *len_p;
4884  UV value = 0;
4885  NV value_nv = 0;
4886 
4887  const UV max_div_16 = UV_MAX / 16;
4888  bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4889  bool overflowed = FALSE;
4890  const char *xdigit;
4891 
4892  if (!(*flags & PERL_SCAN_DISALLOW_PREFIX))
4893  {
4894  /* strip off leading x or 0x.
4895  for compatibility silently suffer "x" and "0x" as valid hex numbers.
4896  */
4897  if (len >= 1)
4898  {
4899  if (s[0] == 'x')
4900  {
4901  s++;
4902  len--;
4903  }
4904  else if (len >= 2 && s[0] == '0' && s[1] == 'x')
4905  {
4906  s += 2;
4907  len -= 2;
4908  }
4909  }
4910  }
4911 
4912  for (; len-- && *s; s++)
4913  {
4914  xdigit = strchr((char *)PL_hexdigit, *s);
4915  if (xdigit)
4916  {
4917  /* Write it in this wonky order with a goto to attempt to get the
4918  compiler to make the common case integer-only loop pretty tight.
4919  With gcc seems to be much straighter code than old scan_hex. */
4920  redo:
4921  if (!overflowed)
4922  {
4923  if (value <= max_div_16)
4924  {
4925  value = (value << 4) | ((xdigit - PL_hexdigit) & 15);
4926  continue;
4927  }
4928  warn("Integer overflow in hexadecimal number");
4929  overflowed = TRUE;
4930  value_nv = (NV)value;
4931  }
4932  value_nv *= 16.0;
4933  /* If an NV has not enough bits in its mantissa to
4934  * represent a UV this summing of small low-order numbers
4935  * is a waste of time (because the NV cannot preserve
4936  * the low-order bits anyway): we could just remember when
4937  * did we overflow and in the end just multiply value_nv by the
4938  * right amount of 16-tuples. */
4939  value_nv += (NV)((xdigit - PL_hexdigit) & 15);
4940  continue;
4941  }
4942  if (*s == '_' && len && allow_underscores && s[1] && (xdigit = strchr((char *)PL_hexdigit, s[1])))
4943  {
4944  --len;
4945  ++s;
4946  goto redo;
4947  }
4948  if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
4949  warn("Illegal hexadecimal digit '%c' ignored", *s);
4950  break;
4951  }
4952 
4953  if ((overflowed && value_nv > 4294967295.0)
4954 #if UVSIZE > 4
4955  || (!overflowed && value > 0xffffffff)
4956 #endif
4957  )
4958  {
4959  warn("Hexadecimal number > 0xffffffff non-portable");
4960  }
4961  *len_p = s - start;
4962  if (!overflowed)
4963  {
4964  *flags = 0;
4965  return value;
4966  }
4967  *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
4968  if (result)
4969  *result = value_nv;
4970  return UV_MAX;
4971 }
4972 #endif
4973 #endif
4974 
4975 #ifndef grok_oct
4976 #if defined(NEED_grok_oct)
4977 static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4978 static
4979 #else
4980 extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
4981 #endif
4982 
4983 #ifdef grok_oct
4984 #undef grok_oct
4985 #endif
4986 #define grok_oct(a, b, c, d) DPPP_(my_grok_oct)(aTHX_ a, b, c, d)
4987 #define Perl_grok_oct DPPP_(my_grok_oct)
4988 
4989 #if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
4990  UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
4991 {
4992  const char *s = start;
4993  STRLEN len = *len_p;
4994  UV value = 0;
4995  NV value_nv = 0;
4996 
4997  const UV max_div_8 = UV_MAX / 8;
4998  bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES;
4999  bool overflowed = FALSE;
5000 
5001  for (; len-- && *s; s++)
5002  {
5003  /* gcc 2.95 optimiser not smart enough to figure that this subtraction
5004  out front allows slicker code. */
5005  int digit = *s - '0';
5006  if (digit >= 0 && digit <= 7)
5007  {
5008  /* Write it in this wonky order with a goto to attempt to get the
5009  compiler to make the common case integer-only loop pretty tight.
5010  */
5011  redo:
5012  if (!overflowed)
5013  {
5014  if (value <= max_div_8)
5015  {
5016  value = (value << 3) | digit;
5017  continue;
5018  }
5019  /* Bah. We're just overflowed. */
5020  warn("Integer overflow in octal number");
5021  overflowed = TRUE;
5022  value_nv = (NV)value;
5023  }
5024  value_nv *= 8.0;
5025  /* If an NV has not enough bits in its mantissa to
5026  * represent a UV this summing of small low-order numbers
5027  * is a waste of time (because the NV cannot preserve
5028  * the low-order bits anyway): we could just remember when
5029  * did we overflow and in the end just multiply value_nv by the
5030  * right amount of 8-tuples. */
5031  value_nv += (NV)digit;
5032  continue;
5033  }
5034  if (digit == ('_' - '0') && len && allow_underscores && (digit = s[1] - '0') && (digit >= 0 && digit <= 7))
5035  {
5036  --len;
5037  ++s;
5038  goto redo;
5039  }
5040  /* Allow \octal to work the DWIM way (that is, stop scanning
5041  * as soon as non-octal characters are seen, complain only iff
5042  * someone seems to want to use the digits eight and nine). */
5043  if (digit == 8 || digit == 9)
5044  {
5045  if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT))
5046  warn("Illegal octal digit '%c' ignored", *s);
5047  }
5048  break;
5049  }
5050 
5051  if ((overflowed && value_nv > 4294967295.0)
5052 #if UVSIZE > 4
5053  || (!overflowed && value > 0xffffffff)
5054 #endif
5055  )
5056  {
5057  warn("Octal number > 037777777777 non-portable");
5058  }
5059  *len_p = s - start;
5060  if (!overflowed)
5061  {
5062  *flags = 0;
5063  return value;
5064  }
5065  *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
5066  if (result)
5067  *result = value_nv;
5068  return UV_MAX;
5069 }
5070 #endif
5071 #endif
5072 
5073 #ifdef NO_XSLOCKS
5074 #ifdef dJMPENV
5075 #define dXCPT \
5076  dJMPENV; \
5077  int rEtV = 0
5078 #define XCPT_TRY_START \
5079  JMPENV_PUSH(rEtV); \
5080  if (rEtV == 0)
5081 #define XCPT_TRY_END JMPENV_POP;
5082 #define XCPT_CATCH if (rEtV != 0)
5083 #define XCPT_RETHROW JMPENV_JUMP(rEtV)
5084 #else
5085 #define dXCPT \
5086  Sigjmp_buf oldTOP; \
5087  int rEtV = 0
5088 #define XCPT_TRY_START \
5089  Copy(top_env, oldTOP, 1, Sigjmp_buf); \
5090  rEtV = Sigsetjmp(top_env, 1); \
5091  if (rEtV == 0)
5092 #define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
5093 #define XCPT_CATCH if (rEtV != 0)
5094 #define XCPT_RETHROW Siglongjmp(top_env, rEtV)
5095 #endif
5096 #endif
5097 
5098 #endif /* _P_P_PORTABILITY_H_ */
5099 
5100 /* End of File ppport.h */
QString name(StandardShortcut id)
const QList< QKeySequence > & redo()
This file is part of the KDE documentation.
Documentation copyright © 1996-2022 The KDE developers.
Generated on Mon Aug 15 2022 04:04:03 by doxygen 1.8.17 written by Dimitri van Heesch, © 1997-2006

KDE's Doxygen guidelines are available online.