/*
----------------------------------------------------------------------
- ppport.h -- Perl/Pollution/Portability Version 3.35
+ ppport.h -- Perl/Pollution/Portability Version 3.39
- Automatically created by Devel::PPPort running under perl 5.025006.
+ Automatically created by Devel::PPPort running under perl 5.027010.
Do NOT edit this file directly! -- Edit PPPort_pm.PL and the
includes in parts/inc/ instead.
=head1 NAME
-ppport.h - Perl/Pollution/Portability version 3.35
+ppport.h - Perl/Pollution/Portability version 3.39
=head1 SYNOPSIS
--nochanges don't suggest changes
--nofilter don't filter input files
- --strip strip all script and doc functionality from
- ppport.h
+ --strip strip all script and doc functionality
+ from ppport.h
--list-provided list provided API
--list-unsupported list unsupported API
PL_signals NEED_PL_signals NEED_PL_signals_GLOBAL
SvRX() NEED_SvRX NEED_SvRX_GLOBAL
caller_cx() NEED_caller_cx NEED_caller_cx_GLOBAL
+ croak_xs_usage() NEED_croak_xs_usage NEED_croak_xs_usage_GLOBAL
+ die_sv() NEED_die_sv NEED_die_sv_GLOBAL
eval_pv() NEED_eval_pv NEED_eval_pv_GLOBAL
grok_bin() NEED_grok_bin NEED_grok_bin_GLOBAL
grok_hex() NEED_grok_hex NEED_grok_hex_GLOBAL
grok_oct() NEED_grok_oct NEED_grok_oct_GLOBAL
gv_fetchpvn_flags() NEED_gv_fetchpvn_flags NEED_gv_fetchpvn_flags_GLOBAL
load_module() NEED_load_module NEED_load_module_GLOBAL
+ mess() NEED_mess NEED_mess_GLOBAL
+ mess_nocontext() NEED_mess_nocontext NEED_mess_nocontext_GLOBAL
+ mess_sv() NEED_mess_sv NEED_mess_sv_GLOBAL
mg_findext() NEED_mg_findext NEED_mg_findext_GLOBAL
my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL
my_sprintf() NEED_my_sprintf NEED_my_sprintf_GLOBAL
sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL
sv_unmagicext() NEED_sv_unmagicext NEED_sv_unmagicext_GLOBAL
vload_module() NEED_vload_module NEED_vload_module_GLOBAL
+ vmess() NEED_vmess NEED_vmess_GLOBAL
vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL
warner() NEED_warner NEED_warner_GLOBAL
# Disable broken TRIE-optimization
BEGIN { eval '${^RE_TRIE_MAXBUF} = -1' if $] >= 5.009004 && $] <= 5.009005 }
-my $VERSION = 3.35;
+my $VERSION = 3.39;
my %opt = (
quiet => 0,
PERLIO_FUNCS_CAST|5.009003||p
PERLIO_FUNCS_DECL|5.009003||p
PERL_ABS|5.008001||p
+PERL_ARGS_ASSERT_CROAK_XS_USAGE|||p
PERL_BCDVERSION|5.024000||p
PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p
PERL_HASH|5.003070||p
coresub_op|||
cr_textfilter|||
create_eval_scope|||
-croak_memory_wrap||5.019003|n
+croak_memory_wrap|5.019003||pn
croak_no_mem|||n
-croak_no_modify||5.013003|n
-croak_nocontext|||vn
+croak_no_modify|5.013003||pn
+croak_nocontext|||pvn
croak_popstack|||n
-croak_sv||5.013001|
-croak_xs_usage||5.010001|n
+croak_sv|5.013001||p
+croak_xs_usage|5.010001||pn
croak|||v
csighandler||5.009003|n
current_re_engine|||
despatch_signals||5.007001|
destroy_matcher|||
die_nocontext|||vn
-die_sv||5.013001|
+die_sv|5.013001||p
die_unwind|||
die|||v
dirp_dup|||
he_dup|||
hek_dup|||
hfree_next_entry|||
-hfreeentries|||
hsplit|||
hv_assert|||
hv_auxinit_internal|||n
hv_fetch|||
hv_fill||5.013002|
hv_free_ent_ret|||
+hv_free_entries|||
hv_free_ent||5.004000|
hv_iterinit|||
hv_iterkeysv||5.003070|
mem_log_free|||n
mem_log_realloc|||n
mess_alloc|||
-mess_nocontext|||vn
-mess_sv||5.013001|
-mess||5.006000|v
+mess_nocontext|||pvn
+mess_sv|5.013001||p
+mess|5.006000||pv
mfree||5.007002|n
mg_clear|||
mg_copy|||
vivify_defelem|||
vivify_ref|||
vload_module|5.006000||p
-vmess||5.006000|
+vmess|5.006000||p
vnewSVpvf|5.006000|5.004000|p
vnormal||5.009002|
vnumify||5.009000|
vwarner||5.006000|
vwarn||5.006000|
wait4pid|||
-warn_nocontext|||vn
-warn_sv||5.013001|
+warn_nocontext|||pvn
+warn_sv|5.013001||p
warner_nocontext|||vn
warner|5.006000|5.004000|pv
warn|||v
#ifndef Newxz
# define Newxz(v,n,t) Newz(0,v,n,t)
#endif
-#ifndef PERL_MAGIC_qr
-# define PERL_MAGIC_qr 'r'
-#endif
-#ifndef cBOOL
-# define cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0)
+#ifndef SvGETMAGIC
+# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
#endif
-#ifndef OpHAS_SIBLING
-# define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling))
+/* Some random bits for sv_unmagicext. These should probably be pulled in for
+ real and organized at some point */
+#ifndef HEf_SVKEY
+# define HEf_SVKEY -2
#endif
-#ifndef OpSIBLING
-# define OpSIBLING(o) (0 + (o)->op_sibling)
+#ifndef MUTABLE_PTR
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
+# define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
+#else
+# define MUTABLE_PTR(p) ((void *) (p))
#endif
-
-#ifndef OpMORESIB_set
-# define OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
+#endif
+#ifndef MUTABLE_SV
+# define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
#endif
-#ifndef OpLASTSIB_set
-# define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
+/* end of random bits */
+#ifndef PERL_MAGIC_sv
+# define PERL_MAGIC_sv '\0'
#endif
-#ifndef OpMAYBESIB_set
-# define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
+#ifndef PERL_MAGIC_overload
+# define PERL_MAGIC_overload 'A'
#endif
-#ifndef SvRX
-#if defined(NEED_SvRX)
-static void * DPPP_(my_SvRX)(pTHX_ SV *rv);
-static
-#else
-extern void * DPPP_(my_SvRX)(pTHX_ SV *rv);
+#ifndef PERL_MAGIC_overload_elem
+# define PERL_MAGIC_overload_elem 'a'
#endif
-#ifdef SvRX
-# undef SvRX
+#ifndef PERL_MAGIC_overload_table
+# define PERL_MAGIC_overload_table 'c'
#endif
-#define SvRX(a) DPPP_(my_SvRX)(aTHX_ a)
-#if defined(NEED_SvRX) || defined(NEED_SvRX_GLOBAL)
+#ifndef PERL_MAGIC_bm
+# define PERL_MAGIC_bm 'B'
+#endif
-void *
-DPPP_(my_SvRX)(pTHX_ SV *rv)
-{
- if (SvROK(rv)) {
- SV *sv = SvRV(rv);
- if (SvMAGICAL(sv)) {
- MAGIC *mg = mg_find(sv, PERL_MAGIC_qr);
- if (mg && mg->mg_obj) {
- return mg->mg_obj;
- }
- }
- }
- return 0;
-}
+#ifndef PERL_MAGIC_regdata
+# define PERL_MAGIC_regdata 'D'
#endif
+
+#ifndef PERL_MAGIC_regdatum
+# define PERL_MAGIC_regdatum 'd'
#endif
-#ifndef SvRXOK
-# define SvRXOK(sv) (!!SvRX(sv))
+
+#ifndef PERL_MAGIC_env
+# define PERL_MAGIC_env 'E'
#endif
-#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
-# endif
+#ifndef PERL_MAGIC_envelem
+# define PERL_MAGIC_envelem 'e'
#endif
-#ifndef PERL_UNUSED_ARG
-# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
-# include <note.h>
-# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
-# else
-# define PERL_UNUSED_ARG(x) ((void)x)
-# endif
+#ifndef PERL_MAGIC_fm
+# define PERL_MAGIC_fm 'f'
#endif
-#ifndef PERL_UNUSED_VAR
-# define PERL_UNUSED_VAR(x) ((void)x)
+#ifndef PERL_MAGIC_regex_global
+# define PERL_MAGIC_regex_global 'g'
#endif
-#ifndef PERL_UNUSED_CONTEXT
-# ifdef USE_ITHREADS
-# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
-# else
-# define PERL_UNUSED_CONTEXT
-# endif
+#ifndef PERL_MAGIC_isa
+# define PERL_MAGIC_isa 'I'
#endif
-#ifndef PERL_UNUSED_RESULT
-# if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
-# define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
-# else
-# define PERL_UNUSED_RESULT(v) ((void)(v))
-# endif
+#ifndef PERL_MAGIC_isaelem
+# define PERL_MAGIC_isaelem 'i'
#endif
-#ifndef NOOP
-# define NOOP /*EMPTY*/(void)0
+
+#ifndef PERL_MAGIC_nkeys
+# define PERL_MAGIC_nkeys 'k'
#endif
-#ifndef dNOOP
-# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
+#ifndef PERL_MAGIC_dbfile
+# define PERL_MAGIC_dbfile 'L'
#endif
-#ifndef NVTYPE
-# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
-# define NVTYPE long double
-# else
-# define NVTYPE double
-# endif
-typedef NVTYPE NV;
+#ifndef PERL_MAGIC_dbline
+# define PERL_MAGIC_dbline 'l'
#endif
-#ifndef INT2PTR
-# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
-# define PTRV UV
-# define INT2PTR(any,d) (any)(d)
-# else
-# if PTRSIZE == LONGSIZE
-# define PTRV unsigned long
-# else
-# define PTRV unsigned
-# endif
-# define INT2PTR(any,d) (any)(PTRV)(d)
-# endif
+#ifndef PERL_MAGIC_mutex
+# define PERL_MAGIC_mutex 'm'
#endif
-#ifndef PTR2ul
-# if PTRSIZE == LONGSIZE
-# define PTR2ul(p) (unsigned long)(p)
-# else
-# define PTR2ul(p) INT2PTR(unsigned long,p)
-# endif
+#ifndef PERL_MAGIC_shared
+# define PERL_MAGIC_shared 'N'
#endif
-#ifndef PTR2nat
-# define PTR2nat(p) (PTRV)(p)
+
+#ifndef PERL_MAGIC_shared_scalar
+# define PERL_MAGIC_shared_scalar 'n'
#endif
-#ifndef NUM2PTR
-# define NUM2PTR(any,d) (any)PTR2nat(d)
+#ifndef PERL_MAGIC_collxfrm
+# define PERL_MAGIC_collxfrm 'o'
#endif
-#ifndef PTR2IV
-# define PTR2IV(p) INT2PTR(IV,p)
+#ifndef PERL_MAGIC_tied
+# define PERL_MAGIC_tied 'P'
#endif
-#ifndef PTR2UV
-# define PTR2UV(p) INT2PTR(UV,p)
+#ifndef PERL_MAGIC_tiedelem
+# define PERL_MAGIC_tiedelem 'p'
#endif
-#ifndef PTR2NV
-# define PTR2NV(p) NUM2PTR(NV,p)
+#ifndef PERL_MAGIC_tiedscalar
+# define PERL_MAGIC_tiedscalar 'q'
#endif
-#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
+#ifndef PERL_MAGIC_qr
+# define PERL_MAGIC_qr 'r'
#endif
-#if defined(PERL_GCC_PEDANTIC)
-# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
-# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
-# endif
+#ifndef PERL_MAGIC_sig
+# define PERL_MAGIC_sig 'S'
#endif
-#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
-# ifndef PERL_USE_GCC_BRACE_GROUPS
-# define PERL_USE_GCC_BRACE_GROUPS
-# endif
+#ifndef PERL_MAGIC_sigelem
+# define PERL_MAGIC_sigelem 's'
#endif
-#undef STMT_START
-#undef STMT_END
-#ifdef PERL_USE_GCC_BRACE_GROUPS
-# 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
+#ifndef PERL_MAGIC_taint
+# define PERL_MAGIC_taint 't'
#endif
-#ifndef boolSV
-# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
+
+#ifndef PERL_MAGIC_uvar
+# define PERL_MAGIC_uvar 'U'
#endif
-/* DEFSV appears first in 5.004_56 */
-#ifndef DEFSV
-# define DEFSV GvSV(PL_defgv)
+#ifndef PERL_MAGIC_uvar_elem
+# define PERL_MAGIC_uvar_elem 'u'
#endif
-#ifndef SAVE_DEFSV
-# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
+#ifndef PERL_MAGIC_vstring
+# define PERL_MAGIC_vstring 'V'
#endif
-#ifndef DEFSV_set
-# define DEFSV_set(sv) (DEFSV = (sv))
+#ifndef PERL_MAGIC_vec
+# define PERL_MAGIC_vec 'v'
#endif
-/* Older perls (<=5.003) lack AvFILLp */
-#ifndef AvFILLp
-# define AvFILLp AvFILL
+#ifndef PERL_MAGIC_utf8
+# define PERL_MAGIC_utf8 'w'
#endif
-#ifndef ERRSV
-# define ERRSV get_sv("@",FALSE)
+
+#ifndef PERL_MAGIC_substr
+# define PERL_MAGIC_substr 'x'
#endif
-/* Hint: gv_stashpvn
- * This function's backport doesn't support the length parameter, but
- * rather ignores it. Portability can only be ensured if the length
- * parameter is used for speed reasons, but the length can always be
- * correctly computed from the string argument.
- */
-#ifndef gv_stashpvn
-# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
+#ifndef PERL_MAGIC_defelem
+# define PERL_MAGIC_defelem 'y'
#endif
-/* Replace: 1 */
-#ifndef get_cv
-# define get_cv perl_get_cv
-#endif
-
-#ifndef get_sv
-# define get_sv perl_get_sv
+#ifndef PERL_MAGIC_glob
+# define PERL_MAGIC_glob '*'
#endif
-#ifndef get_av
-# define get_av perl_get_av
+#ifndef PERL_MAGIC_arylen
+# define PERL_MAGIC_arylen '#'
#endif
-#ifndef get_hv
-# define get_hv perl_get_hv
+#ifndef PERL_MAGIC_pos
+# define PERL_MAGIC_pos '.'
#endif
-/* Replace: 0 */
-#ifndef dUNDERBAR
-# define dUNDERBAR dNOOP
+#ifndef PERL_MAGIC_backref
+# define PERL_MAGIC_backref '<'
#endif
-#ifndef UNDERBAR
-# define UNDERBAR DEFSV
-#endif
-#ifndef dAX
-# define dAX I32 ax = MARK - PL_stack_base + 1
+#ifndef PERL_MAGIC_ext
+# define PERL_MAGIC_ext '~'
#endif
-#ifndef dITEMS
-# define dITEMS I32 items = SP - MARK
-#endif
-#ifndef dXSTARG
-# define dXSTARG SV * targ = sv_newmortal()
-#endif
-#ifndef dAXMARK
-# define dAXMARK I32 ax = POPMARK; \
- register SV ** const mark = PL_stack_base + ax++
-#endif
-#ifndef XSprePUSH
-# define XSprePUSH (sp = PL_stack_base + ax - 1)
+/* That's the best we can do... */
+#ifndef sv_catpvn_nomg
+# define sv_catpvn_nomg sv_catpvn
#endif
-#if (PERL_BCDVERSION < 0x5005000)
-# undef XSRETURN
-# define XSRETURN(off) \
- STMT_START { \
- PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
- return; \
- } STMT_END
-#endif
-#ifndef XSPROTO
-# define XSPROTO(name) void name(pTHX_ CV* cv)
+#ifndef sv_catsv_nomg
+# define sv_catsv_nomg sv_catsv
#endif
-#ifndef SVfARG
-# define SVfARG(p) ((void*)(p))
-#endif
-#ifndef PERL_ABS
-# define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
-#endif
-#ifndef dVAR
-# define dVAR dNOOP
-#endif
-#ifndef SVf
-# define SVf "_"
-#endif
-#ifndef UTF8_MAXBYTES
-# define UTF8_MAXBYTES UTF8_MAXLEN
-#endif
-#ifndef CPERLscope
-# define CPERLscope(x) x
-#endif
-#ifndef PERL_HASH
-# define PERL_HASH(hash,str,len) \
- STMT_START { \
- const char *s_PeRlHaSh = str; \
- I32 i_PeRlHaSh = len; \
- U32 hash_PeRlHaSh = 0; \
- while (i_PeRlHaSh--) \
- hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
- (hash) = hash_PeRlHaSh; \
- } STMT_END
+#ifndef sv_setsv_nomg
+# define sv_setsv_nomg sv_setsv
#endif
-#ifndef PERLIO_FUNCS_DECL
-# ifdef PERLIO_FUNCS_CONST
-# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
-# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
-# else
-# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
-# define PERLIO_FUNCS_CAST(funcs) (funcs)
-# endif
+#ifndef sv_pvn_nomg
+# define sv_pvn_nomg sv_pvn
#endif
-/* provide these typedefs for older perls */
-#if (PERL_BCDVERSION < 0x5009003)
-
-# ifdef ARGSproto
-typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
-# else
-typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
-# endif
-
-typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
-
-#endif
-#ifndef isPSXSPC
-# define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
+#ifndef SvIV_nomg
+# define SvIV_nomg SvIV
#endif
-#ifndef isBLANK
-# define isBLANK(c) ((c) == ' ' || (c) == '\t')
+#ifndef SvUV_nomg
+# define SvUV_nomg SvUV
#endif
-#ifdef EBCDIC
-#ifndef isALNUMC
-# define isALNUMC(c) isalnum(c)
+#ifndef sv_catpv_mg
+# define sv_catpv_mg(sv, ptr) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_catpv(TeMpSv,ptr); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
#endif
-#ifndef isASCII
-# define isASCII(c) isascii(c)
+#ifndef sv_catpvn_mg
+# define sv_catpvn_mg(sv, ptr, len) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_catpvn(TeMpSv,ptr,len); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
#endif
-#ifndef isCNTRL
-# define isCNTRL(c) iscntrl(c)
+#ifndef sv_catsv_mg
+# define sv_catsv_mg(dsv, ssv) \
+ STMT_START { \
+ SV *TeMpSv = dsv; \
+ sv_catsv(TeMpSv,ssv); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
#endif
-#ifndef isGRAPH
-# define isGRAPH(c) isgraph(c)
+#ifndef sv_setiv_mg
+# define sv_setiv_mg(sv, i) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setiv(TeMpSv,i); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
#endif
-#ifndef isPRINT
-# define isPRINT(c) isprint(c)
+#ifndef sv_setnv_mg
+# define sv_setnv_mg(sv, num) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setnv(TeMpSv,num); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
#endif
-#ifndef isPUNCT
-# define isPUNCT(c) ispunct(c)
+#ifndef sv_setpv_mg
+# define sv_setpv_mg(sv, ptr) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setpv(TeMpSv,ptr); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
#endif
-#ifndef isXDIGIT
-# define isXDIGIT(c) isxdigit(c)
+#ifndef sv_setpvn_mg
+# define sv_setpvn_mg(sv, ptr, len) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setpvn(TeMpSv,ptr,len); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
#endif
-#else
-# if (PERL_BCDVERSION < 0x5010000)
-/* Hint: isPRINT
- * The implementation in older perl versions includes all of the
- * isSPACE() characters, which is wrong. The version provided by
- * Devel::PPPort always overrides a present buggy version.
- */
-# undef isPRINT
-# endif
-
-#ifdef HAS_QUAD
-# ifdef U64TYPE
-# define WIDEST_UTYPE U64TYPE
-# else
-# define WIDEST_UTYPE Quad_t
-# endif
-#else
-# define WIDEST_UTYPE U32
-#endif
-#ifndef isALNUMC
-# define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
+#ifndef sv_setsv_mg
+# define sv_setsv_mg(dsv, ssv) \
+ STMT_START { \
+ SV *TeMpSv = dsv; \
+ sv_setsv(TeMpSv,ssv); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
#endif
-#ifndef isASCII
-# define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
+#ifndef sv_setuv_mg
+# define sv_setuv_mg(sv, i) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setuv(TeMpSv,i); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
#endif
-#ifndef isCNTRL
-# define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
+#ifndef sv_usepvn_mg
+# define sv_usepvn_mg(sv, ptr, len) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_usepvn(TeMpSv,ptr,len); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
#endif
-
-#ifndef isGRAPH
-# define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
+#ifndef SvVSTRING_mg
+# define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
#endif
-#ifndef isPRINT
-# define isPRINT(c) (((c) >= 32 && (c) < 127))
-#endif
+/* Hint: sv_magic_portable
+ * This is a compatibility function that is only available with
+ * Devel::PPPort. It is NOT in the perl core.
+ * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
+ * it is being passed a name pointer with namlen == 0. In that
+ * case, perl 5.8.0 and later store the pointer, not a copy of it.
+ * The compatibility can be provided back to perl 5.004. With
+ * earlier versions, the code will not compile.
+ */
-#ifndef isPUNCT
-# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
-#endif
+#if (PERL_BCDVERSION < 0x5004000)
-#ifndef isXDIGIT
-# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
-#endif
+ /* code that uses sv_magic_portable will not compile */
-#endif
+#elif (PERL_BCDVERSION < 0x5008000)
-/* Until we figure out how to support this in older perls... */
-#if (PERL_BCDVERSION >= 0x5008000)
-#ifndef HeUTF8
-# define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
- SvUTF8(HeKEY_sv(he)) : \
- (U32)HeKUTF8(he))
-#endif
+# define sv_magic_portable(sv, obj, how, name, namlen) \
+ STMT_START { \
+ SV *SvMp_sv = (sv); \
+ char *SvMp_name = (char *) (name); \
+ I32 SvMp_namlen = (namlen); \
+ if (SvMp_name && SvMp_namlen == 0) \
+ { \
+ MAGIC *mg; \
+ sv_magic(SvMp_sv, obj, how, 0, 0); \
+ mg = SvMAGIC(SvMp_sv); \
+ mg->mg_len = -42; /* XXX: this is the tricky part */ \
+ mg->mg_ptr = SvMp_name; \
+ } \
+ else \
+ { \
+ sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
+ } \
+ } STMT_END
+
+#else
+
+# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
-#endif
-#ifndef C_ARRAY_LENGTH
-# define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0]))
#endif
-#ifndef C_ARRAY_END
-# define C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a))
+#if !defined(mg_findext)
+#if defined(NEED_mg_findext)
+static MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
+static
+#else
+extern MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
#endif
-#ifndef PERL_SIGNALS_UNSAFE_FLAG
+#define mg_findext DPPP_(my_mg_findext)
+#define Perl_mg_findext DPPP_(my_mg_findext)
-#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
+#if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL)
-#if (PERL_BCDVERSION < 0x5008000)
-# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
-#else
-# define D_PPP_PERL_SIGNALS_INIT 0
-#endif
+MAGIC *
+DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl) {
+ if (sv) {
+ MAGIC *mg;
-#if defined(NEED_PL_signals)
-static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
-#elif defined(NEED_PL_signals_GLOBAL)
-U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
-#else
-extern U32 DPPP_(my_PL_signals);
+#ifdef AvPAD_NAMELIST
+ assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
#endif
-#define PL_signals DPPP_(my_PL_signals)
-#endif
+ for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) {
+ if (mg->mg_type == type && mg->mg_virtual == vtbl)
+ return mg;
+ }
+ }
-/* Hint: PL_ppaddr
- * Calling an op via PL_ppaddr requires passing a context argument
- * for threaded builds. Since the context argument is different for
- * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
- * automatically be defined as the correct argument.
- */
+ return NULL;
+}
-#if (PERL_BCDVERSION <= 0x5005005)
-/* Replace: 1 */
-# define PL_ppaddr ppaddr
-# define PL_no_modify no_modify
-/* Replace: 0 */
#endif
-
-#if (PERL_BCDVERSION <= 0x5004005)
-/* Replace: 1 */
-# define PL_DBsignal DBsignal
-# define PL_DBsingle DBsingle
-# define PL_DBsub DBsub
-# define PL_DBtrace DBtrace
-# define PL_Sv Sv
-# define PL_bufend bufend
-# define PL_bufptr bufptr
-# 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_error_count error_count
-# define PL_expect expect
-# define PL_hexdigit hexdigit
-# define PL_hints hints
-# define PL_in_my in_my
-# define PL_laststatval laststatval
-# define PL_lex_state lex_state
-# define PL_lex_stuff lex_stuff
-# define PL_linestr linestr
-# define PL_na na
-# define PL_perl_destruct_level perl_destruct_level
-# define PL_perldb perldb
-# define PL_rsfp_filters rsfp_filters
-# define PL_rsfp rsfp
-# define PL_stack_base stack_base
-# define PL_stack_sp stack_sp
-# define PL_statcache statcache
-# 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
-# define PL_tokenbuf tokenbuf
-/* Replace: 0 */
#endif
-/* Warning: PL_parser
- * For perl versions earlier than 5.9.5, this is an always
- * non-NULL dummy. Also, it cannot be dereferenced. Don't
- * use it if you can avoid is and unless you absolutely know
- * what you're doing.
- * If you always check that PL_parser is non-NULL, you can
- * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
- * a dummy parser structure.
- */
-
-#if (PERL_BCDVERSION >= 0x5009005)
-# ifdef DPPP_PL_parser_NO_DUMMY
-# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
- (croak("panic: PL_parser == NULL in %s:%d", \
- __FILE__, __LINE__), (yy_parser *) NULL))->var)
-# else
-# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
-# define D_PPP_parser_dummy_warning(var)
-# else
-# define D_PPP_parser_dummy_warning(var) \
- warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
-# endif
-# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
- (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
-#if defined(NEED_PL_parser)
-static yy_parser DPPP_(dummy_PL_parser);
-#elif defined(NEED_PL_parser_GLOBAL)
-yy_parser DPPP_(dummy_PL_parser);
+#if !defined(sv_unmagicext)
+#if defined(NEED_sv_unmagicext)
+static int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
+static
#else
-extern yy_parser DPPP_(dummy_PL_parser);
+extern int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
#endif
-# endif
-
-/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
-/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
- * Do not use this variable unless you know exactly what you're
- * doing. It is internal to the perl parser and may change or even
- * be removed in the future. As of perl 5.9.5, you have to check
- * for (PL_parser != NULL) for this variable to have any effect.
- * An always non-NULL PL_parser dummy is provided for earlier
- * perl versions.
- * If PL_parser is NULL when you try to access this variable, a
- * dummy is being accessed instead and a warning is issued unless
- * you define DPPP_PL_parser_NO_DUMMY_WARNING.
- * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
- * this variable will croak with a panic message.
- */
-
-# define PL_expect D_PPP_my_PL_parser_var(expect)
-# define PL_copline D_PPP_my_PL_parser_var(copline)
-# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
-# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
-# define PL_linestr D_PPP_my_PL_parser_var(linestr)
-# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
-# define PL_bufend D_PPP_my_PL_parser_var(bufend)
-# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
-# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
-# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
-# define PL_in_my D_PPP_my_PL_parser_var(in_my)
-# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
-# define PL_error_count D_PPP_my_PL_parser_var(error_count)
+#ifdef sv_unmagicext
+# undef sv_unmagicext
+#endif
+#define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c)
+#define Perl_sv_unmagicext DPPP_(my_sv_unmagicext)
+#if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL)
-#else
+int
+DPPP_(my_sv_unmagicext)(pTHX_ SV *const sv, const int type, MGVTBL *vtbl)
+{
+ MAGIC* mg;
+ MAGIC** mgp;
-/* ensure that PL_parser != NULL and cannot be dereferenced */
-# define PL_parser ((void *) 1)
+ if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
+ return 0;
+ mgp = &(SvMAGIC(sv));
+ for (mg = *mgp; mg; mg = *mgp) {
+ const MGVTBL* const virt = mg->mg_virtual;
+ if (mg->mg_type == type && virt == vtbl) {
+ *mgp = mg->mg_moremagic;
+ if (virt && virt->svt_free)
+ virt->svt_free(aTHX_ sv, mg);
+ if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
+ if (mg->mg_len > 0)
+ Safefree(mg->mg_ptr);
+ else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */
+ SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
+ else if (mg->mg_type == PERL_MAGIC_utf8)
+ Safefree(mg->mg_ptr);
+ }
+ if (mg->mg_flags & MGf_REFCOUNTED)
+ SvREFCNT_dec(mg->mg_obj);
+ Safefree(mg);
+ }
+ else
+ mgp = &mg->mg_moremagic;
+ }
+ if (SvMAGIC(sv)) {
+ if (SvMAGICAL(sv)) /* if we're under save_magic, wait for restore_magic; */
+ mg_magical(sv); /* else fix the flags now */
+ }
+ else {
+ SvMAGICAL_off(sv);
+ SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+ }
+ return 0;
+}
#endif
-#ifndef mPUSHs
-# define mPUSHs(s) PUSHs(sv_2mortal(s))
#endif
-
-#ifndef PUSHmortal
-# define PUSHmortal PUSHs(sv_newmortal())
+#ifndef cBOOL
+# define cBOOL(cbool) ((cbool) ? (bool)1 : (bool)0)
#endif
-#ifndef mPUSHp
-# define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
+#ifndef OpHAS_SIBLING
+# define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling))
#endif
-#ifndef mPUSHn
-# define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
+#ifndef OpSIBLING
+# define OpSIBLING(o) (0 + (o)->op_sibling)
#endif
-#ifndef mPUSHi
-# define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
+#ifndef OpMORESIB_set
+# define OpMORESIB_set(o, sib) ((o)->op_sibling = (sib))
#endif
-#ifndef mPUSHu
-# define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
+#ifndef OpLASTSIB_set
+# define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
#endif
-#ifndef mXPUSHs
-# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
+
+#ifndef OpMAYBESIB_set
+# define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
#endif
-#ifndef XPUSHmortal
-# define XPUSHmortal XPUSHs(sv_newmortal())
+#ifndef SvRX
+#if defined(NEED_SvRX)
+static void * DPPP_(my_SvRX)(pTHX_ SV *rv);
+static
+#else
+extern void * DPPP_(my_SvRX)(pTHX_ SV *rv);
#endif
-#ifndef mXPUSHp
-# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
+#ifdef SvRX
+# undef SvRX
#endif
+#define SvRX(a) DPPP_(my_SvRX)(aTHX_ a)
-#ifndef mXPUSHn
-# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
+#if defined(NEED_SvRX) || defined(NEED_SvRX_GLOBAL)
+
+void *
+DPPP_(my_SvRX)(pTHX_ SV *rv)
+{
+ if (SvROK(rv)) {
+ SV *sv = SvRV(rv);
+ if (SvMAGICAL(sv)) {
+ MAGIC *mg = mg_find(sv, PERL_MAGIC_qr);
+ if (mg && mg->mg_obj) {
+ return mg->mg_obj;
+ }
+ }
+ }
+ return 0;
+}
+#endif
+#endif
+#ifndef SvRXOK
+# define SvRXOK(sv) (!!SvRX(sv))
#endif
-#ifndef mXPUSHi
-# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
+#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
+# endif
#endif
-#ifndef mXPUSHu
-# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
+#ifndef PERL_UNUSED_ARG
+# if defined(lint) && defined(S_SPLINT_S) /* www.splint.org */
+# include <note.h>
+# define PERL_UNUSED_ARG(x) NOTE(ARGUNUSED(x))
+# else
+# define PERL_UNUSED_ARG(x) ((void)x)
+# endif
#endif
-/* Replace: 1 */
-#ifndef call_sv
-# define call_sv perl_call_sv
+#ifndef PERL_UNUSED_VAR
+# define PERL_UNUSED_VAR(x) ((void)x)
#endif
-#ifndef call_pv
-# define call_pv perl_call_pv
+#ifndef PERL_UNUSED_CONTEXT
+# ifdef USE_ITHREADS
+# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
+# else
+# define PERL_UNUSED_CONTEXT
+# endif
#endif
-#ifndef call_argv
-# define call_argv perl_call_argv
+#ifndef PERL_UNUSED_RESULT
+# if defined(__GNUC__) && defined(HASATTRIBUTE_WARN_UNUSED_RESULT)
+# define PERL_UNUSED_RESULT(v) STMT_START { __typeof__(v) z = (v); (void)sizeof(z); } STMT_END
+# else
+# define PERL_UNUSED_RESULT(v) ((void)(v))
+# endif
+#endif
+#ifndef NOOP
+# define NOOP /*EMPTY*/(void)0
#endif
-#ifndef call_method
-# define call_method perl_call_method
+#ifndef dNOOP
+# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
#endif
-#ifndef eval_sv
-# define eval_sv perl_eval_sv
+
+#ifndef NVTYPE
+# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
+# define NVTYPE long double
+# else
+# define NVTYPE double
+# endif
+typedef NVTYPE NV;
#endif
-/* Replace: 0 */
-#ifndef PERL_LOADMOD_DENY
-# define PERL_LOADMOD_DENY 0x1
+#ifndef INT2PTR
+# if (IVSIZE == PTRSIZE) && (UVSIZE == PTRSIZE)
+# define PTRV UV
+# define INT2PTR(any,d) (any)(d)
+# else
+# if PTRSIZE == LONGSIZE
+# define PTRV unsigned long
+# else
+# define PTRV unsigned
+# endif
+# define INT2PTR(any,d) (any)(PTRV)(d)
+# endif
#endif
-#ifndef PERL_LOADMOD_NOIMPORT
-# define PERL_LOADMOD_NOIMPORT 0x2
+#ifndef PTR2ul
+# if PTRSIZE == LONGSIZE
+# define PTR2ul(p) (unsigned long)(p)
+# else
+# define PTR2ul(p) INT2PTR(unsigned long,p)
+# endif
+#endif
+#ifndef PTR2nat
+# define PTR2nat(p) (PTRV)(p)
#endif
-#ifndef PERL_LOADMOD_IMPORT_OPS
-# define PERL_LOADMOD_IMPORT_OPS 0x4
+#ifndef NUM2PTR
+# define NUM2PTR(any,d) (any)PTR2nat(d)
#endif
-#ifndef G_METHOD
-# define G_METHOD 64
-# ifdef call_sv
-# undef call_sv
-# endif
-# if (PERL_BCDVERSION < 0x5006000)
-# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
- (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
-# else
-# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
- (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
-# endif
+#ifndef PTR2IV
+# define PTR2IV(p) INT2PTR(IV,p)
#endif
-/* Replace perl_eval_pv with eval_pv */
+#ifndef PTR2UV
+# define PTR2UV(p) INT2PTR(UV,p)
+#endif
-#ifndef eval_pv
-#if defined(NEED_eval_pv)
-static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
-static
-#else
-extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
+#ifndef PTR2NV
+# define PTR2NV(p) NUM2PTR(NV,p)
#endif
-#ifdef eval_pv
-# undef eval_pv
+#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
-#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)
+#if defined(PERL_GCC_PEDANTIC)
+# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# endif
+#endif
-SV*
-DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
-{
- dSP;
- SV* sv = newSVpv(p, 0);
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
+# ifndef PERL_USE_GCC_BRACE_GROUPS
+# define PERL_USE_GCC_BRACE_GROUPS
+# endif
+#endif
- PUSHMARK(sp);
- eval_sv(sv, G_SCALAR);
- SvREFCNT_dec(sv);
+#undef STMT_START
+#undef STMT_END
+#ifdef PERL_USE_GCC_BRACE_GROUPS
+# 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
- SPAGAIN;
- sv = POPs;
- PUTBACK;
+/* DEFSV appears first in 5.004_56 */
+#ifndef DEFSV
+# define DEFSV GvSV(PL_defgv)
+#endif
- if (croak_on_error && SvTRUE(GvSV(errgv)))
- croak(SvPVx(GvSV(errgv), na));
+#ifndef SAVE_DEFSV
+# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
+#endif
- return sv;
-}
+#ifndef DEFSV_set
+# define DEFSV_set(sv) (DEFSV = (sv))
+#endif
+/* Older perls (<=5.003) lack AvFILLp */
+#ifndef AvFILLp
+# define AvFILLp AvFILL
#endif
+#ifndef ERRSV
+# define ERRSV get_sv("@",FALSE)
#endif
-#ifndef vload_module
-#if defined(NEED_vload_module)
-static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
-static
-#else
-extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
+/* Hint: gv_stashpvn
+ * This function's backport doesn't support the length parameter, but
+ * rather ignores it. Portability can only be ensured if the length
+ * parameter is used for speed reasons, but the length can always be
+ * correctly computed from the string argument.
+ */
+#ifndef gv_stashpvn
+# define gv_stashpvn(str,len,create) gv_stashpv(str,create)
#endif
-#ifdef vload_module
-# undef vload_module
+/* Replace: 1 */
+#ifndef get_cv
+# define get_cv perl_get_cv
#endif
-#define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
-#define Perl_vload_module DPPP_(my_vload_module)
-#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
+#ifndef get_sv
+# define get_sv perl_get_sv
+#endif
-void
-DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
-{
- dTHR;
- dVAR;
- OP *veop, *imop;
+#ifndef get_av
+# define get_av perl_get_av
+#endif
- OP * const modname = newSVOP(OP_CONST, 0, name);
- /* 5.005 has a somewhat hacky force_normal that doesn't croak on
- SvREADONLY() if PL_compling is true. Current perls take care in
- ck_require() to correctly turn off SvREADONLY before calling
- force_normal_flags(). This seems a better fix than fudging PL_compling
- */
- SvREADONLY_off(((SVOP*)modname)->op_sv);
- modname->op_private |= OPpCONST_BARE;
- if (ver) {
- veop = newSVOP(OP_CONST, 0, ver);
- }
- else
- veop = NULL;
- if (flags & PERL_LOADMOD_NOIMPORT) {
- imop = sawparens(newNULLLIST());
- }
- else if (flags & PERL_LOADMOD_IMPORT_OPS) {
- imop = va_arg(*args, OP*);
- }
- else {
- SV *sv;
- imop = NULL;
- sv = va_arg(*args, SV*);
- while (sv) {
- imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
- sv = va_arg(*args, SV*);
- }
- }
- {
- const line_t ocopline = PL_copline;
- COP * const ocurcop = PL_curcop;
- const int oexpect = PL_expect;
+#ifndef get_hv
+# define get_hv perl_get_hv
+#endif
-#if (PERL_BCDVERSION >= 0x5004000)
- utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
- veop, modname, imop);
-#elif (PERL_BCDVERSION > 0x5003000)
- utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
- veop, modname, imop);
-#else
- utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
- modname, imop);
+/* Replace: 0 */
+#ifndef dUNDERBAR
+# define dUNDERBAR dNOOP
#endif
- PL_expect = oexpect;
- PL_copline = ocopline;
- PL_curcop = ocurcop;
- }
-}
+#ifndef UNDERBAR
+# define UNDERBAR DEFSV
#endif
+#ifndef dAX
+# define dAX I32 ax = MARK - PL_stack_base + 1
#endif
-#ifndef load_module
-#if defined(NEED_load_module)
-static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
-static
-#else
-extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
+#ifndef dITEMS
+# define dITEMS I32 items = SP - MARK
#endif
-
-#ifdef load_module
-# undef load_module
+#ifndef dXSTARG
+# define dXSTARG SV * targ = sv_newmortal()
+#endif
+#ifndef dAXMARK
+# define dAXMARK I32 ax = POPMARK; \
+ register SV ** const mark = PL_stack_base + ax++
+#endif
+#ifndef XSprePUSH
+# define XSprePUSH (sp = PL_stack_base + ax - 1)
#endif
-#define load_module DPPP_(my_load_module)
-#define Perl_load_module DPPP_(my_load_module)
-
-#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
-void
-DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
-{
- va_list args;
- va_start(args, ver);
- vload_module(flags, name, ver, &args);
- va_end(args);
-}
+#if (PERL_BCDVERSION < 0x5005000)
+# undef XSRETURN
+# define XSRETURN(off) \
+ STMT_START { \
+ PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
+ return; \
+ } STMT_END
+#endif
+#ifndef XSPROTO
+# define XSPROTO(name) void name(pTHX_ CV* cv)
+#endif
+#ifndef SVfARG
+# define SVfARG(p) ((void*)(p))
#endif
+#ifndef PERL_ABS
+# define PERL_ABS(x) ((x) < 0 ? -(x) : (x))
#endif
-#ifndef newRV_inc
-# define newRV_inc(sv) newRV(sv) /* Replace */
+#ifndef dVAR
+# define dVAR dNOOP
#endif
-
-#ifndef newRV_noinc
-#if defined(NEED_newRV_noinc)
-static SV * DPPP_(my_newRV_noinc)(SV *sv);
-static
-#else
-extern SV * DPPP_(my_newRV_noinc)(SV *sv);
+#ifndef SVf
+# define SVf "_"
+#endif
+#ifndef UTF8_MAXBYTES
+# define UTF8_MAXBYTES UTF8_MAXLEN
+#endif
+#ifndef CPERLscope
+# define CPERLscope(x) x
+#endif
+#ifndef PERL_HASH
+# define PERL_HASH(hash,str,len) \
+ STMT_START { \
+ const char *s_PeRlHaSh = str; \
+ I32 i_PeRlHaSh = len; \
+ U32 hash_PeRlHaSh = 0; \
+ while (i_PeRlHaSh--) \
+ hash_PeRlHaSh = hash_PeRlHaSh * 33 + *s_PeRlHaSh++; \
+ (hash) = hash_PeRlHaSh; \
+ } STMT_END
#endif
-#ifdef newRV_noinc
-# undef newRV_noinc
+#ifndef PERLIO_FUNCS_DECL
+# ifdef PERLIO_FUNCS_CONST
+# define PERLIO_FUNCS_DECL(funcs) const PerlIO_funcs funcs
+# define PERLIO_FUNCS_CAST(funcs) (PerlIO_funcs*)(funcs)
+# else
+# define PERLIO_FUNCS_DECL(funcs) PerlIO_funcs funcs
+# define PERLIO_FUNCS_CAST(funcs) (funcs)
+# endif
#endif
-#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_(my_newRV_noinc)(SV *sv)
-{
- SV *rv = (SV *)newRV(sv);
- SvREFCNT_dec(sv);
- return rv;
-}
+/* provide these typedefs for older perls */
+#if (PERL_BCDVERSION < 0x5009003)
+
+# ifdef ARGSproto
+typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
+# else
+typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
+# endif
+
+typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
+
#endif
+#ifndef isPSXSPC
+# define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
#endif
-/* Hint: newCONSTSUB
- * Returns a CV* as of perl-5.7.1. This return value is not supported
- * by Devel::PPPort.
- */
-
-/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
-#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
-#if defined(NEED_newCONSTSUB)
-static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
-static
-#else
-extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
+#ifndef isBLANK
+# define isBLANK(c) ((c) == ' ' || (c) == '\t')
#endif
-#ifdef newCONSTSUB
-# undef newCONSTSUB
+#ifdef EBCDIC
+#ifndef isALNUMC
+# define isALNUMC(c) isalnum(c)
#endif
-#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)
+#ifndef isASCII
+# define isASCII(c) isascii(c)
+#endif
-/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
-/* (There's no PL_parser in perl < 5.005, so this is completely safe) */
-#define D_PPP_PL_copline PL_copline
+#ifndef isCNTRL
+# define isCNTRL(c) iscntrl(c)
+#endif
-void
-DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
-{
- U32 oldhints = PL_hints;
- HV *old_cop_stash = PL_curcop->cop_stash;
- HV *old_curstash = PL_curstash;
- line_t oldline = PL_curcop->cop_line;
- PL_curcop->cop_line = D_PPP_PL_copline;
+#ifndef isGRAPH
+# define isGRAPH(c) isgraph(c)
+#endif
- PL_hints &= ~HINT_BLOCK_SCOPE;
- if (stash)
- PL_curstash = PL_curcop->cop_stash = stash;
+#ifndef isPRINT
+# define isPRINT(c) isprint(c)
+#endif
- newSUB(
+#ifndef isPUNCT
+# define isPUNCT(c) ispunct(c)
+#endif
-#if (PERL_BCDVERSION < 0x5003022)
- start_subparse(),
-#elif (PERL_BCDVERSION == 0x5003022)
- start_subparse(0),
-#else /* 5.003_23 onwards */
- start_subparse(FALSE, 0),
+#ifndef isXDIGIT
+# define isXDIGIT(c) isxdigit(c)
#endif
- newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
- newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
- newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
- );
+#else
+# if (PERL_BCDVERSION < 0x5010000)
+/* Hint: isPRINT
+ * The implementation in older perl versions includes all of the
+ * isSPACE() characters, which is wrong. The version provided by
+ * Devel::PPPort always overrides a present buggy version.
+ */
+# undef isPRINT
+# endif
- PL_hints = oldhints;
- PL_curcop->cop_stash = old_cop_stash;
- PL_curstash = old_curstash;
- PL_curcop->cop_line = oldline;
-}
+#ifndef WIDEST_UTYPE
+# ifdef QUADKIND
+# ifdef U64TYPE
+# define WIDEST_UTYPE U64TYPE
+# else
+# define WIDEST_UTYPE Quad_t
+# endif
+# else
+# define WIDEST_UTYPE U32
+# endif
#endif
+#ifndef isALNUMC
+# define isALNUMC(c) (isALPHA(c) || isDIGIT(c))
#endif
-/*
- * Boilerplate macros for initializing and accessing interpreter-local
- * data from C. All statics in extensions should be reworked to use
- * this, if you want to make the extension thread-safe. See ext/re/re.xs
- * for an example of the use of these macros.
- *
- * Code that uses these macros is responsible for the following:
- * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
- * 2. Declare a typedef named my_cxt_t that is a structure that contains
- * all the data that needs to be interpreter-local.
- * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
- * 4. Use the MY_CXT_INIT macro such that it is called exactly once
- * (typically put in the BOOT: section).
- * 5. Use the members of the my_cxt_t structure everywhere as
- * MY_CXT.member.
- * 6. Use the dMY_CXT macro (a declaration) in all the functions that
- * access MY_CXT.
- */
-
-#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 START_MY_CXT
-
-#if (PERL_BCDVERSION < 0x5004068)
-/* Fetches the SV that keeps the per-interpreter data. */
-#define dMY_CXT_SV \
- SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
-#else /* >= perl5.004_68 */
-#define dMY_CXT_SV \
- SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
- sizeof(MY_CXT_KEY)-1, TRUE)
-#endif /* < perl5.004_68 */
-
-/* This declaration should be used within all functions that use the
- * interpreter-local data. */
-#define dMY_CXT \
- dMY_CXT_SV; \
- my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
-
-/* Creates and zeroes the per-interpreter data.
- * (We allocate my_cxtp in a Perl SV so that it will be released when
- * the interpreter goes away.) */
-#define MY_CXT_INIT \
- dMY_CXT_SV; \
- /* newSV() allocates one more than needed */ \
- my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
- Zero(my_cxtp, 1, my_cxt_t); \
- sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
-
-/* This macro must be used to access members of the my_cxt_t structure.
- * e.g. MYCXT.some_data */
-#define MY_CXT (*my_cxtp)
-
-/* Judicious use of these macros can reduce the number of times dMY_CXT
- * is used. Use is similar to pTHX, aTHX etc. */
-#define pMY_CXT my_cxt_t *my_cxtp
-#define pMY_CXT_ pMY_CXT,
-#define _pMY_CXT ,pMY_CXT
-#define aMY_CXT my_cxtp
-#define aMY_CXT_ aMY_CXT,
-#define _aMY_CXT ,aMY_CXT
+#ifndef isASCII
+# define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
+#endif
-#endif /* START_MY_CXT */
+#ifndef isCNTRL
+# define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
+#endif
-#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))
+#ifndef isGRAPH
+# define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
#endif
-#else /* single interpreter */
+#ifndef isPRINT
+# define isPRINT(c) (((c) >= 32 && (c) < 127))
+#endif
-#ifndef START_MY_CXT
+#ifndef isPUNCT
+# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
+#endif
-#define START_MY_CXT static my_cxt_t my_cxt;
-#define dMY_CXT_SV dNOOP
-#define dMY_CXT dNOOP
-#define MY_CXT_INIT NOOP
-#define MY_CXT my_cxt
+#ifndef isXDIGIT
+# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
+#endif
-#define pMY_CXT void
-#define pMY_CXT_
-#define _pMY_CXT
-#define aMY_CXT
-#define aMY_CXT_
-#define _aMY_CXT
+#endif
-#endif /* START_MY_CXT */
+/* Until we figure out how to support this in older perls... */
+#if (PERL_BCDVERSION >= 0x5008000)
+#ifndef HeUTF8
+# define HeUTF8(he) ((HeKLEN(he) == HEf_SVKEY) ? \
+ SvUTF8(HeKEY_sv(he)) : \
+ (U32)HeKUTF8(he))
+#endif
-#ifndef MY_CXT_CLONE
-#define MY_CXT_CLONE NOOP
+#endif
+#ifndef C_ARRAY_LENGTH
+# define C_ARRAY_LENGTH(a) (sizeof(a)/sizeof((a)[0]))
#endif
+#ifndef C_ARRAY_END
+# define C_ARRAY_END(a) ((a) + C_ARRAY_LENGTH(a))
#endif
#ifndef IVdf
# endif
#endif
-#ifndef SvREFCNT_inc
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc(sv) \
- ({ \
- SV * const _sv = (SV*)(sv); \
- if (_sv) \
- (SvREFCNT(_sv))++; \
- _sv; \
- })
-# else
-# define SvREFCNT_inc(sv) \
- ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
-# endif
-#endif
-
-#ifndef SvREFCNT_inc_simple
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc_simple(sv) \
- ({ \
- if (sv) \
- (SvREFCNT(sv))++; \
- (SV *)(sv); \
- })
-# else
-# define SvREFCNT_inc_simple(sv) \
- ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
-# endif
+#ifdef NEED_mess_sv
+#define NEED_mess
#endif
-#ifndef SvREFCNT_inc_NN
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc_NN(sv) \
- ({ \
- SV * const _sv = (SV*)(sv); \
- SvREFCNT(_sv)++; \
- _sv; \
- })
-# else
-# define SvREFCNT_inc_NN(sv) \
- (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
-# endif
+#ifdef NEED_mess
+#define NEED_mess_nocontext
+#define NEED_vmess
#endif
-#ifndef SvREFCNT_inc_void
-# ifdef PERL_USE_GCC_BRACE_GROUPS
-# define SvREFCNT_inc_void(sv) \
- ({ \
- SV * const _sv = (SV*)(sv); \
- if (_sv) \
- (void)(SvREFCNT(_sv)++); \
- })
+#ifndef croak_sv
+#if (PERL_BCDVERSION >= 0x5007003) || ( (PERL_BCDVERSION >= 0x5006001) && (PERL_BCDVERSION < 0x5007000) )
+# if ( (PERL_BCDVERSION >= 0x5008000) && (PERL_BCDVERSION < 0x5008009) ) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5010001) )
+# define _dppp_fix_utf8_errsv(errsv, sv) \
+ STMT_START { \
+ if (sv != ERRSV) \
+ SvFLAGS(ERRSV) = (SvFLAGS(ERRSV) & ~SVf_UTF8) | \
+ (SvFLAGS(sv) & SVf_UTF8); \
+ } STMT_END
# else
-# define SvREFCNT_inc_void(sv) \
- (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
+# define _dppp_fix_utf8_errsv(errsv, sv) STMT_START {} STMT_END
# endif
+# define croak_sv(sv) \
+ STMT_START { \
+ if (SvROK(sv)) { \
+ sv_setsv(ERRSV, sv); \
+ croak(NULL); \
+ } else { \
+ _dppp_fix_utf8_errsv(ERRSV, sv); \
+ croak("%" SVf, SVfARG(sv)); \
+ } \
+ } STMT_END
+#elif (PERL_BCDVERSION >= 0x5004000)
+# define croak_sv(sv) croak("%" SVf, SVfARG(sv))
+#else
+# define croak_sv(sv) croak("%s", SvPV_nolen(sv))
#endif
-#ifndef SvREFCNT_inc_simple_void
-# define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
#endif
-#ifndef SvREFCNT_inc_simple_NN
-# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
+#ifndef die_sv
+#if defined(NEED_die_sv)
+static OP * DPPP_(my_die_sv)(pTHX_ SV *sv);
+static
+#else
+extern OP * DPPP_(my_die_sv)(pTHX_ SV *sv);
#endif
-#ifndef SvREFCNT_inc_void_NN
-# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
+#ifdef die_sv
+# undef die_sv
#endif
+#define die_sv(a) DPPP_(my_die_sv)(aTHX_ a)
+#define Perl_die_sv DPPP_(my_die_sv)
-#ifndef SvREFCNT_inc_simple_void_NN
-# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
+#if defined(NEED_die_sv) || defined(NEED_die_sv_GLOBAL)
+OP *
+DPPP_(my_die_sv)(pTHX_ SV *sv)
+{
+ croak_sv(sv);
+ return (OP *)NULL;
+}
+#endif
#endif
-#ifndef newSV_type
+#ifndef warn_sv
+#if (PERL_BCDVERSION >= 0x5004000)
+# define warn_sv(sv) warn("%" SVf, SVfARG(sv))
+#else
+# define warn_sv(sv) warn("%s", SvPV_nolen(sv))
+#endif
+#endif
-#if defined(NEED_newSV_type)
-static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
+#ifndef vmess
+#if defined(NEED_vmess)
+static SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
static
#else
-extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
+extern SV * DPPP_(my_vmess)(pTHX_ const char * pat, va_list * args);
#endif
-#ifdef newSV_type
-# undef newSV_type
+#ifdef vmess
+# undef vmess
#endif
-#define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
-#define Perl_newSV_type DPPP_(my_newSV_type)
-
-#if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
+#define vmess(a,b) DPPP_(my_vmess)(aTHX_ a,b)
+#define Perl_vmess DPPP_(my_vmess)
+#if defined(NEED_vmess) || defined(NEED_vmess_GLOBAL)
SV*
-DPPP_(my_newSV_type)(pTHX_ svtype const t)
+DPPP_(my_vmess)(pTHX_ const char* pat, va_list* args)
{
- SV* const sv = newSV(0);
- sv_upgrade(sv, t);
- return sv;
+ mess(pat, args);
+ return PL_mess_sv;
}
-
#endif
-
#endif
#if (PERL_BCDVERSION < 0x5006000)
-# define D_PPP_CONSTPV_ARG(x) ((char *) (x))
-#else
-# define D_PPP_CONSTPV_ARG(x) (x)
+#undef mess
#endif
-#ifndef newSVpvn
-# define newSVpvn(data,len) ((data) \
- ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
- : newSV(0))
+
+#if !defined(mess_nocontext) && !defined(Perl_mess_nocontext)
+#if defined(NEED_mess_nocontext)
+static SV * DPPP_(my_mess_nocontext)(const char * pat, ...);
+static
+#else
+extern SV * DPPP_(my_mess_nocontext)(const char * pat, ...);
#endif
-#ifndef newSVpvn_utf8
-# define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
+
+#define mess_nocontext DPPP_(my_mess_nocontext)
+#define Perl_mess_nocontext DPPP_(my_mess_nocontext)
+
+#if defined(NEED_mess_nocontext) || defined(NEED_mess_nocontext_GLOBAL)
+SV*
+DPPP_(my_mess_nocontext)(const char* pat, ...)
+{
+ dTHX;
+ SV *sv;
+ va_list args;
+ va_start(args, pat);
+ sv = vmess(pat, &args);
+ va_end(args);
+ return sv;
+}
#endif
-#ifndef SVf_UTF8
-# define SVf_UTF8 0
#endif
-#ifndef newSVpvn_flags
-
-#if defined(NEED_newSVpvn_flags)
-static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
+#ifndef mess
+#if defined(NEED_mess)
+static SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
static
#else
-extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
+extern SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
#endif
-#ifdef newSVpvn_flags
-# undef newSVpvn_flags
-#endif
-#define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
-#define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
-
-#if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
+#define Perl_mess DPPP_(my_mess)
-SV *
-DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
+#if defined(NEED_mess) || defined(NEED_mess_GLOBAL)
+SV*
+DPPP_(my_mess)(pTHX_ const char* pat, ...)
{
- SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
- SvFLAGS(sv) |= (flags & SVf_UTF8);
- return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
+ SV *sv;
+ va_list args;
+ va_start(args, pat);
+ sv = vmess(pat, &args);
+ va_end(args);
+ return sv;
}
+#ifdef mess_nocontext
+#define mess mess_nocontext
+#else
+#define mess Perl_mess_nocontext
+#endif
+#endif
+#endif
+#ifndef mess_sv
+#if defined(NEED_mess_sv)
+static SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
+static
+#else
+extern SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
#endif
+#ifdef mess_sv
+# undef mess_sv
#endif
+#define mess_sv(a,b) DPPP_(my_mess_sv)(aTHX_ a,b)
+#define Perl_mess_sv DPPP_(my_mess_sv)
-/* Backwards compatibility stuff... :-( */
-#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
-# define NEED_sv_2pv_flags
+#if defined(NEED_mess_sv) || defined(NEED_mess_sv_GLOBAL)
+SV *
+DPPP_(my_mess_sv)(pTHX_ SV *basemsg, bool consume)
+{
+ SV *tmp;
+ SV *ret;
+
+ if (SvPOK(basemsg) && SvCUR(basemsg) && *(SvEND(basemsg)-1) == '\n') {
+ if (consume)
+ return basemsg;
+ ret = mess("");
+ SvSetSV_nosteal(ret, basemsg);
+ return ret;
+ }
+
+ if (consume) {
+ sv_catsv(basemsg, mess(""));
+ return basemsg;
+ }
+
+ ret = mess("");
+ tmp = newSVsv(ret);
+ SvSetSV_nosteal(ret, basemsg);
+ sv_catsv(ret, tmp);
+ sv_dec(tmp);
+ return ret;
+}
#endif
-#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
-# define NEED_sv_2pv_flags_GLOBAL
#endif
-/* Hint: sv_2pv_nolen
- * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
- */
-#ifndef sv_2pv_nolen
-# define sv_2pv_nolen(sv) SvPV_nolen(sv)
+#ifndef warn_nocontext
+#define warn_nocontext warn
#endif
-#ifdef SvPVbyte
-
-/* Hint: SvPVbyte
- * Does not work in perl-5.6.1, ppport.h implements a version
- * borrowed from perl-5.7.3.
- */
+#ifndef croak_nocontext
+#define croak_nocontext croak
+#endif
-#if (PERL_BCDVERSION < 0x5007000)
+#ifndef croak_no_modify
+#define croak_no_modify() croak_nocontext("%s", PL_no_modify)
+#define Perl_croak_no_modify() croak_no_modify()
+#endif
-#if defined(NEED_sv_2pvbyte)
-static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
-static
+#ifndef croak_memory_wrap
+#if (PERL_BCDVERSION >= 0x5009002) || ( (PERL_BCDVERSION >= 0x5008006) && (PERL_BCDVERSION < 0x5009000) )
+# define croak_memory_wrap() croak_nocontext("%s", PL_memory_wrap)
#else
-extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
+# define croak_memory_wrap() croak_nocontext("panic: memory wrap")
+#endif
#endif
-#ifdef sv_2pvbyte
-# undef sv_2pvbyte
+#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
+#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
#endif
-#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)
+#ifndef croak_xs_usage
+#if defined(NEED_croak_xs_usage)
+static void DPPP_(my_croak_xs_usage)(const CV * const cv, const char * const params);
+static
+#else
+extern void DPPP_(my_croak_xs_usage)(const CV * const cv, const char * const params);
+#endif
-char *
-DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
+#define croak_xs_usage DPPP_(my_croak_xs_usage)
+#define Perl_croak_xs_usage DPPP_(my_croak_xs_usage)
+
+#if defined(NEED_croak_xs_usage) || defined(NEED_croak_xs_usage_GLOBAL)
+void
+DPPP_(my_croak_xs_usage)(const CV *const cv, const char *const params)
{
- sv_utf8_downgrade(sv,0);
- return SvPV(sv,*lp);
+ dTHX;
+ const GV *const gv = CvGV(cv);
+
+ PERL_ARGS_ASSERT_CROAK_XS_USAGE;
+
+ if (gv) {
+ const char *const gvname = GvNAME(gv);
+ const HV *const stash = GvSTASH(gv);
+ const char *const hvname = stash ? HvNAME(stash) : NULL;
+
+ if (hvname)
+ croak("Usage: %s::%s(%s)", hvname, gvname, params);
+ else
+ croak("Usage: %s(%s)", gvname, params);
+ } else {
+ /* Pants. I don't think that it should be possible to get here. */
+ croak("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params);
+ }
}
-
+#endif
#endif
-/* Hint: sv_2pvbyte
- * Use the SvPVbyte() macro instead of sv_2pvbyte().
- */
-
-#undef SvPVbyte
+#ifndef PERL_SIGNALS_UNSAFE_FLAG
-#define SvPVbyte(sv, lp) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
- ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
+#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
+#if (PERL_BCDVERSION < 0x5008000)
+# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
+#else
+# define D_PPP_PERL_SIGNALS_INIT 0
#endif
+#if defined(NEED_PL_signals)
+static U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
+#elif defined(NEED_PL_signals_GLOBAL)
+U32 DPPP_(my_PL_signals) = D_PPP_PERL_SIGNALS_INIT;
#else
+extern U32 DPPP_(my_PL_signals);
+#endif
+#define PL_signals DPPP_(my_PL_signals)
-# define SvPVbyte SvPV
-# define sv_2pvbyte sv_2pv
+#endif
+/* Hint: PL_ppaddr
+ * Calling an op via PL_ppaddr requires passing a context argument
+ * for threaded builds. Since the context argument is different for
+ * 5.005 perls, you can use aTHXR (supplied by ppport.h), which will
+ * automatically be defined as the correct argument.
+ */
+
+#if (PERL_BCDVERSION <= 0x5005005)
+/* Replace: 1 */
+# define PL_ppaddr ppaddr
+# define PL_no_modify no_modify
+/* Replace: 0 */
#endif
-#ifndef sv_2pvbyte_nolen
-# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
+
+#if (PERL_BCDVERSION <= 0x5004005)
+/* Replace: 1 */
+# define PL_DBsignal DBsignal
+# define PL_DBsingle DBsingle
+# define PL_DBsub DBsub
+# define PL_DBtrace DBtrace
+# define PL_Sv Sv
+# define PL_bufend bufend
+# define PL_bufptr bufptr
+# 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_error_count error_count
+# define PL_expect expect
+# define PL_hexdigit hexdigit
+# define PL_hints hints
+# define PL_in_my in_my
+# define PL_laststatval laststatval
+# define PL_lex_state lex_state
+# define PL_lex_stuff lex_stuff
+# define PL_linestr linestr
+# define PL_na na
+# define PL_perl_destruct_level perl_destruct_level
+# define PL_perldb perldb
+# define PL_rsfp_filters rsfp_filters
+# define PL_rsfp rsfp
+# define PL_stack_base stack_base
+# define PL_stack_sp stack_sp
+# define PL_statcache statcache
+# 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
+# define PL_tokenbuf tokenbuf
+/* Replace: 0 */
#endif
-/* Hint: sv_pvn
- * Always use the SvPV() macro instead of sv_pvn().
+/* Warning: PL_parser
+ * For perl versions earlier than 5.9.5, this is an always
+ * non-NULL dummy. Also, it cannot be dereferenced. Don't
+ * use it if you can avoid is and unless you absolutely know
+ * what you're doing.
+ * If you always check that PL_parser is non-NULL, you can
+ * define DPPP_PL_parser_NO_DUMMY to avoid the creation of
+ * a dummy parser structure.
*/
-/* Hint: sv_pvn_force
- * Always use the SvPV_force() macro instead of sv_pvn_force().
+#if (PERL_BCDVERSION >= 0x5009005)
+# ifdef DPPP_PL_parser_NO_DUMMY
+# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
+ (croak("panic: PL_parser == NULL in %s:%d", \
+ __FILE__, __LINE__), (yy_parser *) NULL))->var)
+# else
+# ifdef DPPP_PL_parser_NO_DUMMY_WARNING
+# define D_PPP_parser_dummy_warning(var)
+# else
+# define D_PPP_parser_dummy_warning(var) \
+ warn("warning: dummy PL_" #var " used in %s:%d", __FILE__, __LINE__),
+# endif
+# define D_PPP_my_PL_parser_var(var) ((PL_parser ? PL_parser : \
+ (D_PPP_parser_dummy_warning(var) &DPPP_(dummy_PL_parser)))->var)
+#if defined(NEED_PL_parser)
+static yy_parser DPPP_(dummy_PL_parser);
+#elif defined(NEED_PL_parser_GLOBAL)
+yy_parser DPPP_(dummy_PL_parser);
+#else
+extern yy_parser DPPP_(dummy_PL_parser);
+#endif
+
+# endif
+
+/* PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf depends on PL_parser */
+/* Warning: PL_expect, PL_copline, PL_rsfp, PL_rsfp_filters, PL_linestr, PL_bufptr, PL_bufend, PL_lex_state, PL_lex_stuff, PL_tokenbuf
+ * Do not use this variable unless you know exactly what you're
+ * doing. It is internal to the perl parser and may change or even
+ * be removed in the future. As of perl 5.9.5, you have to check
+ * for (PL_parser != NULL) for this variable to have any effect.
+ * An always non-NULL PL_parser dummy is provided for earlier
+ * perl versions.
+ * If PL_parser is NULL when you try to access this variable, a
+ * dummy is being accessed instead and a warning is issued unless
+ * you define DPPP_PL_parser_NO_DUMMY_WARNING.
+ * If DPPP_PL_parser_NO_DUMMY is defined, the code trying to access
+ * this variable will croak with a panic message.
*/
-/* If these are undefined, they're not handled by the core anyway */
-#ifndef SV_IMMEDIATE_UNREF
-# define SV_IMMEDIATE_UNREF 0
-#endif
+# define PL_expect D_PPP_my_PL_parser_var(expect)
+# define PL_copline D_PPP_my_PL_parser_var(copline)
+# define PL_rsfp D_PPP_my_PL_parser_var(rsfp)
+# define PL_rsfp_filters D_PPP_my_PL_parser_var(rsfp_filters)
+# define PL_linestr D_PPP_my_PL_parser_var(linestr)
+# define PL_bufptr D_PPP_my_PL_parser_var(bufptr)
+# define PL_bufend D_PPP_my_PL_parser_var(bufend)
+# define PL_lex_state D_PPP_my_PL_parser_var(lex_state)
+# define PL_lex_stuff D_PPP_my_PL_parser_var(lex_stuff)
+# define PL_tokenbuf D_PPP_my_PL_parser_var(tokenbuf)
+# define PL_in_my D_PPP_my_PL_parser_var(in_my)
+# define PL_in_my_stash D_PPP_my_PL_parser_var(in_my_stash)
+# define PL_error_count D_PPP_my_PL_parser_var(error_count)
-#ifndef SV_GMAGIC
-# define SV_GMAGIC 0
+
+#else
+
+/* ensure that PL_parser != NULL and cannot be dereferenced */
+# define PL_parser ((void *) 1)
+
+#endif
+#ifndef mPUSHs
+# define mPUSHs(s) PUSHs(sv_2mortal(s))
#endif
-#ifndef SV_COW_DROP_PV
-# define SV_COW_DROP_PV 0
+#ifndef PUSHmortal
+# define PUSHmortal PUSHs(sv_newmortal())
#endif
-#ifndef SV_UTF8_NO_ENCODING
-# define SV_UTF8_NO_ENCODING 0
+#ifndef mPUSHp
+# define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
#endif
-#ifndef SV_NOSTEAL
-# define SV_NOSTEAL 0
+#ifndef mPUSHn
+# define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
#endif
-#ifndef SV_CONST_RETURN
-# define SV_CONST_RETURN 0
+#ifndef mPUSHi
+# define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
#endif
-#ifndef SV_MUTABLE_RETURN
-# define SV_MUTABLE_RETURN 0
+#ifndef mPUSHu
+# define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
+#endif
+#ifndef mXPUSHs
+# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
#endif
-#ifndef SV_SMAGIC
-# define SV_SMAGIC 0
+#ifndef XPUSHmortal
+# define XPUSHmortal XPUSHs(sv_newmortal())
#endif
-#ifndef SV_HAS_TRAILING_NUL
-# define SV_HAS_TRAILING_NUL 0
+#ifndef mXPUSHp
+# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
#endif
-#ifndef SV_COW_SHARED_HASH_KEYS
-# define SV_COW_SHARED_HASH_KEYS 0
+#ifndef mXPUSHn
+# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
#endif
-#if (PERL_BCDVERSION < 0x5007002)
+#ifndef mXPUSHi
+# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
+#endif
-#if defined(NEED_sv_2pv_flags)
-static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
-static
-#else
-extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+#ifndef mXPUSHu
+# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
#endif
-#ifdef sv_2pv_flags
-# undef sv_2pv_flags
+/* Replace: 1 */
+#ifndef call_sv
+# define call_sv perl_call_sv
#endif
-#define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
-#define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
-#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
+#ifndef call_pv
+# define call_pv perl_call_pv
+#endif
-char *
-DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
-{
- STRLEN n_a = (STRLEN) flags;
- return sv_2pv(sv, lp ? lp : &n_a);
-}
+#ifndef call_argv
+# define call_argv perl_call_argv
+#endif
+
+#ifndef call_method
+# define call_method perl_call_method
+#endif
+#ifndef eval_sv
+# define eval_sv perl_eval_sv
+#endif
+/* Replace: 0 */
+#ifndef PERL_LOADMOD_DENY
+# define PERL_LOADMOD_DENY 0x1
#endif
-#if defined(NEED_sv_pvn_force_flags)
-static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+#ifndef PERL_LOADMOD_NOIMPORT
+# define PERL_LOADMOD_NOIMPORT 0x2
+#endif
+
+#ifndef PERL_LOADMOD_IMPORT_OPS
+# define PERL_LOADMOD_IMPORT_OPS 0x4
+#endif
+
+#ifndef G_METHOD
+# define G_METHOD 64
+# ifdef call_sv
+# undef call_sv
+# endif
+# if (PERL_BCDVERSION < 0x5006000)
+# define call_sv(sv, flags) ((flags) & G_METHOD ? perl_call_method((char *) SvPV_nolen_const(sv), \
+ (flags) & ~G_METHOD) : perl_call_sv(sv, flags))
+# else
+# define call_sv(sv, flags) ((flags) & G_METHOD ? Perl_call_method(aTHX_ (char *) SvPV_nolen_const(sv), \
+ (flags) & ~G_METHOD) : Perl_call_sv(aTHX_ sv, flags))
+# endif
+#endif
+
+/* Replace perl_eval_pv with eval_pv */
+
+#ifndef eval_pv
+#if defined(NEED_eval_pv)
+static SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
static
#else
-extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+extern SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
#endif
-#ifdef sv_pvn_force_flags
-# undef sv_pvn_force_flags
+#ifdef eval_pv
+# undef eval_pv
#endif
-#define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
-#define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
+#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
+#define Perl_eval_pv DPPP_(my_eval_pv)
-#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
+#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
-char *
-DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
+SV*
+DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
{
- STRLEN n_a = (STRLEN) flags;
- return sv_pvn_force(sv, lp ? lp : &n_a);
+ dSP;
+ SV* sv = newSVpv(p, 0);
+
+ PUSHMARK(sp);
+ eval_sv(sv, G_SCALAR);
+ SvREFCNT_dec(sv);
+
+ SPAGAIN;
+ sv = POPs;
+ PUTBACK;
+
+ if (croak_on_error && SvTRUEx(ERRSV))
+ croak_sv(ERRSV);
+
+ return sv;
}
#endif
-
#endif
-#if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
-# define DPPP_SVPV_NOLEN_LP_ARG &PL_na
+#ifndef vload_module
+#if defined(NEED_vload_module)
+static void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
+static
#else
-# define DPPP_SVPV_NOLEN_LP_ARG 0
-#endif
-#ifndef SvPV_const
-# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
+extern void DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args);
#endif
-#ifndef SvPV_mutable
-# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
-#endif
-#ifndef SvPV_flags
-# define SvPV_flags(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
-#endif
-#ifndef SvPV_flags_const
-# define SvPV_flags_const(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
- (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
+#ifdef vload_module
+# undef vload_module
#endif
-#ifndef SvPV_flags_const_nolen
-# define SvPV_flags_const_nolen(sv, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX_const(sv) : \
- (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
+#define vload_module(a,b,c,d) DPPP_(my_vload_module)(aTHX_ a,b,c,d)
+#define Perl_vload_module DPPP_(my_vload_module)
+
+#if defined(NEED_vload_module) || defined(NEED_vload_module_GLOBAL)
+
+void
+DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
+{
+ dTHR;
+ dVAR;
+ OP *veop, *imop;
+
+ OP * const modname = newSVOP(OP_CONST, 0, name);
+ /* 5.005 has a somewhat hacky force_normal that doesn't croak on
+ SvREADONLY() if PL_compling is true. Current perls take care in
+ ck_require() to correctly turn off SvREADONLY before calling
+ force_normal_flags(). This seems a better fix than fudging PL_compling
+ */
+ SvREADONLY_off(((SVOP*)modname)->op_sv);
+ modname->op_private |= OPpCONST_BARE;
+ if (ver) {
+ veop = newSVOP(OP_CONST, 0, ver);
+ }
+ else
+ veop = NULL;
+ if (flags & PERL_LOADMOD_NOIMPORT) {
+ imop = sawparens(newNULLLIST());
+ }
+ else if (flags & PERL_LOADMOD_IMPORT_OPS) {
+ imop = va_arg(*args, OP*);
+ }
+ else {
+ SV *sv;
+ imop = NULL;
+ sv = va_arg(*args, SV*);
+ while (sv) {
+ imop = append_elem(OP_LIST, imop, newSVOP(OP_CONST, 0, sv));
+ sv = va_arg(*args, SV*);
+ }
+ }
+ {
+ const line_t ocopline = PL_copline;
+ COP * const ocurcop = PL_curcop;
+ const int oexpect = PL_expect;
+
+#if (PERL_BCDVERSION >= 0x5004000)
+ utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
+ veop, modname, imop);
+#elif (PERL_BCDVERSION > 0x5003000)
+ utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
+ veop, modname, imop);
+#else
+ utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
+ modname, imop);
#endif
-#ifndef SvPV_flags_mutable
-# define SvPV_flags_mutable(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
- sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
+ PL_expect = oexpect;
+ PL_copline = ocopline;
+ PL_curcop = ocurcop;
+ }
+}
+
#endif
-#ifndef SvPV_force
-# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
#endif
-#ifndef SvPV_force_nolen
-# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
+#ifndef load_module
+#if defined(NEED_load_module)
+static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
+static
+#else
+extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
#endif
-#ifndef SvPV_force_mutable
-# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
+#ifdef load_module
+# undef load_module
#endif
+#define load_module DPPP_(my_load_module)
+#define Perl_load_module DPPP_(my_load_module)
-#ifndef SvPV_force_nomg
-# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
-#endif
+#if defined(NEED_load_module) || defined(NEED_load_module_GLOBAL)
+
+void
+DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...)
+{
+ va_list args;
+ va_start(args, ver);
+ vload_module(flags, name, ver, &args);
+ va_end(args);
+}
-#ifndef SvPV_force_nomg_nolen
-# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
#endif
-#ifndef SvPV_force_flags
-# define SvPV_force_flags(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
#endif
-#ifndef SvPV_force_flags_nolen
-# define SvPV_force_flags_nolen(sv, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
+#ifndef newRV_inc
+# define newRV_inc(sv) newRV(sv) /* Replace */
#endif
-#ifndef SvPV_force_flags_mutable
-# define SvPV_force_flags_mutable(sv, lp, flags) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
- ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
- : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
+
+#ifndef newRV_noinc
+#if defined(NEED_newRV_noinc)
+static SV * DPPP_(my_newRV_noinc)(SV *sv);
+static
+#else
+extern SV * DPPP_(my_newRV_noinc)(SV *sv);
#endif
-#ifndef SvPV_nolen
-# define SvPV_nolen(sv) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
+
+#ifdef newRV_noinc
+# undef newRV_noinc
#endif
-#ifndef SvPV_nolen_const
-# define SvPV_nolen_const(sv) \
- ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
+#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_(my_newRV_noinc)(SV *sv)
+{
+ SV *rv = (SV *)newRV(sv);
+ SvREFCNT_dec(sv);
+ return rv;
+}
#endif
-#ifndef SvPV_nomg
-# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
#endif
-#ifndef SvPV_nomg_const
-# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
+/* Hint: newCONSTSUB
+ * Returns a CV* as of perl-5.7.1. This return value is not supported
+ * by Devel::PPPort.
+ */
+
+/* newCONSTSUB from IO.xs is in the core starting with 5.004_63 */
+#if (PERL_BCDVERSION < 0x5004063) && (PERL_BCDVERSION != 0x5004005)
+#if defined(NEED_newCONSTSUB)
+static void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
+static
+#else
+extern void DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv);
#endif
-#ifndef SvPV_nomg_const_nolen
-# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
+#ifdef newCONSTSUB
+# undef newCONSTSUB
#endif
+#define newCONSTSUB(a,b,c) DPPP_(my_newCONSTSUB)(aTHX_ a,b,c)
+#define Perl_newCONSTSUB DPPP_(my_newCONSTSUB)
-#ifndef SvPV_nomg_nolen
-# define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
- ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, 0))
+#if defined(NEED_newCONSTSUB) || defined(NEED_newCONSTSUB_GLOBAL)
+
+/* This is just a trick to avoid a dependency of newCONSTSUB on PL_parser */
+/* (There's no PL_parser in perl < 5.005, so this is completely safe) */
+#define D_PPP_PL_copline PL_copline
+
+void
+DPPP_(my_newCONSTSUB)(HV *stash, const char *name, SV *sv)
+{
+ U32 oldhints = PL_hints;
+ HV *old_cop_stash = PL_curcop->cop_stash;
+ HV *old_curstash = PL_curstash;
+ line_t oldline = PL_curcop->cop_line;
+ PL_curcop->cop_line = D_PPP_PL_copline;
+
+ PL_hints &= ~HINT_BLOCK_SCOPE;
+ if (stash)
+ PL_curstash = PL_curcop->cop_stash = stash;
+
+ newSUB(
+
+#if (PERL_BCDVERSION < 0x5003022)
+ start_subparse(),
+#elif (PERL_BCDVERSION == 0x5003022)
+ start_subparse(0),
+#else /* 5.003_23 onwards */
+ start_subparse(FALSE, 0),
#endif
-#ifndef SvPV_renew
-# define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
- SvPV_set((sv), (char *) saferealloc( \
- (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
- } STMT_END
+
+ newSVOP(OP_CONST, 0, newSVpv((char *) name, 0)),
+ newSVOP(OP_CONST, 0, &PL_sv_no), /* SvPV(&PL_sv_no) == "" -- GMB */
+ newSTATEOP(0, Nullch, newSVOP(OP_CONST, 0, sv))
+ );
+
+ PL_hints = oldhints;
+ PL_curcop->cop_stash = old_cop_stash;
+ PL_curstash = old_curstash;
+ PL_curcop->cop_line = oldline;
+}
#endif
-#ifndef SvMAGIC_set
-# define SvMAGIC_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
- (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
#endif
-#if (PERL_BCDVERSION < 0x5009003)
-#ifndef SvPVX_const
-# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
+/*
+ * Boilerplate macros for initializing and accessing interpreter-local
+ * data from C. All statics in extensions should be reworked to use
+ * this, if you want to make the extension thread-safe. See ext/re/re.xs
+ * for an example of the use of these macros.
+ *
+ * Code that uses these macros is responsible for the following:
+ * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
+ * 2. Declare a typedef named my_cxt_t that is a structure that contains
+ * all the data that needs to be interpreter-local.
+ * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t.
+ * 4. Use the MY_CXT_INIT macro such that it is called exactly once
+ * (typically put in the BOOT: section).
+ * 5. Use the members of the my_cxt_t structure everywhere as
+ * MY_CXT.member.
+ * 6. Use the dMY_CXT macro (a declaration) in all the functions that
+ * access MY_CXT.
+ */
+
+#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 START_MY_CXT
+
+#if (PERL_BCDVERSION < 0x5004068)
+/* Fetches the SV that keeps the per-interpreter data. */
+#define dMY_CXT_SV \
+ SV *my_cxt_sv = get_sv(MY_CXT_KEY, FALSE)
+#else /* >= perl5.004_68 */
+#define dMY_CXT_SV \
+ SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
+ sizeof(MY_CXT_KEY)-1, TRUE)
+#endif /* < perl5.004_68 */
+
+/* This declaration should be used within all functions that use the
+ * interpreter-local data. */
+#define dMY_CXT \
+ dMY_CXT_SV; \
+ my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*,SvUV(my_cxt_sv))
+
+/* Creates and zeroes the per-interpreter data.
+ * (We allocate my_cxtp in a Perl SV so that it will be released when
+ * the interpreter goes away.) */
+#define MY_CXT_INIT \
+ dMY_CXT_SV; \
+ /* newSV() allocates one more than needed */ \
+ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+ Zero(my_cxtp, 1, my_cxt_t); \
+ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+
+/* This macro must be used to access members of the my_cxt_t structure.
+ * e.g. MYCXT.some_data */
+#define MY_CXT (*my_cxtp)
+
+/* Judicious use of these macros can reduce the number of times dMY_CXT
+ * is used. Use is similar to pTHX, aTHX etc. */
+#define pMY_CXT my_cxt_t *my_cxtp
+#define pMY_CXT_ pMY_CXT,
+#define _pMY_CXT ,pMY_CXT
+#define aMY_CXT my_cxtp
+#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
-#ifndef SvPVX_mutable
-# define SvPVX_mutable(sv) (0 + SvPVX(sv))
+#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 MY_CXT_INIT NOOP
+#define MY_CXT my_cxt
+
+#define pMY_CXT void
+#define pMY_CXT_
+#define _pMY_CXT
+#define aMY_CXT
+#define aMY_CXT_
+#define _aMY_CXT
+
+#endif /* START_MY_CXT */
+
+#ifndef MY_CXT_CLONE
+#define MY_CXT_CLONE NOOP
#endif
-#ifndef SvRV_set
-# define SvRV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
- (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
+
#endif
-#else
-#ifndef SvPVX_const
-# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
+#ifndef SvREFCNT_inc
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc(sv) \
+ ({ \
+ SV * const _sv = (SV*)(sv); \
+ if (_sv) \
+ (SvREFCNT(_sv))++; \
+ _sv; \
+ })
+# else
+# define SvREFCNT_inc(sv) \
+ ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
+# endif
#endif
-#ifndef SvPVX_mutable
-# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
+#ifndef SvREFCNT_inc_simple
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc_simple(sv) \
+ ({ \
+ if (sv) \
+ (SvREFCNT(sv))++; \
+ (SV *)(sv); \
+ })
+# else
+# define SvREFCNT_inc_simple(sv) \
+ ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
+# endif
#endif
-#ifndef SvRV_set
-# define SvRV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
- ((sv)->sv_u.svu_rv = (val)); } STMT_END
+
+#ifndef SvREFCNT_inc_NN
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc_NN(sv) \
+ ({ \
+ SV * const _sv = (SV*)(sv); \
+ SvREFCNT(_sv)++; \
+ _sv; \
+ })
+# else
+# define SvREFCNT_inc_NN(sv) \
+ (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
+# endif
#endif
+#ifndef SvREFCNT_inc_void
+# ifdef PERL_USE_GCC_BRACE_GROUPS
+# define SvREFCNT_inc_void(sv) \
+ ({ \
+ SV * const _sv = (SV*)(sv); \
+ if (_sv) \
+ (void)(SvREFCNT(_sv)++); \
+ })
+# else
+# define SvREFCNT_inc_void(sv) \
+ (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
+# endif
#endif
-#ifndef SvSTASH_set
-# define SvSTASH_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
- (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
+#ifndef SvREFCNT_inc_simple_void
+# define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
#endif
-#if (PERL_BCDVERSION < 0x5004000)
-#ifndef SvUV_set
-# define SvUV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
- (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
+#ifndef SvREFCNT_inc_simple_NN
+# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
#endif
-#else
-#ifndef SvUV_set
-# define SvUV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
- (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
+#ifndef SvREFCNT_inc_void_NN
+# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
#endif
+#ifndef SvREFCNT_inc_simple_void_NN
+# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
#endif
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
-#if defined(NEED_vnewSVpvf)
-static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
+#ifndef newSV_type
+
+#if defined(NEED_newSV_type)
+static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
static
#else
-extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
+extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
#endif
-#ifdef vnewSVpvf
-# undef vnewSVpvf
+#ifdef newSV_type
+# undef newSV_type
#endif
-#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
-#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
+#define newSV_type(a) DPPP_(my_newSV_type)(aTHX_ a)
+#define Perl_newSV_type DPPP_(my_newSV_type)
-#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
+#if defined(NEED_newSV_type) || defined(NEED_newSV_type_GLOBAL)
-SV *
-DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
+SV*
+DPPP_(my_newSV_type)(pTHX_ svtype const t)
{
- register SV *sv = newSV(0);
- sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
+ SV* const sv = newSV(0);
+ sv_upgrade(sv, t);
return sv;
}
#endif
-#endif
-
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
-# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
-#endif
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
-# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
#endif
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_catpvf_mg)
-#if defined(NEED_sv_catpvf_mg)
-static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
-static
+#if (PERL_BCDVERSION < 0x5006000)
+# define D_PPP_CONSTPV_ARG(x) ((char *) (x))
#else
-extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+# define D_PPP_CONSTPV_ARG(x) (x)
#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);
-}
-
+#ifndef newSVpvn
+# define newSVpvn(data,len) ((data) \
+ ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \
+ : newSV(0))
+#endif
+#ifndef newSVpvn_utf8
+# define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
#endif
+#ifndef SVf_UTF8
+# define SVf_UTF8 0
#endif
-#ifdef PERL_IMPLICIT_CONTEXT
-#if (PERL_BCDVERSION >= 0x5004000) && !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, ...);
+#ifndef newSVpvn_flags
+
+#if defined(NEED_newSVpvn_flags)
+static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
static
#else
-extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
+extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
#endif
-#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
-#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
+#ifdef newSVpvn_flags
+# undef newSVpvn_flags
+#endif
+#define newSVpvn_flags(a,b,c) DPPP_(my_newSVpvn_flags)(aTHX_ a,b,c)
+#define Perl_newSVpvn_flags DPPP_(my_newSVpvn_flags)
-#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
+#if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
-void
-DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
+SV *
+DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
{
- 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);
+ SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
+ SvFLAGS(sv) |= (flags & SVf_UTF8);
+ return (flags & SVs_TEMP) ? sv_2mortal(sv) : sv;
}
#endif
-#endif
+
#endif
-/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
-#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
+/* Backwards compatibility stuff... :-( */
+#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
+# define NEED_sv_2pv_flags
+#endif
+#if !defined(NEED_sv_2pv_flags_GLOBAL) && defined(NEED_sv_2pv_nolen_GLOBAL)
+# define NEED_sv_2pv_flags_GLOBAL
#endif
-#if (PERL_BCDVERSION >= 0x5004000) && !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
+/* Hint: sv_2pv_nolen
+ * Use the SvPV_nolen() or SvPV_nolen_const() macros instead of sv_2pv_nolen().
+ */
+#ifndef sv_2pv_nolen
+# define sv_2pv_nolen(sv) SvPV_nolen(sv)
#endif
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_setpvf_mg)
-#if defined(NEED_sv_setpvf_mg)
-static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+#ifdef SvPVbyte
+
+/* Hint: SvPVbyte
+ * Does not work in perl-5.6.1, ppport.h implements a version
+ * borrowed from perl-5.7.3.
+ */
+
+#if (PERL_BCDVERSION < 0x5007000)
+
+#if defined(NEED_sv_2pvbyte)
+static char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
static
#else
-extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
#endif
-#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
+#ifdef sv_2pvbyte
+# undef sv_2pvbyte
+#endif
+#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
+#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
-#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
+#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
-void
-DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
+char *
+DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
{
- va_list args;
- va_start(args, pat);
- sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
- SvSETMAGIC(sv);
- va_end(args);
+ sv_utf8_downgrade(sv,0);
+ return SvPV(sv,*lp);
}
#endif
+
+/* Hint: sv_2pvbyte
+ * Use the SvPVbyte() macro instead of sv_2pvbyte().
+ */
+
+#undef SvPVbyte
+
+#define SvPVbyte(sv, lp) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
+
#endif
-#ifdef PERL_IMPLICIT_CONTEXT
-#if (PERL_BCDVERSION >= 0x5004000) && !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, ...);
+
+# define SvPVbyte SvPV
+# define sv_2pvbyte sv_2pv
+
+#endif
+#ifndef sv_2pvbyte_nolen
+# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
#endif
-#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
-#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
+/* Hint: sv_pvn
+ * Always use the SvPV() macro instead of sv_pvn().
+ */
-#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
+/* Hint: sv_pvn_force
+ * Always use the SvPV_force() macro instead of sv_pvn_force().
+ */
-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);
-}
+/* If these are undefined, they're not handled by the core anyway */
+#ifndef SV_IMMEDIATE_UNREF
+# define SV_IMMEDIATE_UNREF 0
+#endif
+
+#ifndef SV_GMAGIC
+# define SV_GMAGIC 0
+#endif
+#ifndef SV_COW_DROP_PV
+# define SV_COW_DROP_PV 0
#endif
+
+#ifndef SV_UTF8_NO_ENCODING
+# define SV_UTF8_NO_ENCODING 0
#endif
+
+#ifndef SV_NOSTEAL
+# define SV_NOSTEAL 0
#endif
-/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
-#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
+#ifndef SV_CONST_RETURN
+# define SV_CONST_RETURN 0
#endif
-#if (PERL_BCDVERSION >= 0x5004000) && !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
+#ifndef SV_MUTABLE_RETURN
+# define SV_MUTABLE_RETURN 0
+#endif
+
+#ifndef SV_SMAGIC
+# define SV_SMAGIC 0
#endif
-/* Hint: newSVpvn_share
- * The SVs created by this function only mimic the behaviour of
- * shared PVs without really being shared. Only use if you know
- * what you're doing.
- */
+#ifndef SV_HAS_TRAILING_NUL
+# define SV_HAS_TRAILING_NUL 0
+#endif
-#ifndef newSVpvn_share
+#ifndef SV_COW_SHARED_HASH_KEYS
+# define SV_COW_SHARED_HASH_KEYS 0
+#endif
-#if defined(NEED_newSVpvn_share)
-static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
+#if (PERL_BCDVERSION < 0x5007002)
+
+#if defined(NEED_sv_2pv_flags)
+static char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
static
#else
-extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
+extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
#endif
-#ifdef newSVpvn_share
-# undef newSVpvn_share
+#ifdef sv_2pv_flags
+# undef sv_2pv_flags
#endif
-#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
-#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
+#define sv_2pv_flags(a,b,c) DPPP_(my_sv_2pv_flags)(aTHX_ a,b,c)
+#define Perl_sv_2pv_flags DPPP_(my_sv_2pv_flags)
-#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
+#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
-SV *
-DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
+char *
+DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
{
- SV *sv;
- if (len < 0)
- len = -len;
- if (!hash)
- PERL_HASH(hash, (char*) src, len);
- sv = newSVpvn((char *) src, len);
- sv_upgrade(sv, SVt_PVIV);
- SvIVX(sv) = hash;
- SvREADONLY_on(sv);
- SvPOK_on(sv);
- return sv;
+ STRLEN n_a = (STRLEN) flags;
+ return sv_2pv(sv, lp ? lp : &n_a);
}
#endif
-#endif
-#ifndef SvSHARED_HASH
-# define SvSHARED_HASH(sv) (0 + SvUVX(sv))
-#endif
-#ifndef HvNAME_get
-# define HvNAME_get(hv) HvNAME(hv)
-#endif
-#ifndef HvNAMELEN_get
-# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
-#endif
-
-#ifndef gv_fetchpvn_flags
-#if defined(NEED_gv_fetchpvn_flags)
-static GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types);
+#if defined(NEED_sv_pvn_force_flags)
+static char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
static
#else
-extern GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types);
+extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
#endif
-#ifdef gv_fetchpvn_flags
-# undef gv_fetchpvn_flags
+#ifdef sv_pvn_force_flags
+# undef sv_pvn_force_flags
#endif
-#define gv_fetchpvn_flags(a,b,c,d) DPPP_(my_gv_fetchpvn_flags)(aTHX_ a,b,c,d)
-#define Perl_gv_fetchpvn_flags DPPP_(my_gv_fetchpvn_flags)
+#define sv_pvn_force_flags(a,b,c) DPPP_(my_sv_pvn_force_flags)(aTHX_ a,b,c)
+#define Perl_sv_pvn_force_flags DPPP_(my_sv_pvn_force_flags)
-#if defined(NEED_gv_fetchpvn_flags) || defined(NEED_gv_fetchpvn_flags_GLOBAL)
+#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
-GV*
-DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types) {
- char *namepv = savepvn(name, len);
- GV* stash = gv_fetchpv(namepv, TRUE, SVt_PVHV);
- Safefree(namepv);
- return stash;
+char *
+DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
+{
+ STRLEN n_a = (STRLEN) flags;
+ return sv_pvn_force(sv, lp ? lp : &n_a);
}
#endif
-#endif
-#ifndef GvSVn
-# define GvSVn(gv) GvSV(gv)
-#endif
-#ifndef isGV_with_GP
-# define isGV_with_GP(gv) isGV(gv)
#endif
-#ifndef gv_fetchsv
-# define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
+#if (PERL_BCDVERSION < 0x5008008) || ( (PERL_BCDVERSION >= 0x5009000) && (PERL_BCDVERSION < 0x5009003) )
+# define DPPP_SVPV_NOLEN_LP_ARG &PL_na
+#else
+# define DPPP_SVPV_NOLEN_LP_ARG 0
#endif
-#ifndef get_cvn_flags
-# define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
+#ifndef SvPV_const
+# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
#endif
-#ifndef gv_init_pvn
-# define gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE)
+#ifndef SvPV_mutable
+# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
#endif
-#ifndef WARN_ALL
-# define WARN_ALL 0
+#ifndef SvPV_flags
+# define SvPV_flags(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
#endif
-
-#ifndef WARN_CLOSURE
-# define WARN_CLOSURE 1
+#ifndef SvPV_flags_const
+# define SvPV_flags_const(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
+ (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
#endif
-
-#ifndef WARN_DEPRECATED
-# define WARN_DEPRECATED 2
+#ifndef SvPV_flags_const_nolen
+# define SvPV_flags_const_nolen(sv, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX_const(sv) : \
+ (const char*) sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags|SV_CONST_RETURN))
#endif
-
-#ifndef WARN_EXITING
-# define WARN_EXITING 3
+#ifndef SvPV_flags_mutable
+# define SvPV_flags_mutable(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
+ sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
#endif
-
-#ifndef WARN_GLOB
-# define WARN_GLOB 4
+#ifndef SvPV_force
+# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
#endif
-#ifndef WARN_IO
-# define WARN_IO 5
+#ifndef SvPV_force_nolen
+# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
#endif
-#ifndef WARN_CLOSED
-# define WARN_CLOSED 6
+#ifndef SvPV_force_mutable
+# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
#endif
-#ifndef WARN_EXEC
-# define WARN_EXEC 7
+#ifndef SvPV_force_nomg
+# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
#endif
-#ifndef WARN_LAYER
-# define WARN_LAYER 8
+#ifndef SvPV_force_nomg_nolen
+# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
#endif
-
-#ifndef WARN_NEWLINE
-# define WARN_NEWLINE 9
+#ifndef SvPV_force_flags
+# define SvPV_force_flags(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
#endif
-
-#ifndef WARN_PIPE
-# define WARN_PIPE 10
+#ifndef SvPV_force_flags_nolen
+# define SvPV_force_flags_nolen(sv, flags) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
+ ? SvPVX(sv) : sv_pvn_force_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, flags))
#endif
-
-#ifndef WARN_UNOPENED
-# define WARN_UNOPENED 11
+#ifndef SvPV_force_flags_mutable
+# define SvPV_force_flags_mutable(sv, lp, flags) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
+ ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
+ : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
#endif
-
-#ifndef WARN_MISC
-# define WARN_MISC 12
+#ifndef SvPV_nolen
+# define SvPV_nolen(sv) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC))
#endif
-
-#ifndef WARN_NUMERIC
-# define WARN_NUMERIC 13
+#ifndef SvPV_nolen_const
+# define SvPV_nolen_const(sv) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX_const(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, SV_GMAGIC|SV_CONST_RETURN))
#endif
-
-#ifndef WARN_ONCE
-# define WARN_ONCE 14
+#ifndef SvPV_nomg
+# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
#endif
-#ifndef WARN_OVERFLOW
-# define WARN_OVERFLOW 15
+#ifndef SvPV_nomg_const
+# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
#endif
-#ifndef WARN_PACK
-# define WARN_PACK 16
+#ifndef SvPV_nomg_const_nolen
+# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
#endif
-#ifndef WARN_PORTABLE
-# define WARN_PORTABLE 17
+#ifndef SvPV_nomg_nolen
+# define SvPV_nomg_nolen(sv) ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX(sv) : sv_2pv_flags(sv, DPPP_SVPV_NOLEN_LP_ARG, 0))
#endif
-
-#ifndef WARN_RECURSION
-# define WARN_RECURSION 18
+#ifndef SvPV_renew
+# define SvPV_renew(sv,n) STMT_START { SvLEN_set(sv, n); \
+ SvPV_set((sv), (char *) saferealloc( \
+ (Malloc_t)SvPVX(sv), (MEM_SIZE)((n)))); \
+ } STMT_END
#endif
-
-#ifndef WARN_REDEFINE
-# define WARN_REDEFINE 19
+#ifndef SvMAGIC_set
+# define SvMAGIC_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
+ (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END
#endif
-#ifndef WARN_REGEXP
-# define WARN_REGEXP 20
+#if (PERL_BCDVERSION < 0x5009003)
+#ifndef SvPVX_const
+# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
#endif
-#ifndef WARN_SEVERE
-# define WARN_SEVERE 21
+#ifndef SvPVX_mutable
+# define SvPVX_mutable(sv) (0 + SvPVX(sv))
#endif
-
-#ifndef WARN_DEBUGGING
-# define WARN_DEBUGGING 22
+#ifndef SvRV_set
+# define SvRV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
+ (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
#endif
-#ifndef WARN_INPLACE
-# define WARN_INPLACE 23
+#else
+#ifndef SvPVX_const
+# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
#endif
-#ifndef WARN_INTERNAL
-# define WARN_INTERNAL 24
+#ifndef SvPVX_mutable
+# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
+#endif
+#ifndef SvRV_set
+# define SvRV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
+ ((sv)->sv_u.svu_rv = (val)); } STMT_END
#endif
-#ifndef WARN_MALLOC
-# define WARN_MALLOC 25
#endif
-
-#ifndef WARN_SIGNAL
-# define WARN_SIGNAL 26
+#ifndef SvSTASH_set
+# define SvSTASH_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
+ (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END
#endif
-#ifndef WARN_SUBSTR
-# define WARN_SUBSTR 27
+#if (PERL_BCDVERSION < 0x5004000)
+#ifndef SvUV_set
+# define SvUV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
+ (((XPVIV*) SvANY(sv))->xiv_iv = (IV) (val)); } STMT_END
#endif
-#ifndef WARN_SYNTAX
-# define WARN_SYNTAX 28
+#else
+#ifndef SvUV_set
+# define SvUV_set(sv, val) \
+ STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
+ (((XPVUV*) SvANY(sv))->xuv_uv = (val)); } STMT_END
#endif
-#ifndef WARN_AMBIGUOUS
-# define WARN_AMBIGUOUS 29
#endif
-#ifndef WARN_BAREWORD
-# define WARN_BAREWORD 30
+#if (PERL_BCDVERSION >= 0x5004000) && !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
-#ifndef WARN_DIGIT
-# define WARN_DIGIT 31
+#ifdef vnewSVpvf
+# undef vnewSVpvf
#endif
+#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
+#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
-#ifndef WARN_PARENTHESIS
-# define WARN_PARENTHESIS 32
-#endif
+#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
-#ifndef WARN_PRECEDENCE
-# define WARN_PRECEDENCE 33
-#endif
+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;
+}
-#ifndef WARN_PRINTF
-# define WARN_PRINTF 34
#endif
-
-#ifndef WARN_PROTOTYPE
-# define WARN_PROTOTYPE 35
#endif
-#ifndef WARN_QW
-# define WARN_QW 36
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vcatpvf)
+# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
#endif
-#ifndef WARN_RESERVED
-# define WARN_RESERVED 37
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(sv_vsetpvf)
+# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
#endif
-#ifndef WARN_SEMICOLON
-# define WARN_SEMICOLON 38
+#if (PERL_BCDVERSION >= 0x5004000) && !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
-#ifndef WARN_TAINT
-# define WARN_TAINT 39
-#endif
+#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
-#ifndef WARN_THREADS
-# define WARN_THREADS 40
-#endif
+#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
-#ifndef WARN_UNINITIALIZED
-# define WARN_UNINITIALIZED 41
-#endif
+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);
+}
-#ifndef WARN_UNPACK
-# define WARN_UNPACK 42
#endif
-
-#ifndef WARN_UNTIE
-# define WARN_UNTIE 43
#endif
-#ifndef WARN_UTF8
-# define WARN_UTF8 44
+#ifdef PERL_IMPLICIT_CONTEXT
+#if (PERL_BCDVERSION >= 0x5004000) && !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
-#ifndef WARN_VOID
-# define WARN_VOID 45
-#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);
+}
-#ifndef WARN_ASSERTIONS
-# define WARN_ASSERTIONS 46
#endif
-#ifndef packWARN
-# define packWARN(a) (a)
+#endif
#endif
-#ifndef ckWARN
-# ifdef G_WARN_ON
-# define ckWARN(a) (PL_dowarn & G_WARN_ON)
+/* sv_catpvf_mg depends on sv_catpvf_mg_nocontext */
+#ifndef sv_catpvf_mg
+# ifdef PERL_IMPLICIT_CONTEXT
+# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext
# else
-# define ckWARN(a) PL_dowarn
+# define sv_catpvf_mg Perl_sv_catpvf_mg
# endif
#endif
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
-#if defined(NEED_warner)
-static void DPPP_(my_warner)(U32 err, const char *pat, ...);
+#if (PERL_BCDVERSION >= 0x5004000) && !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
+
+#if (PERL_BCDVERSION >= 0x5004000) && !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_warner)(U32 err, const char *pat, ...);
+extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
#endif
-#define Perl_warner DPPP_(my_warner)
+#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
-#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
+#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
void
-DPPP_(my_warner)(U32 err, const char *pat, ...)
+DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
{
- SV *sv;
va_list args;
-
- PERL_UNUSED_ARG(err);
-
va_start(args, pat);
- sv = vnewSVpvf(pat, &args);
+ sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
+ SvSETMAGIC(sv);
va_end(args);
- sv_2mortal(sv);
- warn("%s", SvPV_nolen(sv));
}
-#define warner Perl_warner
-
-#define Perl_warner_nocontext Perl_warner
-
-#endif
-#endif
-
-/* concatenating with "" ensures that only literal strings are accepted as argument
- * note that STR_WITH_LEN() can't be used as argument to macros or functions that
- * under some configurations might be macros
- */
-#ifndef STR_WITH_LEN
-# define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
#endif
-#ifndef newSVpvs
-# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
#endif
-#ifndef newSVpvs_flags
-# define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
+#ifdef PERL_IMPLICIT_CONTEXT
+#if (PERL_BCDVERSION >= 0x5004000) && !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
-#ifndef newSVpvs_share
-# define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
-#endif
+#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
+#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
-#ifndef sv_catpvs
-# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
-#endif
+#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
-#ifndef sv_setpvs
-# define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
-#endif
+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);
+}
-#ifndef hv_fetchs
-# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
#endif
-
-#ifndef hv_stores
-# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
#endif
-#ifndef gv_fetchpvs
-# define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
#endif
-#ifndef gv_stashpvs
-# define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
-#endif
-#ifndef get_cvs
-# define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
-#endif
-#ifndef SvGETMAGIC
-# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
+/* sv_setpvf_mg depends on sv_setpvf_mg_nocontext */
+#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
-/* Some random bits for sv_unmagicext. These should probably be pulled in for
- real and organized at some point */
-#ifndef HEf_SVKEY
-# define HEf_SVKEY -2
+#if (PERL_BCDVERSION >= 0x5004000) && !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 MUTABLE_PTR
-#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define MUTABLE_PTR(p) ({ void *_p = (p); _p; })
+/* Hint: newSVpvn_share
+ * The SVs created by this function only mimic the behaviour of
+ * shared PVs without really being shared. Only use if you know
+ * what you're doing.
+ */
+
+#ifndef newSVpvn_share
+
+#if defined(NEED_newSVpvn_share)
+static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
+static
#else
-# define MUTABLE_PTR(p) ((void *) (p))
-#endif
-#endif
-#ifndef MUTABLE_SV
-# define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
+extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
#endif
-/* end of random bits */
-#ifndef PERL_MAGIC_sv
-# define PERL_MAGIC_sv '\0'
+#ifdef newSVpvn_share
+# undef newSVpvn_share
#endif
+#define newSVpvn_share(a,b,c) DPPP_(my_newSVpvn_share)(aTHX_ a,b,c)
+#define Perl_newSVpvn_share DPPP_(my_newSVpvn_share)
-#ifndef PERL_MAGIC_overload
-# define PERL_MAGIC_overload 'A'
-#endif
+#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
-#ifndef PERL_MAGIC_overload_elem
-# define PERL_MAGIC_overload_elem 'a'
-#endif
+SV *
+DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
+{
+ SV *sv;
+ if (len < 0)
+ len = -len;
+ if (!hash)
+ PERL_HASH(hash, (char*) src, len);
+ sv = newSVpvn((char *) src, len);
+ sv_upgrade(sv, SVt_PVIV);
+ SvIVX(sv) = hash;
+ SvREADONLY_on(sv);
+ SvPOK_on(sv);
+ return sv;
+}
-#ifndef PERL_MAGIC_overload_table
-# define PERL_MAGIC_overload_table 'c'
#endif
-#ifndef PERL_MAGIC_bm
-# define PERL_MAGIC_bm 'B'
#endif
-
-#ifndef PERL_MAGIC_regdata
-# define PERL_MAGIC_regdata 'D'
+#ifndef SvSHARED_HASH
+# define SvSHARED_HASH(sv) (0 + SvUVX(sv))
#endif
-
-#ifndef PERL_MAGIC_regdatum
-# define PERL_MAGIC_regdatum 'd'
+#ifndef HvNAME_get
+# define HvNAME_get(hv) HvNAME(hv)
#endif
-
-#ifndef PERL_MAGIC_env
-# define PERL_MAGIC_env 'E'
+#ifndef HvNAMELEN_get
+# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
#endif
-#ifndef PERL_MAGIC_envelem
-# define PERL_MAGIC_envelem 'e'
+#ifndef gv_fetchpvn_flags
+#if defined(NEED_gv_fetchpvn_flags)
+static GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types);
+static
+#else
+extern GV* DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types);
#endif
-#ifndef PERL_MAGIC_fm
-# define PERL_MAGIC_fm 'f'
+#ifdef gv_fetchpvn_flags
+# undef gv_fetchpvn_flags
#endif
+#define gv_fetchpvn_flags(a,b,c,d) DPPP_(my_gv_fetchpvn_flags)(aTHX_ a,b,c,d)
+#define Perl_gv_fetchpvn_flags DPPP_(my_gv_fetchpvn_flags)
-#ifndef PERL_MAGIC_regex_global
-# define PERL_MAGIC_regex_global 'g'
-#endif
+#if defined(NEED_gv_fetchpvn_flags) || defined(NEED_gv_fetchpvn_flags_GLOBAL)
-#ifndef PERL_MAGIC_isa
-# define PERL_MAGIC_isa 'I'
-#endif
+GV*
+DPPP_(my_gv_fetchpvn_flags)(pTHX_ const char* name, STRLEN len, int flags, int types) {
+ char *namepv = savepvn(name, len);
+ GV* stash = gv_fetchpv(namepv, TRUE, SVt_PVHV);
+ Safefree(namepv);
+ return stash;
+}
-#ifndef PERL_MAGIC_isaelem
-# define PERL_MAGIC_isaelem 'i'
+#endif
+#endif
+#ifndef GvSVn
+# define GvSVn(gv) GvSV(gv)
#endif
-#ifndef PERL_MAGIC_nkeys
-# define PERL_MAGIC_nkeys 'k'
+#ifndef isGV_with_GP
+# define isGV_with_GP(gv) isGV(gv)
#endif
-#ifndef PERL_MAGIC_dbfile
-# define PERL_MAGIC_dbfile 'L'
+#ifndef gv_fetchsv
+# define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
+#endif
+#ifndef get_cvn_flags
+# define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
#endif
-#ifndef PERL_MAGIC_dbline
-# define PERL_MAGIC_dbline 'l'
+#ifndef gv_init_pvn
+# define gv_init_pvn(gv, stash, ptr, len, flags) gv_init(gv, stash, ptr, len, flags & GV_ADDMULTI ? TRUE : FALSE)
+#endif
+#ifndef WARN_ALL
+# define WARN_ALL 0
#endif
-#ifndef PERL_MAGIC_mutex
-# define PERL_MAGIC_mutex 'm'
+#ifndef WARN_CLOSURE
+# define WARN_CLOSURE 1
#endif
-#ifndef PERL_MAGIC_shared
-# define PERL_MAGIC_shared 'N'
+#ifndef WARN_DEPRECATED
+# define WARN_DEPRECATED 2
#endif
-#ifndef PERL_MAGIC_shared_scalar
-# define PERL_MAGIC_shared_scalar 'n'
+#ifndef WARN_EXITING
+# define WARN_EXITING 3
#endif
-#ifndef PERL_MAGIC_collxfrm
-# define PERL_MAGIC_collxfrm 'o'
+#ifndef WARN_GLOB
+# define WARN_GLOB 4
#endif
-#ifndef PERL_MAGIC_tied
-# define PERL_MAGIC_tied 'P'
+#ifndef WARN_IO
+# define WARN_IO 5
#endif
-#ifndef PERL_MAGIC_tiedelem
-# define PERL_MAGIC_tiedelem 'p'
+#ifndef WARN_CLOSED
+# define WARN_CLOSED 6
#endif
-#ifndef PERL_MAGIC_tiedscalar
-# define PERL_MAGIC_tiedscalar 'q'
+#ifndef WARN_EXEC
+# define WARN_EXEC 7
#endif
-#ifndef PERL_MAGIC_qr
-# define PERL_MAGIC_qr 'r'
+#ifndef WARN_LAYER
+# define WARN_LAYER 8
#endif
-#ifndef PERL_MAGIC_sig
-# define PERL_MAGIC_sig 'S'
+#ifndef WARN_NEWLINE
+# define WARN_NEWLINE 9
#endif
-#ifndef PERL_MAGIC_sigelem
-# define PERL_MAGIC_sigelem 's'
+#ifndef WARN_PIPE
+# define WARN_PIPE 10
#endif
-#ifndef PERL_MAGIC_taint
-# define PERL_MAGIC_taint 't'
+#ifndef WARN_UNOPENED
+# define WARN_UNOPENED 11
#endif
-#ifndef PERL_MAGIC_uvar
-# define PERL_MAGIC_uvar 'U'
+#ifndef WARN_MISC
+# define WARN_MISC 12
#endif
-#ifndef PERL_MAGIC_uvar_elem
-# define PERL_MAGIC_uvar_elem 'u'
+#ifndef WARN_NUMERIC
+# define WARN_NUMERIC 13
#endif
-#ifndef PERL_MAGIC_vstring
-# define PERL_MAGIC_vstring 'V'
+#ifndef WARN_ONCE
+# define WARN_ONCE 14
#endif
-#ifndef PERL_MAGIC_vec
-# define PERL_MAGIC_vec 'v'
+#ifndef WARN_OVERFLOW
+# define WARN_OVERFLOW 15
#endif
-#ifndef PERL_MAGIC_utf8
-# define PERL_MAGIC_utf8 'w'
+#ifndef WARN_PACK
+# define WARN_PACK 16
#endif
-#ifndef PERL_MAGIC_substr
-# define PERL_MAGIC_substr 'x'
+#ifndef WARN_PORTABLE
+# define WARN_PORTABLE 17
#endif
-#ifndef PERL_MAGIC_defelem
-# define PERL_MAGIC_defelem 'y'
+#ifndef WARN_RECURSION
+# define WARN_RECURSION 18
#endif
-#ifndef PERL_MAGIC_glob
-# define PERL_MAGIC_glob '*'
+#ifndef WARN_REDEFINE
+# define WARN_REDEFINE 19
#endif
-#ifndef PERL_MAGIC_arylen
-# define PERL_MAGIC_arylen '#'
+#ifndef WARN_REGEXP
+# define WARN_REGEXP 20
#endif
-#ifndef PERL_MAGIC_pos
-# define PERL_MAGIC_pos '.'
+#ifndef WARN_SEVERE
+# define WARN_SEVERE 21
#endif
-#ifndef PERL_MAGIC_backref
-# define PERL_MAGIC_backref '<'
+#ifndef WARN_DEBUGGING
+# define WARN_DEBUGGING 22
#endif
-#ifndef PERL_MAGIC_ext
-# define PERL_MAGIC_ext '~'
+#ifndef WARN_INPLACE
+# define WARN_INPLACE 23
#endif
-/* That's the best we can do... */
-#ifndef sv_catpvn_nomg
-# define sv_catpvn_nomg sv_catpvn
+#ifndef WARN_INTERNAL
+# define WARN_INTERNAL 24
#endif
-#ifndef sv_catsv_nomg
-# define sv_catsv_nomg sv_catsv
+#ifndef WARN_MALLOC
+# define WARN_MALLOC 25
#endif
-#ifndef sv_setsv_nomg
-# define sv_setsv_nomg sv_setsv
+#ifndef WARN_SIGNAL
+# define WARN_SIGNAL 26
#endif
-#ifndef sv_pvn_nomg
-# define sv_pvn_nomg sv_pvn
+#ifndef WARN_SUBSTR
+# define WARN_SUBSTR 27
#endif
-#ifndef SvIV_nomg
-# define SvIV_nomg SvIV
+#ifndef WARN_SYNTAX
+# define WARN_SYNTAX 28
#endif
-#ifndef SvUV_nomg
-# define SvUV_nomg SvUV
+#ifndef WARN_AMBIGUOUS
+# define WARN_AMBIGUOUS 29
#endif
-#ifndef sv_catpv_mg
-# define sv_catpv_mg(sv, ptr) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_catpv(TeMpSv,ptr); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
+#ifndef WARN_BAREWORD
+# define WARN_BAREWORD 30
#endif
-#ifndef sv_catpvn_mg
-# define sv_catpvn_mg(sv, ptr, len) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_catpvn(TeMpSv,ptr,len); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
+#ifndef WARN_DIGIT
+# define WARN_DIGIT 31
#endif
-#ifndef sv_catsv_mg
-# define sv_catsv_mg(dsv, ssv) \
- STMT_START { \
- SV *TeMpSv = dsv; \
- sv_catsv(TeMpSv,ssv); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
+#ifndef WARN_PARENTHESIS
+# define WARN_PARENTHESIS 32
#endif
-#ifndef sv_setiv_mg
-# define sv_setiv_mg(sv, i) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setiv(TeMpSv,i); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
+#ifndef WARN_PRECEDENCE
+# define WARN_PRECEDENCE 33
#endif
-#ifndef sv_setnv_mg
-# define sv_setnv_mg(sv, num) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setnv(TeMpSv,num); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
+#ifndef WARN_PRINTF
+# define WARN_PRINTF 34
#endif
-#ifndef sv_setpv_mg
-# define sv_setpv_mg(sv, ptr) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setpv(TeMpSv,ptr); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
+#ifndef WARN_PROTOTYPE
+# define WARN_PROTOTYPE 35
#endif
-#ifndef sv_setpvn_mg
-# define sv_setpvn_mg(sv, ptr, len) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setpvn(TeMpSv,ptr,len); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
+#ifndef WARN_QW
+# define WARN_QW 36
#endif
-#ifndef sv_setsv_mg
-# define sv_setsv_mg(dsv, ssv) \
- STMT_START { \
- SV *TeMpSv = dsv; \
- sv_setsv(TeMpSv,ssv); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
+#ifndef WARN_RESERVED
+# define WARN_RESERVED 37
#endif
-#ifndef sv_setuv_mg
-# define sv_setuv_mg(sv, i) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_setuv(TeMpSv,i); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
+#ifndef WARN_SEMICOLON
+# define WARN_SEMICOLON 38
#endif
-#ifndef sv_usepvn_mg
-# define sv_usepvn_mg(sv, ptr, len) \
- STMT_START { \
- SV *TeMpSv = sv; \
- sv_usepvn(TeMpSv,ptr,len); \
- SvSETMAGIC(TeMpSv); \
- } STMT_END
-#endif
-#ifndef SvVSTRING_mg
-# define SvVSTRING_mg(sv) (SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_vstring) : NULL)
+#ifndef WARN_TAINT
+# define WARN_TAINT 39
#endif
-/* Hint: sv_magic_portable
- * This is a compatibility function that is only available with
- * Devel::PPPort. It is NOT in the perl core.
- * Its purpose is to mimic the 5.8.0 behaviour of sv_magic() when
- * it is being passed a name pointer with namlen == 0. In that
- * case, perl 5.8.0 and later store the pointer, not a copy of it.
- * The compatibility can be provided back to perl 5.004. With
- * earlier versions, the code will not compile.
- */
+#ifndef WARN_THREADS
+# define WARN_THREADS 40
+#endif
-#if (PERL_BCDVERSION < 0x5004000)
+#ifndef WARN_UNINITIALIZED
+# define WARN_UNINITIALIZED 41
+#endif
- /* code that uses sv_magic_portable will not compile */
+#ifndef WARN_UNPACK
+# define WARN_UNPACK 42
+#endif
-#elif (PERL_BCDVERSION < 0x5008000)
+#ifndef WARN_UNTIE
+# define WARN_UNTIE 43
+#endif
-# define sv_magic_portable(sv, obj, how, name, namlen) \
- STMT_START { \
- SV *SvMp_sv = (sv); \
- char *SvMp_name = (char *) (name); \
- I32 SvMp_namlen = (namlen); \
- if (SvMp_name && SvMp_namlen == 0) \
- { \
- MAGIC *mg; \
- sv_magic(SvMp_sv, obj, how, 0, 0); \
- mg = SvMAGIC(SvMp_sv); \
- mg->mg_len = -42; /* XXX: this is the tricky part */ \
- mg->mg_ptr = SvMp_name; \
- } \
- else \
- { \
- sv_magic(SvMp_sv, obj, how, SvMp_name, SvMp_namlen); \
- } \
- } STMT_END
+#ifndef WARN_UTF8
+# define WARN_UTF8 44
+#endif
-#else
+#ifndef WARN_VOID
+# define WARN_VOID 45
+#endif
-# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
+#ifndef WARN_ASSERTIONS
+# define WARN_ASSERTIONS 46
+#endif
+#ifndef packWARN
+# define packWARN(a) (a)
+#endif
+#ifndef ckWARN
+# ifdef G_WARN_ON
+# define ckWARN(a) (PL_dowarn & G_WARN_ON)
+# else
+# define ckWARN(a) PL_dowarn
+# endif
#endif
-#if !defined(mg_findext)
-#if defined(NEED_mg_findext)
-static MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
+#if (PERL_BCDVERSION >= 0x5004000) && !defined(warner)
+#if defined(NEED_warner)
+static void DPPP_(my_warner)(U32 err, const char *pat, ...);
static
#else
-extern MAGIC * DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl);
+extern void DPPP_(my_warner)(U32 err, const char *pat, ...);
#endif
-#define mg_findext DPPP_(my_mg_findext)
-#define Perl_mg_findext DPPP_(my_mg_findext)
-
-#if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL)
+#define Perl_warner DPPP_(my_warner)
-MAGIC *
-DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl) {
- if (sv) {
- MAGIC *mg;
+#if defined(NEED_warner) || defined(NEED_warner_GLOBAL)
-#ifdef AvPAD_NAMELIST
- assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
-#endif
+void
+DPPP_(my_warner)(U32 err, const char *pat, ...)
+{
+ SV *sv;
+ va_list args;
- for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) {
- if (mg->mg_type == type && mg->mg_virtual == vtbl)
- return mg;
- }
- }
+ PERL_UNUSED_ARG(err);
- return NULL;
+ va_start(args, pat);
+ sv = vnewSVpvf(pat, &args);
+ va_end(args);
+ sv_2mortal(sv);
+ warn("%s", SvPV_nolen(sv));
}
+#define warner Perl_warner
+
+#define Perl_warner_nocontext Perl_warner
+
#endif
#endif
-#if !defined(sv_unmagicext)
-#if defined(NEED_sv_unmagicext)
-static int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
-static
-#else
-extern int DPPP_(my_sv_unmagicext)(pTHX_ SV * const sv, const int type, MGVTBL * vtbl);
+/* concatenating with "" ensures that only literal strings are accepted as argument
+ * note that STR_WITH_LEN() can't be used as argument to macros or functions that
+ * under some configurations might be macros
+ */
+#ifndef STR_WITH_LEN
+# define STR_WITH_LEN(s) (s ""), (sizeof(s)-1)
+#endif
+#ifndef newSVpvs
+# define newSVpvs(str) newSVpvn(str "", sizeof(str) - 1)
#endif
-#ifdef sv_unmagicext
-# undef sv_unmagicext
+#ifndef newSVpvs_flags
+# define newSVpvs_flags(str, flags) newSVpvn_flags(str "", sizeof(str) - 1, flags)
#endif
-#define sv_unmagicext(a,b,c) DPPP_(my_sv_unmagicext)(aTHX_ a,b,c)
-#define Perl_sv_unmagicext DPPP_(my_sv_unmagicext)
-#if defined(NEED_sv_unmagicext) || defined(NEED_sv_unmagicext_GLOBAL)
+#ifndef newSVpvs_share
+# define newSVpvs_share(str) newSVpvn_share(str "", sizeof(str) - 1, 0)
+#endif
-int
-DPPP_(my_sv_unmagicext)(pTHX_ SV *const sv, const int type, MGVTBL *vtbl)
-{
- MAGIC* mg;
- MAGIC** mgp;
+#ifndef sv_catpvs
+# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1)
+#endif
- if (SvTYPE(sv) < SVt_PVMG || !SvMAGIC(sv))
- return 0;
- mgp = &(SvMAGIC(sv));
- for (mg = *mgp; mg; mg = *mgp) {
- const MGVTBL* const virt = mg->mg_virtual;
- if (mg->mg_type == type && virt == vtbl) {
- *mgp = mg->mg_moremagic;
- if (virt && virt->svt_free)
- virt->svt_free(aTHX_ sv, mg);
- if (mg->mg_ptr && mg->mg_type != PERL_MAGIC_regex_global) {
- if (mg->mg_len > 0)
- Safefree(mg->mg_ptr);
- else if (mg->mg_len == HEf_SVKEY) /* Questionable on older perls... */
- SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
- else if (mg->mg_type == PERL_MAGIC_utf8)
- Safefree(mg->mg_ptr);
- }
- if (mg->mg_flags & MGf_REFCOUNTED)
- SvREFCNT_dec(mg->mg_obj);
- Safefree(mg);
- }
- else
- mgp = &mg->mg_moremagic;
- }
- if (SvMAGIC(sv)) {
- if (SvMAGICAL(sv)) /* if we're under save_magic, wait for restore_magic; */
- mg_magical(sv); /* else fix the flags now */
- }
- else {
- SvMAGICAL_off(sv);
- SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
- }
- return 0;
-}
+#ifndef sv_setpvs
+# define sv_setpvs(sv, str) sv_setpvn(sv, str "", sizeof(str) - 1)
+#endif
+
+#ifndef hv_fetchs
+# define hv_fetchs(hv, key, lval) hv_fetch(hv, key "", sizeof(key) - 1, lval)
+#endif
+
+#ifndef hv_stores
+# define hv_stores(hv, key, val) hv_store(hv, key "", sizeof(key) - 1, val, 0)
+#endif
+#ifndef gv_fetchpvs
+# define gv_fetchpvs(name, flags, svt) gv_fetchpvn_flags(name "", sizeof(name) - 1, flags, svt)
+#endif
+#ifndef gv_stashpvs
+# define gv_stashpvs(name, flags) gv_stashpvn(name "", sizeof(name) - 1, flags)
#endif
+#ifndef get_cvs
+# define get_cvs(name, flags) get_cvn_flags(name "", sizeof(name)-1, flags)
#endif
#ifdef USE_ITHREADS
projects / p5sagit/Sub-Name.git / commitdiff