#
################################################################################
#
-# $Revision: 28 $
+# $Revision: 33 $
# $Author: mhx $
-# $Date: 2004/08/13 12:49:22 +0200 $
+# $Date: 2005/01/31 08:10:55 +0100 $
#
################################################################################
#
-# Version 3.x, Copyright (C) 2004, Marcus Holland-Moritz.
+# Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
# Version 2.x, Copyright (C) 2001, Paul Marquess.
# Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
#
notes, and can even make suggestions on how to change your code. You
can run it like any other Perl program:
- perl ppport.h
+ perl ppport.h [options] [files]
It also has embedded documentation, so you can use
dTHXa
dTHXoa
dUNDERBAR
+ dXCPT
+ dXSTARG
+ END_EXTERN_C
ERRSV
eval_pv
eval_sv
+ EXTERN_C
get_av
get_cv
get_hv
mXPUSHp
mXPUSHu
MY_CXT
+ MY_CXT_CLONE
MY_CXT_INIT
newCONSTSUB
newRV_inc
NVgf
NVTYPE
PERL_BCDVERSION
+ PERL_GCC_BRACE_GROUPS_FORBIDDEN
PERL_INT_MAX
PERL_INT_MIN
PERL_LONG_MAX
PL_copline
PL_curcop
PL_curstash
+ PL_DBsingle
+ PL_DBsub
+ PL_debstash
PL_defgv
+ PL_diehook
PL_dirty
PL_dowarn
+ PL_errgv
PL_hexdigit
PL_hints
PL_na
+ PL_no_modify
+ PL_perl_destruct_level
PL_perldb
+ PL_ppaddr
PL_rsfp
PL_rsfp_filters
PL_stack_base
+ PL_stack_sp
PL_stdingv
PL_Sv
+ PL_sv_arenaroot
PL_sv_no
PL_sv_undef
PL_sv_yes
+ PL_tainted
+ PL_tainting
pMY_CXT
pMY_CXT_
Poison
PTR2UV
PTRV
PUSHmortal
+ PUSHu
SAVE_DEFSV
+ START_EXTERN_C
START_MY_CXT
+ STMT_END
+ STMT_START
sv_2pv_nolen
sv_2pvbyte
sv_2uv
sv_catpv_mg
+ sv_catpvf_mg
+ sv_catpvf_mg_nocontext
sv_catpvn_mg
sv_catpvn_nomg
sv_catsv_mg
sv_setiv_mg
sv_setnv_mg
sv_setpv_mg
+ sv_setpvf_mg
+ sv_setpvf_mg_nocontext
sv_setpvn_mg
sv_setsv_mg
sv_setsv_nomg
sv_setuv_mg
sv_usepvn_mg
sv_uv
+ sv_vcatpvf
+ sv_vcatpvf_mg
+ sv_vsetpvf
+ sv_vsetpvf_mg
SvGETMAGIC
SvIV_nomg
SvPV_force_nomg
UVuf
UVXf
UVxf
+ vnewSVpvf
+ XCPT_CATCH
+ XCPT_RETHROW
+ XCPT_TRY_END
+ XCPT_TRY_START
XPUSHmortal
+ XPUSHu
XSRETURN_UV
XST_mUV
ZeroD
SvPVbyte_force
find_rundefsvoffset
+ gv_fetchpvn_flags
+ gv_fetchsv
+ op_refcnt_lock
+ op_refcnt_unlock
+ savesvpv
vnormal
=item perl 5.9.1
sv_utf8_decode
sv_utf8_downgrade
sv_utf8_encode
- sv_vcatpvf
- sv_vcatpvf_mg
- sv_vsetpvf
- sv_vsetpvf_mg
swash_init
tmps_grow
to_uni_lower_lc
vform
vload_module
vmess
- vnewSVpvf
vwarn
vwarner
warner
do_binmode
save_aelem
save_helem
- sv_catpvf_mg
- sv_setpvf_mg
=item perl 5.004_04
HeSVKEY_force
HeSVKEY_set
HeVAL
- PUSHu
SvSetMagicSV
SvSetMagicSV_nosteal
SvSetSV_nosteal
SvTAINTED
SvTAINTED_off
SvTAINTED_on
- XPUSHu
block_gimme
call_list
cv_const_sv
save_gp
start_subparse
sv_catpvf
+ sv_catpvf_mg
sv_cmp_locale
sv_derived_from
sv_gets
sv_setpvf
+ sv_setpvf_mg
sv_taint
sv_tainted
sv_untaint
+ sv_vcatpvf
+ sv_vcatpvf_mg
sv_vcatpvfn
+ sv_vsetpvf
+ sv_vsetpvf_mg
sv_vsetpvfn
unsharepvn
+ vnewSVpvf
=back
=head1 COPYRIGHT
-Version 3.x, Copyright (C) 2004, Marcus Holland-Moritz.
+Version 3.x, Copyright (C) 2004-2005, Marcus Holland-Moritz.
Version 2.x, Copyright (C) 2001, Paul Marquess.
use strict;
use vars qw($VERSION @ISA $data);
-$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.00 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
+$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.06 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' };
@ISA = qw(DynaLoader);
POD
POD --list-provided list provided API
POD --list-unsupported list unsupported API
+POD --api-info=name show Perl API portability information
POD
POD =head1 COMPATIBILITY
POD
POD F<ppport.h> and below which version of Perl they probably
POD won't be available or work.
POD
+POD =head2 --api-info=I<name>
+POD
+POD Show portability information for API elements matching I<name>.
+POD If I<name> is surrounded by slashes, it is interpreted as a regular
+POD expression.
+POD
POD =head1 DESCRIPTION
POD
POD In order for a Perl extension (XS) module to be as portable as possible
POD Note that you mustn't have more than one global request for one
POD function in your project.
POD
-POD Function Static Request Global Request
-POD -----------------------------------------------------------------------------
-POD eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
-POD grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
-POD grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
-POD grok_number() NEED_grok_number NEED_grok_number_GLOBAL
-POD grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
-POD grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
-POD newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
-POD newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
-POD sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL
-POD sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
+POD Function Static Request Global Request
+POD -----------------------------------------------------------------------------------------
+POD eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
+POD grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
+POD grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
+POD grok_number() NEED_grok_number NEED_grok_number_GLOBAL
+POD grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_GLOBAL
+POD grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
+POD newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL
+POD newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL
+POD sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL
+POD sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL
+POD sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL
+POD sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL
+POD sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL
+POD sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
+POD vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
POD
POD To avoid namespace conflicts, you can change the namespace of the
POD explicitly exported functions using the C<DPPP_NAMESPACE> macro.
POD
POD This would output context diffs with 10 lines of context.
POD
+POD To display portability information for the C<newSVpvn> function,
+POD use:
+POD
+POD perl ppport.h --api-info=newSVpvn
+POD
+POD Since the argument to C<--api-info> can be a regular expression,
+POD you can use
+POD
+POD perl ppport.h --api-info=/_nomg$/
+POD
+POD to display portability information for all C<_nomg> functions or
+POD
+POD perl ppport.h --api-info=/./
+POD
+POD to display information for all known API elements.
+POD
POD =head1 BUGS
POD
POD If this version of F<ppport.h> is causing failure during
POD
POD =head1 COPYRIGHT
POD
-POD Version 3.x, Copyright (c) 2004, Marcus Holland-Moritz.
+POD Version 3.x, Copyright (c) 2004-2005, Marcus Holland-Moritz.
POD
POD Version 2.x, Copyright (C) 2001, Paul Marquess.
POD
Getopt::Long::GetOptions(\%opt, qw(
help quiet diag! hints! changes! cplusplus
patch=s copy=s diff=s compat-version=s
- list-provided list-unsupported
+ list-provided list-unsupported api-info=s
)) or usage();
};
CvSTASH|||
CvWEAKOUTSIDE|||
DEFSV|5.004050||p
+END_EXTERN_C|5.005000||p
ENTER|||
ERRSV|5.004050||p
EXTEND|||
+EXTERN_C|5.005000||p
FREETMPS|||
GIMME_V||5.004000|n
GIMME|||n
LEAVE|||
LVRET|||
MARK|||
+MY_CXT_CLONE|5.009002||p
MY_CXT_INIT|5.007003||p
MY_CXT|5.007003||p
MoveD|5.009002||p
PAD_SVl|||
PAD_SV|||
PERL_BCDVERSION|5.009002||p
+PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
PERL_INT_MAX|5.004000||p
PERL_INT_MIN|5.004000||p
PERL_LONG_MAX|5.004000||p
PERL_USHORT_MAX|5.004000||p
PERL_USHORT_MIN|5.004000||p
PERL_VERSION|5.006000||p
-PL_DBsingle|||n
-PL_DBsub|||n
+PL_DBsingle|||pn
+PL_DBsub|||pn
PL_DBtrace|||n
PL_Sv|5.005000||p
PL_compiling|5.004050||p
PL_copline|5.005000||p
PL_curcop|5.004050||p
PL_curstash|5.004050||p
+PL_debstash|5.004050||p
PL_defgv|5.004050||p
+PL_diehook|5.004050||p
PL_dirty|5.004050||p
PL_dowarn|||pn
+PL_errgv|5.004050||p
PL_hexdigit|5.005000||p
PL_hints|5.005000||p
PL_last_in_gv|||n
PL_modglobal||5.005000|n
PL_na|5.004050||pn
+PL_no_modify|5.006000||p
PL_ofs_sv|||n
+PL_perl_destruct_level|5.004050||p
PL_perldb|5.004050||p
+PL_ppaddr|5.006000||p
PL_rsfp_filters|5.004050||p
PL_rsfp|5.004050||p
PL_rs|||n
-PL_stack_base|||p
+PL_stack_base|5.004050||p
+PL_stack_sp|5.004050||p
PL_stdingv|5.004050||p
+PL_sv_arenaroot|5.004050||p
PL_sv_no|5.004050||pn
PL_sv_undef|5.004050||pn
PL_sv_yes|5.004050||pn
+PL_tainted|5.004050||p
+PL_tainting|5.004050||p
POPi|||n
POPl|||n
POPn|||n
PUSHn|||
PUSHp|||
PUSHs|||
-PUSHu||5.004000|
+PUSHu|5.004000||p
PUTBACK|||
PerlIO_clearerr||5.007003|
PerlIO_close||5.007003|
SAVE_DEFSV|5.004050||p
SPAGAIN|||
SP|||
+START_EXTERN_C|5.005000||p
START_MY_CXT|5.007003||p
+STMT_END|||p
+STMT_START|||p
ST|||
SVt_IV|||
SVt_NV|||
UVof|5.006000||p
UVuf|5.006000||p
UVxf|5.006000||p
+XCPT_CATCH|5.009002||p
+XCPT_RETHROW|5.009002||p
+XCPT_TRY_END|5.009002||p
+XCPT_TRY_START|5.009002||p
XPUSHi|||
XPUSHmortal|5.009002||p
XPUSHn|||
XPUSHp|||
XPUSHs|||
-XPUSHu||5.004000|
+XPUSHu|5.004000||p
XSRETURN_EMPTY|||
XSRETURN_IV|||
XSRETURN_NO|||
dTHXoa|5.006000||p
dTHX|5.006000||p
dUNDERBAR|5.009002||p
+dXCPT|5.009002||p
dXSARGS|||
dXSI32|||
+dXSTARG|5.006000||p
deb_curcv|||
deb_nocontext|||vn
deb_stack_all|||
debstackptrs||5.007003|
debstack||5.007003|
deb||5.007003|v
-default_protect|||v
del_he|||
del_sv|||
del_xiv|||
gv_fetchmethod_autoload||5.004000|
gv_fetchmethod|||
gv_fetchmeth|||
+gv_fetchpvn_flags||5.009002|
gv_fetchpv|||
+gv_fetchsv||5.009002|
gv_fullname3||5.004000|
gv_fullname4||5.006001|
gv_fullname|||
isSPACE|||
isUPPER|||
is_an_int|||
+is_gv_magical_sv|||
is_gv_magical|||
is_handle_constructor|||
is_lvalue_sub||5.007001|
op_dump||5.006000|
op_free|||
op_null||5.007002|
+op_refcnt_lock||5.009002|
+op_refcnt_unlock||5.009002|
open_script|||
pMY_CXT_|5.007003||p
pMY_CXT|5.007003||p
savesharedpv||5.007003|
savestack_grow_cnt||5.008001|
savestack_grow|||
+savesvpv||5.009002|
sawparens|||
scalar_mod_type|||
scalarboolean|||
sv_bless|||
sv_cat_decode||5.008001|
sv_catpv_mg|5.006000||p
-sv_catpvf_mg_nocontext|||vn
-sv_catpvf_mg||5.004050|v
+sv_catpvf_mg_nocontext|||pvn
+sv_catpvf_mg|5.006000|5.004000|pv
sv_catpvf_nocontext|||vn
sv_catpvf||5.004000|v
sv_catpvn_flags||5.007002|
sv_setnv_mg|5.006000||p
sv_setnv|||
sv_setpv_mg|5.006000||p
-sv_setpvf_mg_nocontext|||vn
-sv_setpvf_mg||5.004050|v
+sv_setpvf_mg_nocontext|||pvn
+sv_setpvf_mg|5.006000|5.004000|pv
sv_setpvf_nocontext|||vn
sv_setpvf||5.004000|v
sv_setpviv_mg||5.008001|
sv_utf8_upgrade_flags||5.007002|
sv_utf8_upgrade||5.007001|
sv_uv|5.006000||p
-sv_vcatpvf_mg||5.006000|
+sv_vcatpvf_mg|5.006000|5.004000|p
sv_vcatpvfn||5.004000|
-sv_vcatpvf||5.006000|
-sv_vsetpvf_mg||5.006000|
+sv_vcatpvf|5.006000|5.004000|p
+sv_vsetpvf_mg|5.006000|5.004000|p
sv_vsetpvfn||5.004000|
-sv_vsetpvf||5.006000|
+sv_vsetpvf|5.006000|5.004000|p
svtype|||
swallow_bom|||
swash_fetch||5.007002|
uvuni_to_utf8_flags||5.007003|
uvuni_to_utf8||5.007001|
validate_suid|||
-vcall_body|||
-vcall_list_body|||
vcmp||5.009000|
vcroak||5.006000|
vdeb||5.007003|
-vdefault_protect|||
vdie|||
-vdocatch_body|||
vform||5.006000|
visit|||
vivify_defelem|||
vivify_ref|||
vload_module||5.006000|
vmess||5.006000|
-vnewSVpvf||5.006000|
+vnewSVpvf|5.006000|5.004000|p
vnormal||5.009002|
vnumify||5.009000|
-vparse_body|||
-vrun_body|||
vstringify||5.009000|
vwarner||5.006000|
vwarn||5.006000|
$need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)};
}
+if (exists $opt{'api-info'}) {
+ my $f;
+ my $count = 0;
+ my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$";
+ for $f (sort { lc $a cmp lc $b } keys %API) {
+ next unless $f =~ /$match/;
+ print "\n=== $f ===\n\n";
+ my $info = 0;
+ if ($API{$f}{base} || $API{$f}{todo}) {
+ my $base = format_version($API{$f}{base} || $API{$f}{todo});
+ print "Supported at least starting from perl-$base.\n";
+ $info++;
+ }
+ if ($API{$f}{provided}) {
+ my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003";
+ print "Support by $ppport provided back to perl-$todo.\n";
+ print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f};
+ print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f};
+ print "$hints{$f}" if exists $hints{$f};
+ $info++;
+ }
+ unless ($info) {
+ print "No portability information available.\n";
+ }
+ $count++;
+ }
+ if ($count > 0) {
+ print "\n";
+ }
+ else {
+ print "Found no API matching '$opt{'api-info'}'.\n";
+ }
+ exit 0;
+}
+
if (exists $opt{'list-provided'}) {
my $f;
for $f (sort { lc $a cmp lc $b } keys %API) {
if (exists $API{$func}{provided}) {
if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) {
$file{uses}{$func}++;
- push @{$global{uses}{$func}}, $filename;
my @deps = rec_depend($func);
if (@deps) {
$file{uses_deps}{$func} = \@deps;
for (@deps) {
$file{uses}{$_} = 0 unless exists $file{uses}{$_};
- push @{$global{uses}{$_}}, $filename;
}
}
for ($func, @deps) {
if (exists $need{$_}) {
$file{needs}{$_} = 'static';
- push @{$global{needs}{$_}}, $filename;
}
}
}
if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) {
if ($c =~ /\b$func\b/) {
$file{uses_todo}{$func}++;
- push @{$global{uses_todo}{$func}}, $filename;
}
}
}
while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) {
if (exists $need{$2}) {
$file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++;
- push @{$global{defined $3 ? 'needed_global' : 'needed_static'}{$2}}, $filename;
}
else {
warning("Possibly wrong #define $1 in $filename");
}
}
+ for (qw(uses needs uses_todo needed_global needed_static)) {
+ for $func (keys %{$file{$_}}) {
+ push @{$global{$_}{$func}}, $filename;
+ }
+ }
+
$files{$filename} = \%file;
}
sub rec_depend
{
my $func = shift;
+ my %seen;
return () unless exists $depends{$func};
- map { ($_, rec_depend($_)) } @{$depends{$func}};
+ grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}};
}
sub parse_version
#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name)
#ifndef PERL_REVISION
-# ifndef __PATCHLEVEL_H_INCLUDED__
+# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION))
# define PERL_PATCHLEVEL_H_IMPLICIT
# include <patchlevel.h>
# endif
#ifndef XSRETURN_UV
# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END
#endif
+#ifndef PUSHu
+# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END
+#endif
+
+#ifndef XPUSHu
+# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END
+#endif
#if (PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))
/* Replace: 1 */
-# define PL_Sv Sv
-# define PL_compiling compiling
-# define PL_copline copline
-# define PL_curcop curcop
-# define PL_curstash curstash
-# define PL_defgv defgv
-# define PL_dirty dirty
-# define PL_dowarn dowarn
-# define PL_hints hints
-# define PL_na na
-# define PL_perldb perldb
-# define PL_rsfp_filters rsfp_filters
-# define PL_rsfp rsfp
-# define PL_stdingv stdingv
-# define PL_sv_no sv_no
-# define PL_sv_undef sv_undef
-# define PL_sv_yes sv_yes
-# define PL_hexdigit hexdigit
+# define PL_DBsingle DBsingle
+# define PL_DBsub DBsub
+# define PL_Sv Sv
+# define PL_compiling compiling
+# define PL_copline copline
+# define PL_curcop curcop
+# define PL_curstash curstash
+# define PL_debstash debstash
+# define PL_defgv defgv
+# define PL_diehook diehook
+# define PL_dirty dirty
+# define PL_dowarn dowarn
+# define PL_errgv errgv
+# define PL_hexdigit hexdigit
+# define PL_hints hints
+# define PL_na na
+# define PL_no_modify no_modify
+# define PL_perl_destruct_level perl_destruct_level
+# define PL_perldb perldb
+# define PL_ppaddr ppaddr
+# define PL_rsfp_filters rsfp_filters
+# define PL_rsfp rsfp
+# define PL_stack_base stack_base
+# define PL_stack_sp stack_sp
+# define PL_stdingv stdingv
+# define PL_sv_arenaroot sv_arenaroot
+# define PL_sv_no sv_no
+# define PL_sv_undef sv_undef
+# define PL_sv_yes sv_yes
+# define PL_tainted tainted
+# define PL_tainting tainting
/* Replace: 0 */
#endif
-#ifdef HASATTRIBUTE
-# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
-# define PERL_UNUSED_DECL
+#ifndef PERL_UNUSED_DECL
+# ifdef HASATTRIBUTE
+# if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER)
+# define PERL_UNUSED_DECL
+# else
+# define PERL_UNUSED_DECL __attribute__((unused))
+# endif
# else
-# define PERL_UNUSED_DECL __attribute__((unused))
+# define PERL_UNUSED_DECL
# endif
-#else
-# define PERL_UNUSED_DECL
#endif
#ifndef NOOP
# define NOOP (void)0
# endif
#endif /* !INT2PTR */
+
+#undef START_EXTERN_C
+#undef END_EXTERN_C
+#undef EXTERN_C
+#ifdef __cplusplus
+# define START_EXTERN_C extern "C" {
+# define END_EXTERN_C }
+# define EXTERN_C extern "C"
+#else
+# define START_EXTERN_C
+# define END_EXTERN_C
+# define EXTERN_C extern
+#endif
+
+#ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# if defined(__STRICT_ANSI__) && defined(PERL_GCC_PEDANTIC)
+# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# endif
+#endif
+
+#undef STMT_START
+#undef STMT_END
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
+# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
+# define STMT_END )
+#else
+# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__)
+# define STMT_START if (1)
+# define STMT_END else (void)0
+# else
+# define STMT_START do
+# define STMT_END while (0)
+# endif
+#endif
#ifndef boolSV
# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
#endif
#ifndef dITEMS
# define dITEMS I32 items = SP - MARK
#endif
+#ifndef dXSTARG
+# define dXSTARG SV * targ = sv_newmortal()
+#endif
#ifndef dTHR
# define dTHR dNOOP
#endif
#ifndef eval_pv
#if defined(NEED_eval_pv)
-static SV* DPPP_(eval_pv)(char *p, I32 croak_on_error);
+static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
static
#else
-extern SV* DPPP_(eval_pv)(char *p, I32 croak_on_error);
+extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
#endif
#ifdef eval_pv
# undef eval_pv
#endif
-#define eval_pv(a,b) DPPP_(eval_pv)(aTHX_ a,b)
-#define Perl_eval_pv DPPP_(eval_pv)
+#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
+#define Perl_eval_pv DPPP_(my_eval_pv)
#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
SV*
-DPPP_(eval_pv)(char *p, I32 croak_on_error)
+DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
{
dSP;
SV* sv = newSVpv(p, 0);
#ifndef newRV_noinc
#if defined(NEED_newRV_noinc)
-static SV * DPPP_(newRV_noinc)(SV *sv);
+static SV * DPPP_(my_newRV_noinc)(SV *sv);
static
#else
-extern SV * DPPP_(newRV_noinc)(SV *sv);
+extern SV * DPPP_(my_newRV_noinc)(SV *sv);
#endif
#ifdef newRV_noinc
# undef newRV_noinc
#endif
-#define newRV_noinc(a) DPPP_(newRV_noinc)(aTHX_ a)
-#define Perl_newRV_noinc DPPP_(newRV_noinc)
+#define newRV_noinc(a) DPPP_(my_newRV_noinc)(aTHX_ a)
+#define Perl_newRV_noinc DPPP_(my_newRV_noinc)
#if defined(NEED_newRV_noinc) || defined(NEED_newRV_noinc_GLOBAL)
SV *
-DPPP_(newRV_noinc)(SV *sv)
+DPPP_(my_newRV_noinc)(SV *sv)
{
SV *rv = (SV *)newRV(sv);
SvREFCNT_dec(sv);
/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
#if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5))
#if defined(NEED_newCONSTSUB)
-static void DPPP_(newCONSTSUB)(HV *stash, char *name, SV *sv);
+static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
static
#else
-extern void DPPP_(newCONSTSUB)(HV *stash, char *name, SV *sv);
+extern void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv);
#endif
#ifdef newCONSTSUB
# undef newCONSTSUB
#endif
-#define newCONSTSUB(a,b,c) DPPP_(newCONSTSUB)(aTHX_ a,b,c)
-#define Perl_newCONSTSUB DPPP_(newCONSTSUB)
+#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
+#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
void
-DPPP_(newCONSTSUB)(HV *stash, char *name, SV *sv)
+DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv)
{
U32 oldhints = PL_hints;
HV *old_cop_stash = PL_curcop->cop_stash;
#endif
#endif
-#ifndef START_MY_CXT
-
/*
* Boilerplate macros for initializing and accessing interpreter-local
* data from C. All statics in extensions should be reworked to use
#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
+#ifndef START_MY_CXT
+
/* This must appear in all extensions that define a my_cxt_t structure,
* right after the definition (i.e. at file scope). The non-threads
* case below uses it to declare the data as static. */
#define aMY_CXT_ aMY_CXT,
#define _aMY_CXT ,aMY_CXT
+#endif /* START_MY_CXT */
+
+#ifndef MY_CXT_CLONE
+/* Clones the per-interpreter data. */
+#define MY_CXT_CLONE \
+ dMY_CXT_SV; \
+ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+ Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
+ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+#endif
+
#else /* single interpreter */
+#ifndef START_MY_CXT
+
#define START_MY_CXT static my_cxt_t my_cxt;
#define dMY_CXT_SV dNOOP
#define dMY_CXT dNOOP
#define aMY_CXT_
#define _aMY_CXT
-#endif
-
#endif /* START_MY_CXT */
+#ifndef MY_CXT_CLONE
+#define MY_CXT_CLONE NOOP
+#endif
+
+#endif
+
#ifndef IVdf
# if IVSIZE == LONGSIZE
# define IVdf "ld"
#ifndef SvPV_nolen
#if defined(NEED_sv_2pv_nolen)
-static char * DPPP_(sv_2pv_nolen)(pTHX_ register SV *sv);
+static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
static
#else
-extern char * DPPP_(sv_2pv_nolen)(pTHX_ register SV *sv);
+extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv);
#endif
#ifdef sv_2pv_nolen
# undef sv_2pv_nolen
#endif
-#define sv_2pv_nolen(a) DPPP_(sv_2pv_nolen)(aTHX_ a)
-#define Perl_sv_2pv_nolen DPPP_(sv_2pv_nolen)
+#define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a)
+#define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen)
#if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL)
char *
-DPPP_(sv_2pv_nolen)(pTHX_ register SV *sv)
+DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv)
{
STRLEN n_a;
return sv_2pv(sv, &n_a);
#if ((PERL_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0)))
#if defined(NEED_sv_2pvbyte)
-static char * DPPP_(sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
+static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
static
#else
-extern char * DPPP_(sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
+extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp);
#endif
#ifdef sv_2pvbyte
# undef sv_2pvbyte
#endif
-#define sv_2pvbyte(a,b) DPPP_(sv_2pvbyte)(aTHX_ a,b)
-#define Perl_sv_2pvbyte DPPP_(sv_2pvbyte)
+#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
+#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
char *
-DPPP_(sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
+DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp)
{
sv_utf8_downgrade(sv,0);
return SvPV(sv,*lp);
# define sv_pvn(sv, len) SvPV(sv, len)
#endif
-/* Hint: sv_pvn
+/* Hint: sv_pvn_force
* Always use the SvPV_force() macro instead of sv_pvn_force().
*/
#ifndef sv_pvn_force
# define sv_pvn_force(sv, len) SvPV_force(sv, len)
#endif
+
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf)
+#if defined(NEED_vnewSVpvf)
+static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
+static
+#else
+extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args);
+#endif
+
+#ifdef vnewSVpvf
+# undef vnewSVpvf
+#endif
+#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
+#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
+
+#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
+
+SV *
+DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
+{
+ register SV *sv = newSV(0);
+ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
+ return sv;
+}
+
+#endif
+#endif
+
+/* sv_vcatpvf depends on sv_vcatpvfn */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf)
+# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+/* sv_vsetpvf depends on sv_vsetpvfn */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf)
+# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+#endif
+
+/* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg)
+#if defined(NEED_sv_catpvf_mg)
+static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
+static
+#else
+extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
+#endif
+
+#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
+
+#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
+
+void
+DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+
+/* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */
+#ifdef PERL_IMPLICIT_CONTEXT
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext)
+#if defined(NEED_sv_catpvf_mg_nocontext)
+static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
+static
+#else
+extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...);
+#endif
+
+#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
+#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
+
+#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
+
+void
+DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
+{
+ dTHX;
+ va_list args;
+ va_start(args, pat);
+ sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+#endif
+
+#ifndef sv_catpvf_mg
+# ifdef PERL_IMPLICIT_CONTEXT
+# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
+# else
+# define sv_catpvf_mg Perl_sv_catpvf_mg
+# endif
+#endif
+
+/* sv_vcatpvf_mg depends on sv_vcatpvfn */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg)
+# define sv_vcatpvf_mg(sv, pat, args) \
+ STMT_START { \
+ sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
+ SvSETMAGIC(sv); \
+ } STMT_END
+#endif
+
+/* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg)
+#if defined(NEED_sv_setpvf_mg)
+static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
+static
+#else
+extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...);
+#endif
+
+#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
+
+#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
+
+void
+DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
+{
+ va_list args;
+ va_start(args, pat);
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+
+/* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */
+#ifdef PERL_IMPLICIT_CONTEXT
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext)
+#if defined(NEED_sv_setpvf_mg_nocontext)
+static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
+static
+#else
+extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...);
+#endif
+
+#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
+#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
+
+#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
+
+void
+DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
+{
+ dTHX;
+ va_list args;
+ va_start(args, pat);
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
+ va_end(args);
+}
+
+#endif
+#endif
+#endif
+
+#ifndef sv_setpvf_mg
+# ifdef PERL_IMPLICIT_CONTEXT
+# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext
+# else
+# define sv_setpvf_mg Perl_sv_setpvf_mg
+# endif
+#endif
+
+/* sv_vsetpvf_mg depends on sv_vsetpvfn */
+#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg)
+# define sv_vsetpvf_mg(sv, pat, args) \
+ STMT_START { \
+ sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \
+ SvSETMAGIC(sv); \
+ } STMT_END
+#endif
#ifndef SvGETMAGIC
# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
#endif
#ifndef grok_numeric_radix
#if defined(NEED_grok_numeric_radix)
-static bool DPPP_(grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
+static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
static
#else
-extern bool DPPP_(grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
+extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send);
#endif
#ifdef grok_numeric_radix
# undef grok_numeric_radix
#endif
-#define grok_numeric_radix(a,b) DPPP_(grok_numeric_radix)(aTHX_ a,b)
-#define Perl_grok_numeric_radix DPPP_(grok_numeric_radix)
+#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b)
+#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix)
#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL)
bool
-DPPP_(grok_numeric_radix)(pTHX_ const char **sp, const char *send)
+DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send)
{
#ifdef USE_LOCALE_NUMERIC
#ifdef PL_numeric_radix_sv
#ifndef grok_number
#if defined(NEED_grok_number)
-static int DPPP_(grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
+static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
static
#else
-extern int DPPP_(grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
+extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep);
#endif
#ifdef grok_number
# undef grok_number
#endif
-#define grok_number(a,b,c) DPPP_(grok_number)(aTHX_ a,b,c)
-#define Perl_grok_number DPPP_(grok_number)
+#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c)
+#define Perl_grok_number DPPP_(my_grok_number)
#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL)
int
-DPPP_(grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
+DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep)
{
const char *s = pv;
const char *send = pv + len;
#ifndef grok_bin
#if defined(NEED_grok_bin)
-static UV DPPP_(grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
-extern UV DPPP_(grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
#ifdef grok_bin
# undef grok_bin
#endif
-#define grok_bin(a,b,c,d) DPPP_(grok_bin)(aTHX_ a,b,c,d)
-#define Perl_grok_bin DPPP_(grok_bin)
+#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d)
+#define Perl_grok_bin DPPP_(my_grok_bin)
#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL)
UV
-DPPP_(grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
+DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
#ifndef grok_hex
#if defined(NEED_grok_hex)
-static UV DPPP_(grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
-extern UV DPPP_(grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
#ifdef grok_hex
# undef grok_hex
#endif
-#define grok_hex(a,b,c,d) DPPP_(grok_hex)(aTHX_ a,b,c,d)
-#define Perl_grok_hex DPPP_(grok_hex)
+#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d)
+#define Perl_grok_hex DPPP_(my_grok_hex)
#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL)
UV
-DPPP_(grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
+DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
#ifndef grok_oct
#if defined(NEED_grok_oct)
-static UV DPPP_(grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
static
#else
-extern UV DPPP_(grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
+extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result);
#endif
#ifdef grok_oct
# undef grok_oct
#endif
-#define grok_oct(a,b,c,d) DPPP_(grok_oct)(aTHX_ a,b,c,d)
-#define Perl_grok_oct DPPP_(grok_oct)
+#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d)
+#define Perl_grok_oct DPPP_(my_grok_oct)
#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL)
UV
-DPPP_(grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
+DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result)
{
const char *s = start;
STRLEN len = *len_p;
#endif
#endif
+#ifdef NO_XSLOCKS
+# ifdef dJMPENV
+# define dXCPT dJMPENV; int rEtV = 0
+# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0)
+# define XCPT_TRY_END JMPENV_POP;
+# define XCPT_CATCH if (rEtV != 0)
+# define XCPT_RETHROW JMPENV_JUMP(rEtV)
+# else
+# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0
+# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0)
+# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf);
+# define XCPT_CATCH if (rEtV != 0)
+# define XCPT_RETHROW Siglongjmp(top_env, rEtV)
+# endif
+#endif
+
#endif /* _P_P_PORTABILITY_H_ */
/* End of File ppport.h */
projects / p5sagit/p5-mst-13.2.git / blobdiff