/*
----------------------------------------------------------------------
- ppport.h -- Perl/Pollution/Portability Version 3.31
+ ppport.h -- Perl/Pollution/Portability Version 3.39
- Automatically created by Devel::PPPort running under perl 5.021011.
+ 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.31
+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_parser NEED_PL_parser NEED_PL_parser_GLOBAL
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_number() NEED_grok_number NEED_grok_number_GLOBAL
grok_numeric_radix() NEED_grok_numeric_radix NEED_grok_numeric_radix_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.31;
+my $VERSION = 3.39;
my %opt = (
quiet => 0,
ASCII_TO_NEED||5.007001|n
AvFILLp|5.004050||p
AvFILL|||
-BhkDISABLE||5.021008|
-BhkENABLE||5.021008|
-BhkENTRY_set||5.021008|
+BhkDISABLE||5.024000|
+BhkENABLE||5.024000|
+BhkENTRY_set||5.024000|
BhkENTRY|||
BhkFLAGS|||
CALL_BLOCK_HOOKS|||
CPERLscope|5.005000||p
CX_CURPAD_SAVE|||
CX_CURPAD_SV|||
+C_ARRAY_END|5.013002||p
+C_ARRAY_LENGTH|5.008001||p
CopFILEAV|5.006000||p
CopFILEGV_set|5.006000||p
CopFILEGV|5.006000||p
CvPADLIST||5.008001|
CvSTASH|||
CvWEAKOUTSIDE|||
+DECLARATION_FOR_LC_NUMERIC_MANIPULATION||5.021010|n
DEFSV_set|5.010001||p
DEFSV|5.004050||p
+DO_UTF8||5.006000|
END_EXTERN_C|5.005000||p
ENTER|||
ERRSV|5.004050||p
GvAV|||
GvCV|||
GvHV|||
-GvSVn|5.009003||p
GvSV|||
Gv_AMupdate||5.011000|
HEf_SVKEY|5.003070||p
LINKLIST||5.013006|
LVRET|||
MARK|||
-MULTICALL||5.021008|
+MULTICALL||5.024000|
MUTABLE_PTR|5.010001||p
MUTABLE_SV|5.010001||p
MY_CXT_CLONE|5.009002||p
OP_TYPE_IS_OR_WAS||5.019010|
OP_TYPE_IS||5.019007|
ORIGMARK|||
-OpHAS_SIBLING||5.021007|
-OpSIBLING_set||5.021007|
-OpSIBLING||5.021007|
+OpHAS_SIBLING|5.021007||p
+OpLASTSIB_set|5.021011||p
+OpMAYBESIB_set|5.021011||p
+OpMORESIB_set|5.021011||p
+OpSIBLING|5.021007||p
PAD_BASE_SV|||
PAD_CLONE_VARS|||
PAD_COMPNAME_FLAGS|||
PERLIO_FUNCS_CAST|5.009003||p
PERLIO_FUNCS_DECL|5.009003||p
PERL_ABS|5.008001||p
-PERL_BCDVERSION|5.021008||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
PERL_INT_MAX|5.003070||p
PERL_MAGIC_env|5.007002||p
PERL_MAGIC_ext|5.007002||p
PERL_MAGIC_fm|5.007002||p
-PERL_MAGIC_glob|5.021008||p
+PERL_MAGIC_glob|5.024000||p
PERL_MAGIC_isaelem|5.007002||p
PERL_MAGIC_isa|5.007002||p
-PERL_MAGIC_mutex|5.021008||p
+PERL_MAGIC_mutex|5.024000||p
PERL_MAGIC_nkeys|5.007002||p
-PERL_MAGIC_overload_elem|5.021008||p
+PERL_MAGIC_overload_elem|5.024000||p
PERL_MAGIC_overload_table|5.007002||p
-PERL_MAGIC_overload|5.021008||p
+PERL_MAGIC_overload|5.024000||p
PERL_MAGIC_pos|5.007002||p
PERL_MAGIC_qr|5.007002||p
PERL_MAGIC_regdata|5.007002||p
PERL_SUBVERSION|5.006000||p
PERL_SYS_INIT3||5.006000|
PERL_SYS_INIT|||
-PERL_SYS_TERM||5.021008|
+PERL_SYS_TERM||5.024000|
PERL_UCHAR_MAX|5.003070||p
PERL_UCHAR_MIN|5.003070||p
PERL_UINT_MAX|5.003070||p
PERL_UNUSED_ARG|5.009003||p
PERL_UNUSED_CONTEXT|5.009004||p
PERL_UNUSED_DECL|5.007002||p
+PERL_UNUSED_RESULT|5.021001||p
PERL_UNUSED_VAR|5.007002||p
PERL_UQUAD_MAX|5.003070||p
PERL_UQUAD_MIN|5.003070||p
PL_DBsub|||pn
PL_DBtrace|||pn
PL_Sv|5.005000||p
-PL_bufend|5.021008||p
-PL_bufptr|5.021008||p
+PL_bufend|5.024000||p
+PL_bufptr|5.024000||p
PL_check||5.006000|
PL_compiling|5.004050||p
PL_comppad_name||5.017004|
PL_comppad||5.008001|
-PL_copline|5.021008||p
+PL_copline|5.024000||p
PL_curcop|5.004050||p
PL_curpad||5.005000|
PL_curstash|5.004050||p
PL_dirty|5.004050||p
PL_dowarn|||pn
PL_errgv|5.004050||p
-PL_error_count|5.021008||p
-PL_expect|5.021008||p
+PL_error_count|5.024000||p
+PL_expect|5.024000||p
PL_hexdigit|5.005000||p
PL_hints|5.005000||p
-PL_in_my_stash|5.021008||p
-PL_in_my|5.021008||p
+PL_in_my_stash|5.024000||p
+PL_in_my|5.024000||p
PL_keyword_plugin||5.011002|
PL_last_in_gv|||n
PL_laststatval|5.005000||p
-PL_lex_state|5.021008||p
-PL_lex_stuff|5.021008||p
-PL_linestr|5.021008||p
+PL_lex_state|5.024000||p
+PL_lex_stuff|5.024000||p
+PL_linestr|5.024000||p
PL_modglobal||5.005000|n
PL_na|5.004050||pn
PL_no_modify|5.006000||p
PL_perldb|5.004050||p
PL_ppaddr|5.006000||p
PL_rpeepp||5.013005|n
-PL_rsfp_filters|5.021008||p
-PL_rsfp|5.021008||p
+PL_rsfp_filters|5.024000||p
+PL_rsfp|5.024000||p
PL_rs|||n
PL_signals|5.008001||p
PL_stack_base|5.004050||p
PL_sv_yes|5.004050||pn
PL_tainted|5.004050||p
PL_tainting|5.004050||p
-PL_tokenbuf|5.021008||p
-POP_MULTICALL||5.021008|
+PL_tokenbuf|5.024000||p
+POP_MULTICALL||5.024000|
POPi|||n
POPl|||n
POPn|||n
POPpx||5.005030|n
POPp|||n
POPs|||n
+POPul||5.006000|n
+POPu||5.004000|n
PTR2IV|5.006000||p
PTR2NV|5.006000||p
PTR2UV|5.006000||p
PTR2ul|5.007001||p
PTRV|5.006000||p
PUSHMARK|||
-PUSH_MULTICALL||5.021008|
+PUSH_MULTICALL||5.024000|
PUSHi|||
PUSHmortal|5.009002||p
PUSHn|||
PUSHs|||
PUSHu|5.004000||p
PUTBACK|||
-PadARRAY||5.021008|
-PadMAX||5.021008|
-PadlistARRAY||5.021008|
-PadlistMAX||5.021008|
-PadlistNAMESARRAY||5.021008|
-PadlistNAMESMAX||5.021008|
-PadlistNAMES||5.021008|
+PadARRAY||5.024000|
+PadMAX||5.024000|
+PadlistARRAY||5.024000|
+PadlistMAX||5.024000|
+PadlistNAMESARRAY||5.024000|
+PadlistNAMESMAX||5.024000|
+PadlistNAMES||5.024000|
PadlistREFCNT||5.017004|
PadnameIsOUR|||
PadnameIsSTATE|||
-PadnameLEN||5.021008|
+PadnameLEN||5.024000|
PadnameOURSTASH|||
PadnameOUTER|||
-PadnamePV||5.021008|
-PadnameREFCNT_dec||5.021008|
-PadnameREFCNT||5.021008|
-PadnameSV||5.021008|
+PadnamePV||5.024000|
+PadnameREFCNT_dec||5.024000|
+PadnameREFCNT||5.024000|
+PadnameSV||5.024000|
PadnameTYPE|||
PadnameUTF8||5.021007|
-PadnamelistARRAY||5.021008|
-PadnamelistMAX||5.021008|
-PadnamelistREFCNT_dec||5.021008|
-PadnamelistREFCNT||5.021008|
+PadnamelistARRAY||5.024000|
+PadnamelistMAX||5.024000|
+PadnamelistREFCNT_dec||5.024000|
+PadnamelistREFCNT||5.024000|
PerlIO_clearerr||5.007003|
PerlIO_close||5.007003|
PerlIO_context_layers||5.009004|
PoisonWith|5.009004||p
Poison|5.008000||p
READ_XDIGIT||5.017006|
+RESTORE_LC_NUMERIC||5.024000|
RETVAL|||n
Renewc|||
Renew|||
START_MY_CXT|5.007003||p
STMT_END|||p
STMT_START|||p
+STORE_LC_NUMERIC_FORCE_TO_UNDERLYING||5.024000|
+STORE_LC_NUMERIC_SET_TO_NEEDED||5.024000|
STR_WITH_LEN|5.009003||p
ST|||
SV_CONST_RETURN|5.009003||p
SvROK|||
SvRV_set|5.009003||p
SvRV|||
-SvRXOK||5.009005|
-SvRX||5.009005|
+SvRXOK|5.009005||p
+SvRX|5.009005||p
SvSETMAGIC|||
SvSHARED_HASH|5.009003||p
SvSHARE||5.007003|
SvVSTRING_mg|5.009004||p
THIS|||n
UNDERBAR|5.009002||p
+UTF8SKIP||5.006000|
UTF8_MAXBYTES|5.009002||p
+UVCHR_SKIP||5.022000|
UVSIZE|5.006000||p
UVTYPE|5.006000||p
UVXf|5.007001||p
UVxf|5.006000||p
WARN_ALL|5.006000||p
WARN_AMBIGUOUS|5.006000||p
-WARN_ASSERTIONS|5.021008||p
+WARN_ASSERTIONS|5.024000||p
WARN_BAREWORD|5.006000||p
WARN_CLOSED|5.006000||p
WARN_CLOSURE|5.006000||p
XST_mUNDEF|||
XST_mUV|5.008001||p
XST_mYES|||
-XS_APIVERSION_BOOTCHECK||5.021008|
-XS_EXTERNAL||5.021008|
-XS_INTERNAL||5.021008|
-XS_VERSION_BOOTCHECK||5.021008|
+XS_APIVERSION_BOOTCHECK||5.024000|
+XS_EXTERNAL||5.024000|
+XS_INTERNAL||5.024000|
+XS_VERSION_BOOTCHECK||5.024000|
XS_VERSION|||
XSprePUSH|5.006000||p
XS|||
-XopDISABLE||5.021008|
-XopENABLE||5.021008|
-XopENTRYCUSTOM||5.021008|
-XopENTRY_set||5.021008|
-XopENTRY||5.021008|
+XopDISABLE||5.024000|
+XopENABLE||5.024000|
+XopENTRYCUSTOM||5.024000|
+XopENTRY_set||5.024000|
+XopENTRY||5.024000|
XopFLAGS||5.013007|
ZeroD|5.009002||p
Zero|||
_get_encoding|||
_get_regclass_nonbitmap_data|||
_get_swash_invlist|||
+_invlistEQ|||
_invlist_array_init|||n
_invlist_contains_cp|||n
-_invlist_contents|||
_invlist_dump|||
_invlist_intersection_maybe_complement_2nd|||
_invlist_intersection|||
_new_invlist_C_array|||
_new_invlist|||
_pMY_CXT|5.007003||p
+_setlocale_debug_string|||n
_setup_canned_invlist|||
_swash_inversion_hash|||
_swash_to_invlist|||
_to_fold_latin1|||
_to_uni_fold_flags||5.014000|
_to_upper_title_latin1|||
+_to_utf8_case|||
_to_utf8_fold_flags||5.019009|
_to_utf8_lower_flags||5.019009|
_to_utf8_title_flags||5.019009|
_warn_problematic_locale|||n
aMY_CXT_|5.007003||p
aMY_CXT|5.007003||p
-aTHXR_|5.021008||p
-aTHXR|5.021008||p
+aTHXR_|5.024000||p
+aTHXR|5.024000||p
aTHX_|5.006000||p
aTHX|5.006000||p
-aassign_common_vars|||
add_above_Latin1_folds|||
add_cp_to_invlist|||
add_data|||n
add_multi_match|||
add_utf16_textfilter|||
adjust_size_and_find_bucket|||n
+advance_one_LB|||
advance_one_SB|||
advance_one_WB|||
alloc_maybe_populate_EXACT|||
av_undef|||
av_unshift|||
ax|||n
+backup_one_LB|||
backup_one_SB|||
backup_one_WB|||
bad_type_gv|||
bytes_cmp_utf8||5.013007|
bytes_from_utf8||5.007001|
bytes_to_utf8||5.006001|
+cBOOL|5.013000||p
call_argv|5.006000||p
call_atexit||5.006000|
call_list||5.004000|
ckwarn_common|||
ckwarn_d||5.009003|
ckwarn||5.009003|
+clear_defarray||5.023008|
clear_placeholders|||
clear_special_blocks|||
clone_params_del|||n
cophh_fetch_pv||5.013007|
cophh_fetch_sv||5.013007|
cophh_free||5.013007|
-cophh_new_empty||5.021008|
+cophh_new_empty||5.024000|
cophh_store_pvn||5.013007|
cophh_store_pvs||5.013007|
cophh_store_pv||5.013007|
cophh_store_sv||5.013007|
core_prototype|||
coresub_op|||
-could_it_be_a_POSIX_class|||n
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|||
cvstash_set|||
cx_dump||5.005000|
cx_dup|||
+cx_popblock||5.023008|
+cx_popeval||5.023008|
+cx_popformat||5.023008|
+cx_popgiven||5.023008|
+cx_poploop||5.023008|
+cx_popsub_args||5.023008|
+cx_popsub_common||5.023008|
+cx_popsub||5.023008|
+cx_popwhen||5.023008|
+cx_pushblock||5.023008|
+cx_pusheval||5.023008|
+cx_pushformat||5.023008|
+cx_pushgiven||5.023008|
+cx_pushloop_for||5.023008|
+cx_pushloop_plain||5.023008|
+cx_pushsub||5.023008|
+cx_pushwhen||5.023008|
+cx_topblock||5.023008|
cxinc|||
dAXMARK|5.009003||p
dAX|5.007002||p
dORIGMARK|||
dSP|||
dTHR|5.004050||p
-dTHXR|5.021008||p
+dTHXR|5.024000||p
dTHXa|5.006000||p
dTHXoa|5.006000||p
dTHX|5.006000||p
despatch_signals||5.007001|
destroy_matcher|||
die_nocontext|||vn
-die_sv||5.013001|
+die_sv|5.013001||p
die_unwind|||
die|||v
dirp_dup|||
do_vecset|||
do_vop|||
docatch|||
-doeval|||
+doeval_compile|||
dofile|||
dofindlabel|||
doform|||
doopen_pm|||
doparseform|||
dopoptoeval|||
-dopoptogiven|||
+dopoptogivenfor|||
dopoptolabel|||
dopoptoloop|||
dopoptosub_at|||
dowantarray|||
drand48_init_r|||n
drand48_r|||n
+dtrace_probe_call|||
+dtrace_probe_load|||
+dtrace_probe_op|||
+dtrace_probe_phase|||
dump_all_perl|||
dump_all||5.006000|
dump_c_backtrace|||
dump_vindent||5.006000|
dumpuntil|||
dup_attrlist|||
+edit_distance|||n
emulate_cop_io|||
eval_pv|5.006000||p
eval_sv|5.006000||p
find_lexical_cv|||
find_runcv_where|||
find_runcv||5.008001|
-find_rundefsv2|||
find_rundefsvoffset||5.009002|
find_rundefsv||5.013002|
find_script|||
get_c_backtrace_dump|||
get_c_backtrace|||
get_context||5.006000|n
-get_cvn_flags|5.009005||p
+get_cvn_flags|||
get_cvs|5.011000||p
get_cv|5.006000||p
get_db_sub|||
gv_fetchpvn_flags|5.009002||p
gv_fetchpvs|5.009004||p
gv_fetchpv|||
-gv_fetchsv|5.009002||p
+gv_fetchsv|||
gv_fullname3||5.003070|
gv_fullname4||5.006001|
gv_fullname|||
gv_handler||5.007001|
-gv_init_pvn||5.015004|
+gv_init_pvn|||
gv_init_pv||5.015004|
gv_init_svtype|||
gv_init_sv||5.015004|
gv_stashsvpvn_cached|||
gv_stashsv|||
gv_try_downgrade|||
+handle_named_backref|||
+handle_possible_posix|||
handle_regex_sets|||
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|
intuit_more|||
invert|||
invlist_array|||n
+invlist_clear|||
invlist_clone|||
+invlist_contents|||
invlist_extend|||
invlist_highest|||n
invlist_is_iterating|||n
invlist_iternext|||n
invlist_max|||n
invlist_previous_index|||n
+invlist_replace_list_destroys_src|||
invlist_set_len|||
invlist_set_previous_index|||n
invlist_trim|||n
isFOO_utf8_lc|||
isGCB|||n
isGRAPH|5.006000||p
-isGV_with_GP|5.009004||p
isIDCONT||5.017008|
isIDFIRST_lazy||5.021001|
isIDFIRST|||
+isLB|||
isLOWER|||
isOCTAL||5.013005|
isPRINT|5.004000||p
join_exact|||
keyword_plugin_standard|||
keyword|||
-leave_common|||
+leave_adjust_stacks||5.023008|
leave_scope|||
lex_bufutf8||5.011002|
lex_discard_to||5.011002|
memNEs|5.009005||p
memNE|5.004000||p
mem_collxfrm|||
+mem_log_alloc|||n
mem_log_common|||n
+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|||
my_atof2||5.007002|
my_atof||5.006000|
my_attrs|||
-my_bcopy|||n
+my_bcopy||5.004050|n
my_bytes_to_utf8|||n
my_bzero|||n
my_chsize|||
my_fork||5.007003|n
my_kid|||
my_lstat_flags|||
-my_lstat||5.021008|
+my_lstat||5.024000|
my_memcmp|||n
my_memset|||n
my_pclose||5.003070|
my_socketpair||5.007003|n
my_sprintf|5.009003||pvn
my_stat_flags|||
-my_stat||5.021008|
+my_stat||5.024000|
my_strerror||5.021001|
my_strftime||5.007002|
my_strlcat|5.009004||pn
op_lvalue_flags|||
op_lvalue||5.013007|
op_null||5.007002|
-op_parent||5.021002|n
+op_parent|||n
op_prepend_elem||5.013006|
op_refcnt_dec|||
op_refcnt_inc|||
opslab_force_free|||
opslab_free_nopad|||
opslab_free|||
+output_or_return_posix_warnings|||
pMY_CXT_|5.007003||p
pMY_CXT|5.007003||p
pTHX_|5.006000||p
ptr_table_split||5.009005|
ptr_table_store||5.009005|
push_scope|||
+put_charclass_bitmap_innards_common|||
+put_charclass_bitmap_innards_invlist|||
put_charclass_bitmap_innards|||
put_code_point|||
put_range|||
re_compile||5.009005|
re_croak2|||
re_dup_guts|||
+re_exec_indentf|||v
+re_indentf|||v
re_intuit_start||5.019001|
re_intuit_string||5.006000|
re_op_compile|||
+re_printf|||v
realloc||5.007002|n
-reentrant_free||5.021008|
-reentrant_init||5.021008|
-reentrant_retry||5.021008|vn
-reentrant_size||5.021008|
+reentrant_free||5.024000|
+reentrant_init||5.024000|
+reentrant_retry||5.024000|vn
+reentrant_size||5.024000|
ref_array_or_hash|||
refcounted_he_chain_2hv|||
refcounted_he_fetch_pvn|||
refcounted_he_value|||
refkids|||
refto|||
-ref||5.021008|
+ref||5.024000|
reg2Lanode|||
reg_check_named_buff_matched|||n
reg_named_buff_all||5.009005|
regdump_intflags|||
regdump||5.005000|
regdupe_internal|||
+regex_set_precedence|||n
regexec_flags||5.005000|
regfree_internal||5.009005|
reghop3|||n
regmatch|||
regnext||5.005000|
regnode_guts|||
-regpatws|||n
regpiece|||
-regpposixcc|||
regprop|||
regrepeat|||
regtail_study|||
save_adelete||5.011000|
save_aelem_flags||5.011000|
save_aelem||5.004050|
-save_aliased_sv|||
save_alloc||5.006000|
save_aptr|||
save_ary|||
savestack_grow_cnt||5.008001|
savestack_grow|||
savesvpv||5.009002|
+savetmps||5.023008|
sawparens|||
scalar_mod_type|||n
scalarboolean|||
si_dup|||
sighandler|||n
simplify_sort|||
+skip_to_be_ignored_text|||
skipspace_flags|||
softref2xv|||
sortcv_stacked|||
sv_len_utf8_nomg|||
sv_len_utf8||5.006000|
sv_len|||
-sv_magic_portable|5.021008|5.004000|p
+sv_magic_portable|5.024000|5.004000|p
sv_magicext_mglob|||
sv_magicext||5.007003|
sv_magic|||
sv_pv||5.006000|
sv_recode_to_utf8||5.007003|
sv_reftype|||
-sv_ref|||
-sv_release_COW|||
+sv_ref||5.015004|
sv_replace|||
sv_report_used|||
sv_resetpvn|||
sv_setref_iv|||
sv_setref_nv|||
sv_setref_pvn|||
-sv_setref_pvs||5.021008|
+sv_setref_pvs||5.024000|
sv_setref_pv|||
sv_setref_uv||5.007001|
sv_setsv_cow|||
taint_proper|||
tied_method|||v
tmps_grow_p|||
-toFOLD_uni||5.007003|
toFOLD_utf8||5.019001|
+toFOLD_uvchr||5.023009|
toFOLD||5.019001|
toLOWER_L1||5.019001|
toLOWER_LC||5.004000|
-toLOWER_uni||5.007003|
toLOWER_utf8||5.015007|
+toLOWER_uvchr||5.023009|
toLOWER|||
-toTITLE_uni||5.007003|
toTITLE_utf8||5.015007|
+toTITLE_uvchr||5.023009|
toTITLE||5.019001|
-toUPPER_uni||5.007003|
toUPPER_utf8||5.015007|
+toUPPER_uvchr||5.023009|
toUPPER|||
to_byte_substr|||
to_lower_latin1|||n
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 SvGETMAGIC
+# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
+#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
+/* 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 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 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
+#endif
+#ifndef MUTABLE_SV
+# define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
#endif
-#ifndef PERL_UNUSED_VAR
-# define PERL_UNUSED_VAR(x) ((void)x)
+/* end of random bits */
+#ifndef PERL_MAGIC_sv
+# define PERL_MAGIC_sv '\0'
#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_overload
+# define PERL_MAGIC_overload 'A'
#endif
-#ifndef NOOP
-# define NOOP /*EMPTY*/(void)0
+
+#ifndef PERL_MAGIC_overload_elem
+# define PERL_MAGIC_overload_elem 'a'
#endif
-#ifndef dNOOP
-# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
+#ifndef PERL_MAGIC_overload_table
+# define PERL_MAGIC_overload_table 'c'
#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_bm
+# define PERL_MAGIC_bm 'B'
#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_regdata
+# define PERL_MAGIC_regdata 'D'
#endif
-#ifndef PTR2ul
-# if PTRSIZE == LONGSIZE
-# define PTR2ul(p) (unsigned long)(p)
-# else
-# define PTR2ul(p) INT2PTR(unsigned long,p)
-# endif
+#ifndef PERL_MAGIC_regdatum
+# define PERL_MAGIC_regdatum 'd'
#endif
-#ifndef PTR2nat
-# define PTR2nat(p) (PTRV)(p)
+
+#ifndef PERL_MAGIC_env
+# define PERL_MAGIC_env 'E'
#endif
-#ifndef NUM2PTR
-# define NUM2PTR(any,d) (any)PTR2nat(d)
+#ifndef PERL_MAGIC_envelem
+# define PERL_MAGIC_envelem 'e'
#endif
-#ifndef PTR2IV
-# define PTR2IV(p) INT2PTR(IV,p)
+#ifndef PERL_MAGIC_fm
+# define PERL_MAGIC_fm 'f'
#endif
-#ifndef PTR2UV
-# define PTR2UV(p) INT2PTR(UV,p)
+#ifndef PERL_MAGIC_regex_global
+# define PERL_MAGIC_regex_global 'g'
#endif
-#ifndef PTR2NV
-# define PTR2NV(p) NUM2PTR(NV,p)
+#ifndef PERL_MAGIC_isa
+# define PERL_MAGIC_isa 'I'
#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_isaelem
+# define PERL_MAGIC_isaelem 'i'
#endif
-#if defined(PERL_GCC_PEDANTIC)
-# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
-# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
-# endif
+#ifndef PERL_MAGIC_nkeys
+# define PERL_MAGIC_nkeys 'k'
#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_dbfile
+# define PERL_MAGIC_dbfile 'L'
#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_dbline
+# define PERL_MAGIC_dbline 'l'
#endif
-#ifndef boolSV
-# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
+
+#ifndef PERL_MAGIC_mutex
+# define PERL_MAGIC_mutex 'm'
#endif
-/* DEFSV appears first in 5.004_56 */
-#ifndef DEFSV
-# define DEFSV GvSV(PL_defgv)
+#ifndef PERL_MAGIC_shared
+# define PERL_MAGIC_shared 'N'
#endif
-#ifndef SAVE_DEFSV
-# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
+#ifndef PERL_MAGIC_shared_scalar
+# define PERL_MAGIC_shared_scalar 'n'
#endif
-#ifndef DEFSV_set
-# define DEFSV_set(sv) (DEFSV = (sv))
+#ifndef PERL_MAGIC_collxfrm
+# define PERL_MAGIC_collxfrm 'o'
#endif
-/* Older perls (<=5.003) lack AvFILLp */
-#ifndef AvFILLp
-# define AvFILLp AvFILL
+#ifndef PERL_MAGIC_tied
+# define PERL_MAGIC_tied 'P'
#endif
-#ifndef ERRSV
-# define ERRSV get_sv("@",FALSE)
+
+#ifndef PERL_MAGIC_tiedelem
+# define PERL_MAGIC_tiedelem 'p'
#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_tiedscalar
+# define PERL_MAGIC_tiedscalar 'q'
#endif
-/* Replace: 1 */
-#ifndef get_cv
-# define get_cv perl_get_cv
+#ifndef PERL_MAGIC_qr
+# define PERL_MAGIC_qr 'r'
#endif
-#ifndef get_sv
-# define get_sv perl_get_sv
+#ifndef PERL_MAGIC_sig
+# define PERL_MAGIC_sig 'S'
#endif
-#ifndef get_av
-# define get_av perl_get_av
+#ifndef PERL_MAGIC_sigelem
+# define PERL_MAGIC_sigelem 's'
#endif
-#ifndef get_hv
-# define get_hv perl_get_hv
+#ifndef PERL_MAGIC_taint
+# define PERL_MAGIC_taint 't'
#endif
-/* Replace: 0 */
-#ifndef dUNDERBAR
-# define dUNDERBAR dNOOP
+#ifndef PERL_MAGIC_uvar
+# define PERL_MAGIC_uvar 'U'
#endif
-#ifndef UNDERBAR
-# define UNDERBAR DEFSV
+#ifndef PERL_MAGIC_uvar_elem
+# define PERL_MAGIC_uvar_elem 'u'
#endif
-#ifndef dAX
-# define dAX I32 ax = MARK - PL_stack_base + 1
+
+#ifndef PERL_MAGIC_vstring
+# define PERL_MAGIC_vstring 'V'
#endif
-#ifndef dITEMS
-# define dITEMS I32 items = SP - MARK
+#ifndef PERL_MAGIC_vec
+# define PERL_MAGIC_vec 'v'
#endif
-#ifndef dXSTARG
-# define dXSTARG SV * targ = sv_newmortal()
+
+#ifndef PERL_MAGIC_utf8
+# define PERL_MAGIC_utf8 'w'
#endif
-#ifndef dAXMARK
-# define dAXMARK I32 ax = POPMARK; \
- register SV ** const mark = PL_stack_base + ax++
+
+#ifndef PERL_MAGIC_substr
+# define PERL_MAGIC_substr 'x'
#endif
-#ifndef XSprePUSH
-# define XSprePUSH (sp = PL_stack_base + ax - 1)
+
+#ifndef PERL_MAGIC_defelem
+# define PERL_MAGIC_defelem 'y'
#endif
-#if (PERL_BCDVERSION < 0x5005000)
-# undef XSRETURN
-# define XSRETURN(off) \
- STMT_START { \
- PL_stack_sp = PL_stack_base + ax + ((off) - 1); \
- return; \
- } STMT_END
+#ifndef PERL_MAGIC_glob
+# define PERL_MAGIC_glob '*'
#endif
-#ifndef XSPROTO
-# define XSPROTO(name) void name(pTHX_ CV* cv)
+
+#ifndef PERL_MAGIC_arylen
+# define PERL_MAGIC_arylen '#'
#endif
-#ifndef SVfARG
-# define SVfARG(p) ((void*)(p))
+#ifndef PERL_MAGIC_pos
+# define PERL_MAGIC_pos '.'
#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 PERL_MAGIC_backref
+# define PERL_MAGIC_backref '<'
#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 PERL_MAGIC_ext
+# define PERL_MAGIC_ext '~'
#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')
+/* That's the best we can do... */
+#ifndef sv_catpvn_nomg
+# define sv_catpvn_nomg sv_catpvn
#endif
-#ifndef isBLANK
-# define isBLANK(c) ((c) == ' ' || (c) == '\t')
+#ifndef sv_catsv_nomg
+# define sv_catsv_nomg sv_catsv
#endif
-#ifdef EBCDIC
-#ifndef isALNUMC
-# define isALNUMC(c) isalnum(c)
+#ifndef sv_setsv_nomg
+# define sv_setsv_nomg sv_setsv
#endif
-#ifndef isASCII
-# define isASCII(c) isascii(c)
+#ifndef sv_pvn_nomg
+# define sv_pvn_nomg sv_pvn
#endif
-#ifndef isCNTRL
-# define isCNTRL(c) iscntrl(c)
+#ifndef SvIV_nomg
+# define SvIV_nomg SvIV
#endif
-#ifndef isGRAPH
-# define isGRAPH(c) isgraph(c)
+#ifndef SvUV_nomg
+# define SvUV_nomg SvUV
#endif
-#ifndef isPRINT
-# define isPRINT(c) isprint(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 isPUNCT
-# define isPUNCT(c) ispunct(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 isXDIGIT
-# define isXDIGIT(c) isxdigit(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
-#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_setiv_mg
+# define sv_setiv_mg(sv, i) \
+ STMT_START { \
+ SV *TeMpSv = sv; \
+ sv_setiv(TeMpSv,i); \
+ SvSETMAGIC(TeMpSv); \
+ } STMT_END
#endif
-#ifndef isASCII
-# define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
+#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 isCNTRL
-# define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
+#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 isGRAPH
-# define isGRAPH(c) (isALNUM(c) || isPUNCT(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
-#ifndef isPRINT
-# define isPRINT(c) (((c) >= 32 && (c) < 127))
+#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 isPUNCT
-# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
+#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 isXDIGIT
-# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
+#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)
#endif
-/* 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
+/* 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.
+ */
-#endif
+#if (PERL_BCDVERSION < 0x5004000)
-#ifndef PERL_SIGNALS_UNSAFE_FLAG
+ /* code that uses sv_magic_portable will not compile */
-#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
+#elif (PERL_BCDVERSION < 0x5008000)
-#if (PERL_BCDVERSION < 0x5008000)
-# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
-#else
-# define D_PPP_PERL_SIGNALS_INIT 0
-#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
-#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);
+
+# define sv_magic_portable(a, b, c, d, e) sv_magic(a, b, c, d, e)
+
#endif
-#define PL_signals DPPP_(my_PL_signals)
+#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
-/* 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.
- */
+#define mg_findext DPPP_(my_mg_findext)
+#define Perl_mg_findext DPPP_(my_mg_findext)
-#if (PERL_BCDVERSION <= 0x5005005)
-/* Replace: 1 */
-# define PL_ppaddr ppaddr
-# define PL_no_modify no_modify
-/* Replace: 0 */
-#endif
+#if defined(NEED_mg_findext) || defined(NEED_mg_findext_GLOBAL)
-#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 */
+MAGIC *
+DPPP_(my_mg_findext)(SV * sv, int type, const MGVTBL *vtbl) {
+ if (sv) {
+ MAGIC *mg;
+
+#ifdef AvPAD_NAMELIST
+ assert(!(SvTYPE(sv) == SVt_PVAV && AvPAD_NAMELIST(sv)));
#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.
- */
+ for (mg = SvMAGIC (sv); mg; mg = mg->mg_moremagic) {
+ if (mg->mg_type == type && mg->mg_virtual == vtbl)
+ return mg;
+ }
+ }
-#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
+ return NULL;
+}
-# endif
+#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
- * doint. 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 !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);
+#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)
+#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))
-#endif
-#ifndef mXPUSHs
-# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
+#ifndef OpLASTSIB_set
+# define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL)
#endif
-#ifndef XPUSHmortal
-# define XPUSHmortal XPUSHs(sv_newmortal())
+#ifndef OpMAYBESIB_set
+# define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib))
#endif
-#ifndef mXPUSHp
-# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
+#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 mXPUSHn
-# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
+#ifdef SvRX
+# undef SvRX
#endif
+#define SvRX(a) DPPP_(my_SvRX)(aTHX_ a)
-#ifndef mXPUSHi
-# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
-#endif
+#if defined(NEED_SvRX) || defined(NEED_SvRX_GLOBAL)
-#ifndef mXPUSHu
-# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
+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
-
-/* Replace: 1 */
-#ifndef call_sv
-# define call_sv perl_call_sv
#endif
-
-#ifndef call_pv
-# define call_pv perl_call_pv
+#ifndef SvRXOK
+# define SvRXOK(sv) (!!SvRX(sv))
#endif
-#ifndef call_argv
-# define call_argv perl_call_argv
+#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 call_method
-# define call_method perl_call_method
-#endif
-#ifndef eval_sv
-# define eval_sv perl_eval_sv
+#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: 0 */
-#ifndef PERL_LOADMOD_DENY
-# define PERL_LOADMOD_DENY 0x1
+#ifndef PERL_UNUSED_VAR
+# define PERL_UNUSED_VAR(x) ((void)x)
#endif
-#ifndef PERL_LOADMOD_NOIMPORT
-# define PERL_LOADMOD_NOIMPORT 0x2
+#ifndef PERL_UNUSED_CONTEXT
+# ifdef USE_ITHREADS
+# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl)
+# else
+# define PERL_UNUSED_CONTEXT
+# endif
#endif
-#ifndef PERL_LOADMOD_IMPORT_OPS
-# define PERL_LOADMOD_IMPORT_OPS 0x4
+#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 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 dNOOP
+# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL
#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 SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
+#ifndef NVTYPE
+# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE)
+# define NVTYPE long double
+# else
+# define NVTYPE double
+# endif
+typedef NVTYPE NV;
#endif
-#ifdef eval_pv
-# undef eval_pv
+#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
-#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
-#define Perl_eval_pv DPPP_(my_eval_pv)
-
-#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
-
-SV*
-DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
-{
- dSP;
- SV* sv = newSVpv(p, 0);
-
- PUSHMARK(sp);
- eval_sv(sv, G_SCALAR);
- SvREFCNT_dec(sv);
-
- SPAGAIN;
- sv = POPs;
- PUTBACK;
-
- if (croak_on_error && SvTRUE(GvSV(errgv)))
- croak(SvPVx(GvSV(errgv), na));
-
- return sv;
-}
+#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 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);
+#ifndef NUM2PTR
+# define NUM2PTR(any,d) (any)PTR2nat(d)
#endif
-#ifdef vload_module
-# undef vload_module
+#ifndef PTR2IV
+# define PTR2IV(p) INT2PTR(IV,p)
#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)
-void
-DPPP_(my_vload_module)(U32 flags, SV *name, SV *ver, va_list *args)
-{
- dTHR;
- dVAR;
- OP *veop, *imop;
+#ifndef PTR2UV
+# define PTR2UV(p) INT2PTR(UV,p)
+#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 PTR2NV
+# define PTR2NV(p) NUM2PTR(NV,p)
+#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);
+#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
- utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(),
- modname, imop);
+# define START_EXTERN_C
+# define END_EXTERN_C
+# define EXTERN_C extern
#endif
- PL_expect = oexpect;
- PL_copline = ocopline;
- PL_curcop = ocurcop;
- }
-}
+#if defined(PERL_GCC_PEDANTIC)
+# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
+# endif
#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
#endif
-#ifndef load_module
-#if defined(NEED_load_module)
-static void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
-static
+#undef STMT_START
+#undef STMT_END
+#ifdef PERL_USE_GCC_BRACE_GROUPS
+# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */
+# define STMT_END )
#else
-extern void DPPP_(my_load_module)(U32 flags, SV *name, SV *ver, ...);
+# 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
-
-#ifdef load_module
-# undef load_module
+#ifndef boolSV
+# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
#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)
+/* DEFSV appears first in 5.004_56 */
+#ifndef DEFSV
+# define DEFSV GvSV(PL_defgv)
+#endif
-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 SAVE_DEFSV
+# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv))
+#endif
+#ifndef DEFSV_set
+# define DEFSV_set(sv) (DEFSV = (sv))
#endif
+
+/* Older perls (<=5.003) lack AvFILLp */
+#ifndef AvFILLp
+# define AvFILLp AvFILL
#endif
-#ifndef newRV_inc
-# define newRV_inc(sv) newRV(sv) /* Replace */
+#ifndef ERRSV
+# define ERRSV get_sv("@",FALSE)
#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);
+/* 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 newRV_noinc
-# undef newRV_noinc
+/* Replace: 1 */
+#ifndef get_cv
+# define get_cv perl_get_cv
#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;
-}
+#ifndef get_sv
+# define get_sv perl_get_sv
#endif
+
+#ifndef get_av
+# define get_av perl_get_av
#endif
-/* Hint: newCONSTSUB
- * Returns a CV* as of perl-5.7.1. This return value is not supported
- * by Devel::PPPort.
- */
+#ifndef get_hv
+# define get_hv perl_get_hv
+#endif
-/* 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);
+/* Replace: 0 */
+#ifndef dUNDERBAR
+# define dUNDERBAR dNOOP
#endif
-#ifdef newCONSTSUB
-# undef newCONSTSUB
+#ifndef UNDERBAR
+# define UNDERBAR DEFSV
+#endif
+#ifndef dAX
+# define dAX I32 ax = MARK - PL_stack_base + 1
#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)
-
-/* 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),
+#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)
#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))
- );
+#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
- PL_hints = oldhints;
- PL_curcop->cop_stash = old_cop_stash;
- PL_curstash = old_curstash;
- PL_curcop->cop_line = oldline;
-}
+#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
#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.
- */
+#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
-#if defined(MULTIPLICITY) || defined(PERL_OBJECT) || \
- defined(PERL_CAPI) || defined(PERL_IMPLICIT_CONTEXT)
+/* provide these typedefs for older perls */
+#if (PERL_BCDVERSION < 0x5009003)
-#ifndef START_MY_CXT
+# ifdef ARGSproto
+typedef OP* (CPERLscope(*Perl_ppaddr_t))(ARGSproto);
+# else
+typedef OP* (CPERLscope(*Perl_ppaddr_t))(pTHX);
+# endif
-/* 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
+typedef OP* (CPERLscope(*Perl_check_t)) (pTHX_ OP*);
-#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 */
+#endif
+#ifndef isPSXSPC
+# define isPSXSPC(c) (isSPACE(c) || (c) == '\v')
+#endif
-/* 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))
+#ifndef isBLANK
+# define isBLANK(c) ((c) == ' ' || (c) == '\t')
+#endif
-/* 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))
+#ifdef EBCDIC
+#ifndef isALNUMC
+# define isALNUMC(c) isalnum(c)
+#endif
-/* This macro must be used to access members of the my_cxt_t structure.
- * e.g. MYCXT.some_data */
-#define MY_CXT (*my_cxtp)
+#ifndef isASCII
+# define isASCII(c) isascii(c)
+#endif
-/* 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 isCNTRL
+# define isCNTRL(c) iscntrl(c)
+#endif
-#endif /* START_MY_CXT */
+#ifndef isGRAPH
+# define isGRAPH(c) isgraph(c)
+#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 isPRINT
+# define isPRINT(c) isprint(c)
#endif
-#else /* single interpreter */
+#ifndef isPUNCT
+# define isPUNCT(c) ispunct(c)
+#endif
-#ifndef START_MY_CXT
+#ifndef isXDIGIT
+# define isXDIGIT(c) isxdigit(c)
+#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
+#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
-#define pMY_CXT void
-#define pMY_CXT_
-#define _pMY_CXT
-#define aMY_CXT
-#define aMY_CXT_
-#define _aMY_CXT
+#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
-#endif /* START_MY_CXT */
+#ifndef isASCII
+# define isASCII(c) ((WIDEST_UTYPE) (c) <= 127)
+#endif
-#ifndef MY_CXT_CLONE
-#define MY_CXT_CLONE NOOP
+#ifndef isCNTRL
+# define isCNTRL(c) ((WIDEST_UTYPE) (c) < ' ' || (c) == 127)
#endif
+#ifndef isGRAPH
+# define isGRAPH(c) (isALNUM(c) || isPUNCT(c))
+#endif
+
+#ifndef isPRINT
+# define isPRINT(c) (((c) >= 32 && (c) < 127))
+#endif
+
+#ifndef isPUNCT
+# define isPUNCT(c) (((c) >= 33 && (c) <= 47) || ((c) >= 58 && (c) <= 64) || ((c) >= 91 && (c) <= 96) || ((c) >= 123 && (c) <= 126))
+#endif
+
+#ifndef isXDIGIT
+# define isXDIGIT(c) (isDIGIT(c) || ((c) >= 'a' && (c) <= 'f') || ((c) >= 'A' && (c) <= 'F'))
+#endif
+
+#endif
+
+/* 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
+
+#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)
-#endif
-#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
+#undef mess
#endif
-#ifndef newSVpvn_flags
-
-#if defined(NEED_newSVpvn_flags)
-static SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
+#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_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
-#endif
-
-#ifdef newSVpvn_flags
-# undef newSVpvn_flags
+extern SV * DPPP_(my_mess_nocontext)(const char * pat, ...);
#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 mess_nocontext DPPP_(my_mess_nocontext)
+#define Perl_mess_nocontext DPPP_(my_mess_nocontext)
-SV *
-DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
+#if defined(NEED_mess_nocontext) || defined(NEED_mess_nocontext_GLOBAL)
+SV*
+DPPP_(my_mess_nocontext)(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;
+ dTHX;
+ SV *sv;
+ va_list args;
+ va_start(args, pat);
+ sv = vmess(pat, &args);
+ va_end(args);
+ return sv;
}
-
+#endif
#endif
+#ifndef mess
+#if defined(NEED_mess)
+static SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
+static
+#else
+extern SV * DPPP_(my_mess)(pTHX_ const char * pat, ...);
#endif
-/* Backwards compatibility stuff... :-( */
-#if !defined(NEED_sv_2pv_flags) && defined(NEED_sv_2pv_nolen)
-# define NEED_sv_2pv_flags
+#define Perl_mess DPPP_(my_mess)
+
+#if defined(NEED_mess) || defined(NEED_mess_GLOBAL)
+SV*
+DPPP_(my_mess)(pTHX_ const char* pat, ...)
+{
+ 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
-#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)
#endif
-#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);
+#ifndef mess_sv
+#if defined(NEED_mess_sv)
+static SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
static
#else
-extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
+extern SV * DPPP_(my_mess_sv)(pTHX_ SV * basemsg, bool consume);
#endif
-#ifdef sv_2pvbyte
-# undef sv_2pvbyte
+#ifdef mess_sv
+# undef mess_sv
#endif
-#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b)
-#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte)
+#define mess_sv(a,b) DPPP_(my_mess_sv)(aTHX_ a,b)
+#define Perl_mess_sv DPPP_(my_mess_sv)
-#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
-
-char *
-DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp)
+#if defined(NEED_mess_sv) || defined(NEED_mess_sv_GLOBAL)
+SV *
+DPPP_(my_mess_sv)(pTHX_ SV *basemsg, bool consume)
{
- sv_utf8_downgrade(sv,0);
- return SvPV(sv,*lp);
+ 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
+#endif
+#ifndef warn_nocontext
+#define warn_nocontext warn
#endif
-/* Hint: sv_2pvbyte
- * Use the SvPVbyte() macro instead of sv_2pvbyte().
- */
+#ifndef croak_nocontext
+#define croak_nocontext croak
+#endif
-#undef SvPVbyte
+#ifndef croak_no_modify
+#define croak_no_modify() croak_nocontext("%s", PL_no_modify)
+#define Perl_croak_no_modify() croak_no_modify()
+#endif
-#define SvPVbyte(sv, lp) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
- ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
+#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
+# define croak_memory_wrap() croak_nocontext("panic: memory wrap")
+#endif
+#endif
+#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE
+#define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params)
#endif
+#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
-# define SvPVbyte SvPV
-# define sv_2pvbyte sv_2pv
+#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)
+{
+ 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
-#ifndef sv_2pvbyte_nolen
-# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
#endif
-/* Hint: sv_pvn
- * Always use the SvPV() macro instead of sv_pvn().
- */
-
-/* Hint: sv_pvn_force
- * Always use the SvPV_force() macro instead of sv_pvn_force().
- */
+#ifndef PERL_SIGNALS_UNSAFE_FLAG
-/* If these are undefined, they're not handled by the core anyway */
-#ifndef SV_IMMEDIATE_UNREF
-# define SV_IMMEDIATE_UNREF 0
-#endif
+#define PERL_SIGNALS_UNSAFE_FLAG 0x0001
-#ifndef SV_GMAGIC
-# define SV_GMAGIC 0
+#if (PERL_BCDVERSION < 0x5008000)
+# define D_PPP_PERL_SIGNALS_INIT PERL_SIGNALS_UNSAFE_FLAG
+#else
+# define D_PPP_PERL_SIGNALS_INIT 0
#endif
-#ifndef SV_COW_DROP_PV
-# define SV_COW_DROP_PV 0
+#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)
-#ifndef SV_UTF8_NO_ENCODING
-# define SV_UTF8_NO_ENCODING 0
#endif
-#ifndef SV_NOSTEAL
-# define SV_NOSTEAL 0
-#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.
+ */
-#ifndef SV_CONST_RETURN
-# define SV_CONST_RETURN 0
+#if (PERL_BCDVERSION <= 0x5005005)
+/* Replace: 1 */
+# define PL_ppaddr ppaddr
+# define PL_no_modify no_modify
+/* Replace: 0 */
#endif
-#ifndef SV_MUTABLE_RETURN
-# define SV_MUTABLE_RETURN 0
+#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
-#ifndef SV_SMAGIC
-# define SV_SMAGIC 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.
+ */
-#ifndef SV_HAS_TRAILING_NUL
-# define SV_HAS_TRAILING_NUL 0
+#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
-#ifndef SV_COW_SHARED_HASH_KEYS
-# define SV_COW_SHARED_HASH_KEYS 0
-#endif
+# endif
-#if (PERL_BCDVERSION < 0x5007002)
+/* 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 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);
-#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)
-#ifdef sv_2pv_flags
-# undef sv_2pv_flags
-#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)
+#else
-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);
-}
+/* ensure that PL_parser != NULL and cannot be dereferenced */
+# define PL_parser ((void *) 1)
#endif
-
-#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 char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
+#ifndef mPUSHs
+# define mPUSHs(s) PUSHs(sv_2mortal(s))
#endif
-#ifdef sv_pvn_force_flags
-# undef sv_pvn_force_flags
+#ifndef PUSHmortal
+# define PUSHmortal PUSHs(sv_newmortal())
#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)
-
-#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
-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);
-}
+#ifndef mPUSHp
+# define mPUSHp(p,l) sv_setpvn(PUSHmortal, (p), (l))
+#endif
+#ifndef mPUSHn
+# define mPUSHn(n) sv_setnv(PUSHmortal, (NV)(n))
#endif
+#ifndef mPUSHi
+# define mPUSHi(i) sv_setiv(PUSHmortal, (IV)(i))
#endif
-#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
+#ifndef mPUSHu
+# define mPUSHu(u) sv_setuv(PUSHmortal, (UV)(u))
#endif
-#ifndef SvPV_const
-# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
+#ifndef mXPUSHs
+# define mXPUSHs(s) XPUSHs(sv_2mortal(s))
#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))
+#ifndef XPUSHmortal
+# define XPUSHmortal XPUSHs(sv_newmortal())
#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))
+
+#ifndef mXPUSHp
+# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn(PUSHmortal, (p), (l)); } STMT_END
#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))
+
+#ifndef mXPUSHn
+# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv(PUSHmortal, (NV)(n)); } STMT_END
#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))
+
+#ifndef mXPUSHi
+# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv(PUSHmortal, (IV)(i)); } STMT_END
#endif
-#ifndef SvPV_force
-# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
+
+#ifndef mXPUSHu
+# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv(PUSHmortal, (UV)(u)); } STMT_END
#endif
-#ifndef SvPV_force_nolen
-# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
+/* Replace: 1 */
+#ifndef call_sv
+# define call_sv perl_call_sv
#endif
-#ifndef SvPV_force_mutable
-# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
+#ifndef call_pv
+# define call_pv perl_call_pv
#endif
-#ifndef SvPV_force_nomg
-# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
+#ifndef call_argv
+# define call_argv perl_call_argv
#endif
-#ifndef SvPV_force_nomg_nolen
-# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
+#ifndef call_method
+# define call_method perl_call_method
#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))
+#ifndef eval_sv
+# define eval_sv perl_eval_sv
#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))
+
+/* Replace: 0 */
+#ifndef PERL_LOADMOD_DENY
+# define PERL_LOADMOD_DENY 0x1
#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 PERL_LOADMOD_NOIMPORT
+# define PERL_LOADMOD_NOIMPORT 0x2
#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))
+
+#ifndef PERL_LOADMOD_IMPORT_OPS
+# define PERL_LOADMOD_IMPORT_OPS 0x4
#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))
+
+#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
-#ifndef SvPV_nomg
-# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
+
+/* 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 SV* DPPP_(my_eval_pv)(char *p, I32 croak_on_error);
#endif
-#ifndef SvPV_nomg_const
-# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
+#ifdef eval_pv
+# undef eval_pv
#endif
+#define eval_pv(a,b) DPPP_(my_eval_pv)(aTHX_ a,b)
+#define Perl_eval_pv DPPP_(my_eval_pv)
-#ifndef SvPV_nomg_const_nolen
-# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
+#if defined(NEED_eval_pv) || defined(NEED_eval_pv_GLOBAL)
+
+SV*
+DPPP_(my_eval_pv)(char *p, I32 croak_on_error)
+{
+ 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
-#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))
+#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);
#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
+
+#ifdef vload_module
+# undef vload_module
+#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)
+
+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
+ PL_expect = oexpect;
+ PL_copline = ocopline;
+ PL_curcop = ocurcop;
+ }
+}
+
+#endif
+#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, ...);
+#endif
+
+#ifdef load_module
+# undef load_module
+#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);
+}
+
+#endif
+#endif
+#ifndef newRV_inc
+# define newRV_inc(sv) newRV(sv) /* Replace */
+#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);
+#endif
+
+#ifdef newRV_noinc
+# undef newRV_noinc
+#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;
+}
+#endif
+#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);
+#endif
+
+#ifdef newCONSTSUB
+# undef newCONSTSUB
+#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)
+
+/* 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
+
+ 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
+#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
+
+#endif /* START_MY_CXT */
+
+#ifndef MY_CXT_CLONE
+/* Clones the per-interpreter data. */
+#define MY_CXT_CLONE \
+ dMY_CXT_SV; \
+ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\
+ Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\
+ sv_setuv(my_cxt_sv, PTR2UV(my_cxtp))
+#endif
+
+#else /* single interpreter */
+
+#ifndef START_MY_CXT
+
+#define START_MY_CXT static my_cxt_t my_cxt;
+#define dMY_CXT_SV dNOOP
+#define dMY_CXT dNOOP
+#define 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
+
+#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
+#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
+#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 SvMAGIC_set
-# define SvMAGIC_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
- (((XPVMG*) SvANY(sv))->xmg_magic = (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 < 0x5009003)
-#ifndef SvPVX_const
-# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
+#ifndef SvREFCNT_inc_simple_NN
+# define SvREFCNT_inc_simple_NN(sv) (++SvREFCNT(sv), (SV*)(sv))
#endif
-#ifndef SvPVX_mutable
-# define SvPVX_mutable(sv) (0 + SvPVX(sv))
+#ifndef SvREFCNT_inc_void_NN
+# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
#endif
-#ifndef SvRV_set
-# define SvRV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
- (((XRV*) SvANY(sv))->xrv_rv = (val)); } STMT_END
+
+#ifndef SvREFCNT_inc_simple_void_NN
+# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
#endif
+#ifndef newSV_type
+
+#if defined(NEED_newSV_type)
+static SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
+static
#else
-#ifndef SvPVX_const
-# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
+extern SV* DPPP_(my_newSV_type)(pTHX_ svtype const t);
#endif
-#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
+#ifdef newSV_type
+# undef newSV_type
#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)
+
+SV*
+DPPP_(my_newSV_type)(pTHX_ svtype const t)
+{
+ SV* const sv = newSV(0);
+ sv_upgrade(sv, t);
+ return sv;
+}
-#endif
-#ifndef SvSTASH_set
-# define SvSTASH_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
- (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } 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
#endif
+#if (PERL_BCDVERSION < 0x5006000)
+# define D_PPP_CONSTPV_ARG(x) ((char *) (x))
#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
+# define D_PPP_CONSTPV_ARG(x) (x)
#endif
-
+#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
-#if (PERL_BCDVERSION >= 0x5004000) && !defined(vnewSVpvf)
-#if defined(NEED_vnewSVpvf)
-static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
+#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 SV * DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args);
+extern SV * DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags);
#endif
-#ifdef vnewSVpvf
-# undef vnewSVpvf
+#ifdef newSVpvn_flags
+# undef newSVpvn_flags
#endif
-#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
-#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
+#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_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
+#if defined(NEED_newSVpvn_flags) || defined(NEED_newSVpvn_flags_GLOBAL)
SV *
-DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args)
+DPPP_(my_newSVpvn_flags)(pTHX_ const char *s, STRLEN len, U32 flags)
{
- register SV *sv = newSV(0);
- sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*));
- return sv;
+ SV *sv = newSVpvn(D_PPP_CONSTPV_ARG(s), len);
+ SvFLAGS(sv) |= (flags & SVf_UTF8);
+ return (flags & SVs_TEMP) ? sv_2mortal(sv) : 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*))
+/* 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_vsetpvf)
-# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*))
+/* 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_catpvf_mg)
-#if defined(NEED_sv_catpvf_mg)
-static void DPPP_(my_sv_catpvf_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_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+extern char * DPPP_(my_sv_2pvbyte)(pTHX_ SV *sv, STRLEN *lp);
#endif
-#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_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_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
+#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL)
-void
-DPPP_(my_sv_catpvf_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_vcatpvfn(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
-#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, ...);
-static
-#else
-extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...);
-#endif
+/* Hint: sv_2pvbyte
+ * Use the SvPVbyte() macro instead of sv_2pvbyte().
+ */
-#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
-#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
+#undef SvPVbyte
-#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
+#define SvPVbyte(sv, lp) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
+ ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
-void
-DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...)
-{
- dTHX;
- va_list args;
- va_start(args, pat);
- sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
- SvSETMAGIC(sv);
- va_end(args);
-}
+#endif
+
+#else
+
+# define SvPVbyte SvPV
+# define sv_2pvbyte sv_2pv
#endif
+#ifndef sv_2pvbyte_nolen
+# define sv_2pvbyte_nolen(sv) sv_2pv_nolen(sv)
#endif
+
+/* Hint: sv_pvn
+ * Always use the SvPV() macro instead of sv_pvn().
+ */
+
+/* Hint: sv_pvn_force
+ * Always use the SvPV_force() macro instead of sv_pvn_force().
+ */
+
+/* If these are undefined, they're not handled by the core anyway */
+#ifndef SV_IMMEDIATE_UNREF
+# define SV_IMMEDIATE_UNREF 0
#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
+#ifndef SV_GMAGIC
+# define SV_GMAGIC 0
#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
+#ifndef SV_COW_DROP_PV
+# define SV_COW_DROP_PV 0
#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_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...);
+#ifndef SV_UTF8_NO_ENCODING
+# define SV_UTF8_NO_ENCODING 0
#endif
-#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg)
+#ifndef SV_NOSTEAL
+# define SV_NOSTEAL 0
+#endif
-#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL)
+#ifndef SV_CONST_RETURN
+# define SV_CONST_RETURN 0
+#endif
-void
-DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...)
-{
- va_list args;
- va_start(args, pat);
- sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*));
- SvSETMAGIC(sv);
- va_end(args);
-}
+#ifndef SV_MUTABLE_RETURN
+# define SV_MUTABLE_RETURN 0
+#endif
+#ifndef SV_SMAGIC
+# define SV_SMAGIC 0
#endif
+
+#ifndef SV_HAS_TRAILING_NUL
+# define SV_HAS_TRAILING_NUL 0
#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, ...);
+#ifndef SV_COW_SHARED_HASH_KEYS
+# define SV_COW_SHARED_HASH_KEYS 0
+#endif
+
+#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 void DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...);
+extern char * DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
#endif
-#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
-#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext)
+#ifdef sv_2pv_flags
+# undef sv_2pv_flags
+#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_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL)
+#if defined(NEED_sv_2pv_flags) || defined(NEED_sv_2pv_flags_GLOBAL)
-void
-DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...)
+char *
+DPPP_(my_sv_2pv_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags)
{
- 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);
+ STRLEN n_a = (STRLEN) flags;
+ return sv_2pv(sv, lp ? lp : &n_a);
}
#endif
-#endif
-#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
-#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
-#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 newSVpvn_share
-#if defined(NEED_newSVpvn_share)
-static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
+#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 SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
+extern char * DPPP_(my_sv_pvn_force_flags)(pTHX_ SV *sv, STRLEN *lp, I32 flags);
#endif
-#ifdef newSVpvn_share
-# undef newSVpvn_share
+#ifdef sv_pvn_force_flags
+# undef sv_pvn_force_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_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_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
+#if defined(NEED_sv_pvn_force_flags) || defined(NEED_sv_pvn_force_flags_GLOBAL)
-SV *
-DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash)
+char *
+DPPP_(my_sv_pvn_force_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_pvn_force(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)
+
+#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 GvSVn
-# define GvSVn(gv) GvSV(gv)
+#ifndef SvPV_const
+# define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
#endif
-#ifndef isGV_with_GP
-# define isGV_with_GP(gv) isGV(gv)
+#ifndef SvPV_mutable
+# define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
#endif
-
-#ifndef gv_fetchpvn_flags
-# define gv_fetchpvn_flags(name, len, flags, svt) gv_fetchpv(name, flags, svt)
+#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 gv_fetchsv
-# define gv_fetchsv(name, flags, svt) gv_fetchpv(SvPV_nolen_const(name), flags, svt)
+#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 get_cvn_flags
-# define get_cvn_flags(name, namelen, flags) get_cv(name, flags)
+#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_ALL
-# define WARN_ALL 0
+#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_CLOSURE
-# define WARN_CLOSURE 1
+#ifndef SvPV_force
+# define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
#endif
-#ifndef WARN_DEPRECATED
-# define WARN_DEPRECATED 2
+#ifndef SvPV_force_nolen
+# define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
#endif
-#ifndef WARN_EXITING
-# define WARN_EXITING 3
+#ifndef SvPV_force_mutable
+# define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
#endif
-#ifndef WARN_GLOB
-# define WARN_GLOB 4
+#ifndef SvPV_force_nomg
+# define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
#endif
-#ifndef WARN_IO
-# define WARN_IO 5
+#ifndef SvPV_force_nomg_nolen
+# define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
#endif
-
-#ifndef WARN_CLOSED
-# define WARN_CLOSED 6
+#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_EXEC
-# define WARN_EXEC 7
+#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_LAYER
-# define WARN_LAYER 8
+#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_NEWLINE
-# define WARN_NEWLINE 9
+#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_PIPE
-# define WARN_PIPE 10
+#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_UNOPENED
-# define WARN_UNOPENED 11
+#ifndef SvPV_nomg
+# define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
#endif
-#ifndef WARN_MISC
-# define WARN_MISC 12
+#ifndef SvPV_nomg_const
+# define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
#endif
-#ifndef WARN_NUMERIC
-# define WARN_NUMERIC 13
+#ifndef SvPV_nomg_const_nolen
+# define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
#endif
-#ifndef WARN_ONCE
-# define WARN_ONCE 14
+#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_OVERFLOW
-# define WARN_OVERFLOW 15
+#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_PACK
-# define WARN_PACK 16
+#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_PORTABLE
-# define WARN_PORTABLE 17
+#if (PERL_BCDVERSION < 0x5009003)
+#ifndef SvPVX_const
+# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv)))
#endif
-#ifndef WARN_RECURSION
-# define WARN_RECURSION 18
+#ifndef SvPVX_mutable
+# define SvPVX_mutable(sv) (0 + SvPVX(sv))
#endif
-
-#ifndef WARN_REDEFINE
-# define WARN_REDEFINE 19
+#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_REGEXP
-# define WARN_REGEXP 20
+#else
+#ifndef SvPVX_const
+# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv))
#endif
-#ifndef WARN_SEVERE
-# define WARN_SEVERE 21
+#ifndef SvPVX_mutable
+# define SvPVX_mutable(sv) ((sv)->sv_u.svu_pv)
#endif
-
-#ifndef WARN_DEBUGGING
-# define WARN_DEBUGGING 22
+#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_INPLACE
-# define WARN_INPLACE 23
#endif
-
-#ifndef WARN_INTERNAL
-# define WARN_INTERNAL 24
+#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_MALLOC
-# define WARN_MALLOC 25
+#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_SIGNAL
-# define WARN_SIGNAL 26
+#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_SUBSTR
-# define WARN_SUBSTR 27
#endif
-#ifndef WARN_SYNTAX
-# define WARN_SYNTAX 28
+#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_AMBIGUOUS
-# define WARN_AMBIGUOUS 29
+#ifdef vnewSVpvf
+# undef vnewSVpvf
#endif
+#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b)
+#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf)
-#ifndef WARN_BAREWORD
-# define WARN_BAREWORD 30
-#endif
+#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL)
-#ifndef WARN_DIGIT
-# define WARN_DIGIT 31
-#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_PARENTHESIS
-# define WARN_PARENTHESIS 32
#endif
-
-#ifndef WARN_PRECEDENCE
-# define WARN_PRECEDENCE 33
#endif
-#ifndef WARN_PRINTF
-# define WARN_PRINTF 34
+#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_PROTOTYPE
-# define WARN_PROTOTYPE 35
+#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_QW
-# define WARN_QW 36
+#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_RESERVED
-# define WARN_RESERVED 37
-#endif
+#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg)
-#ifndef WARN_SEMICOLON
-# define WARN_SEMICOLON 38
-#endif
+#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL)
-#ifndef WARN_TAINT
-# define WARN_TAINT 39
-#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_THREADS
-# define WARN_THREADS 40
#endif
-
-#ifndef WARN_UNINITIALIZED
-# define WARN_UNINITIALIZED 41
#endif
-#ifndef WARN_UNPACK
-# define WARN_UNPACK 42
+#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_UNTIE
-# define WARN_UNTIE 43
-#endif
+#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
+#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext)
-#ifndef WARN_UTF8
-# define WARN_UTF8 44
-#endif
+#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL)
-#ifndef WARN_VOID
-# define WARN_VOID 45
-#endif
+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
-#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
+/* 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.
+ */
-#define MUTABLE_SV(p) ((SV *)MUTABLE_PTR(p))
+#ifndef newSVpvn_share
-/* end of random bits */
-#ifndef PERL_MAGIC_sv
-# define PERL_MAGIC_sv '\0'
+#if defined(NEED_newSVpvn_share)
+static SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
+static
+#else
+extern SV * DPPP_(my_newSVpvn_share)(pTHX_ const char *src, I32 len, U32 hash);
#endif
-#ifndef PERL_MAGIC_overload
-# define PERL_MAGIC_overload 'A'
+#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_elem
-# define PERL_MAGIC_overload_elem 'a'
-#endif
+#if defined(NEED_newSVpvn_share) || defined(NEED_newSVpvn_share_GLOBAL)
-#ifndef PERL_MAGIC_overload_table
-# define PERL_MAGIC_overload_table 'c'
-#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_bm
-# define PERL_MAGIC_bm 'B'
#endif
-#ifndef PERL_MAGIC_regdata
-# define PERL_MAGIC_regdata 'D'
#endif
-
-#ifndef PERL_MAGIC_regdatum
-# define PERL_MAGIC_regdatum 'd'
+#ifndef SvSHARED_HASH
+# define SvSHARED_HASH(sv) (0 + SvUVX(sv))
#endif
-
-#ifndef PERL_MAGIC_env
-# define PERL_MAGIC_env 'E'
+#ifndef HvNAME_get
+# define HvNAME_get(hv) HvNAME(hv)
#endif
-
-#ifndef PERL_MAGIC_envelem
-# define PERL_MAGIC_envelem 'e'
+#ifndef HvNAMELEN_get
+# define HvNAMELEN_get(hv) (HvNAME_get(hv) ? (I32)strlen(HvNAME_get(hv)) : 0)
#endif
-#ifndef PERL_MAGIC_fm
-# define PERL_MAGIC_fm 'f'
+#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_regex_global
-# define PERL_MAGIC_regex_global 'g'
+#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_isa
-# define PERL_MAGIC_isa 'I'
-#endif
+#if defined(NEED_gv_fetchpvn_flags) || defined(NEED_gv_fetchpvn_flags_GLOBAL)
-#ifndef PERL_MAGIC_isaelem
-# define PERL_MAGIC_isaelem 'i'
+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;
+}
+
+#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 / blobdiff