diff options
author | Marcus Holland-Moritz <mhx-perl@gmx.net> | 2006-06-23 19:06:43 +0000 |
---|---|---|
committer | Marcus Holland-Moritz <mhx-perl@gmx.net> | 2006-06-23 19:06:43 +0000 |
commit | 216f5eae3179f16935cfab26c5085e58ecfc337d (patch) | |
tree | a4a7279752fface530923541da6b89ff91cd2381 /ext | |
parent | 1e73acc8af3eecb1b36ee831483e1e9a7b3d1662 (diff) | |
download | perl-216f5eae3179f16935cfab26c5085e58ecfc337d.tar.gz |
Upgrade to Devel::PPPort 3.08_05
p4raw-id: //depot/perl@28420
Diffstat (limited to 'ext')
-rwxr-xr-x | ext/Devel/PPPort/Changes | 6 | ||||
-rw-r--r-- | ext/Devel/PPPort/Makefile.PL | 29 | ||||
-rw-r--r-- | ext/Devel/PPPort/PPPort.pm | 6767 | ||||
-rw-r--r-- | ext/Devel/PPPort/PPPort.xs | 1281 | ||||
-rw-r--r-- | ext/Devel/PPPort/PPPort_pm.PL | 19 | ||||
-rw-r--r-- | ext/Devel/PPPort/soak | 2 |
6 files changed, 35 insertions, 8069 deletions
diff --git a/ext/Devel/PPPort/Changes b/ext/Devel/PPPort/Changes index cd74b314bd..0e79576350 100755 --- a/ext/Devel/PPPort/Changes +++ b/ext/Devel/PPPort/Changes @@ -1,3 +1,9 @@ +3.08_05 - 2006-06-23 + + * when in the core, generate PPPort.pm and PPPort.xs + automatically + * PPPort.pm can now be loaded by miniperl + 3.08_04 - 2006-05-29 * update API info diff --git a/ext/Devel/PPPort/Makefile.PL b/ext/Devel/PPPort/Makefile.PL index 50599c6def..500b335746 100644 --- a/ext/Devel/PPPort/Makefile.PL +++ b/ext/Devel/PPPort/Makefile.PL @@ -4,9 +4,9 @@ # ################################################################################ # -# $Revision: 20 $ +# $Revision: 21 $ # $Author: mhx $ -# $Date: 2006/05/28 19:36:23 +0200 $ +# $Date: 2006/06/23 15:55:22 +0200 $ # ################################################################################ # @@ -26,18 +26,13 @@ unless ($ENV{'PERL_CORE'}) { $ENV{'PERL_CORE'} = 1 if grep { $_ eq 'PERL_CORE=1' } @ARGV; } -if ($ENV{'PERL_CORE'}) { - # Pods will be built by installman. - @moreopts = ( MAN3PODS => {} ); -} -else { - # Devel::PPPort is in the core since 5.7.3 - @moreopts = ( INSTALLDIRS => ($] >= 5.007003 ? 'perl' : 'site') ); -} - @ARGV = map { /^--with-(.*)/ && ++$opt{$1} ? () : $_ } @ARGV; -%PL_FILES = ( 'ppport_h.PL' => 'ppport.h' ), +%PL_FILES = ( + 'ppport_h.PL' => 'ppport.h', + 'PPPort_pm.PL' => 'PPPort.pm', + 'PPPort_xs.PL' => 'PPPort.xs', +); @C_FILES = qw{ module2.c module3.c }; @@ -52,6 +47,16 @@ if ($opt{'apicheck'}) { $depend{'apicheck.i'} = 'ppport.h'; } +if ($ENV{'PERL_CORE'}) { + # Pods will be built by installman. + push @moreopts, MAN3PODS => {}; + push @clean, qw( PPPort.pm PPPort.xs ); +} +else { + # Devel::PPPort is in the core since 5.7.3 + push @moreopts, INSTALLDIRS => ($] >= 5.007003 ? 'perl' : 'site'); +} + if (eval $ExtUtils::MakeMaker::VERSION >= 6) { push @moreopts, AUTHOR => 'Marcus Holland-Moritz <mhx@cpan.org>'; if (-f 'PPPort.pm') { diff --git a/ext/Devel/PPPort/PPPort.pm b/ext/Devel/PPPort/PPPort.pm deleted file mode 100644 index 212b1a51da..0000000000 --- a/ext/Devel/PPPort/PPPort.pm +++ /dev/null @@ -1,6767 +0,0 @@ -################################################################################ -# -# !!!!! Do NOT edit this file directly! -- Edit PPPort_pm.PL instead. !!!!! -# -################################################################################ -# -# Perl/Pollution/Portability -# -################################################################################ -# -# $Revision: 44 $ -# $Author: mhx $ -# $Date: 2006/05/22 20:28:47 +0200 $ -# -################################################################################ -# -# Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz. -# Version 2.x, Copyright (C) 2001, Paul Marquess. -# Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -# -# This program is free software; you can redistribute it and/or -# modify it under the same terms as Perl itself. -# -################################################################################ - -=head1 NAME - -Devel::PPPort - Perl/Pollution/Portability - -=head1 SYNOPSIS - - Devel::PPPort::WriteFile(); # defaults to ./ppport.h - Devel::PPPort::WriteFile('someheader.h'); - -=head1 DESCRIPTION - -Perl's API has changed over time, gaining new features, new functions, -increasing its flexibility, and reducing the impact on the C namespace -environment (reduced pollution). The header file written by this module, -typically F<ppport.h>, attempts to bring some of the newer Perl API -features to older versions of Perl, so that you can worry less about -keeping track of old releases, but users can still reap the benefit. - -C<Devel::PPPort> contains a single function, called C<WriteFile>. Its -only purpose is to write the F<ppport.h> C header file. This file -contains a series of macros and, if explicitly requested, functions that -allow XS modules to be built using older versions of Perl. Currently, -Perl versions from 5.003 to 5.9.4 are supported. - -This module is used by C<h2xs> to write the file F<ppport.h>. - -=head2 Why use ppport.h? - -You should use F<ppport.h> in modern code so that your code will work -with the widest range of Perl interpreters possible, without significant -additional work. - -You should attempt older code to fully use F<ppport.h>, because the -reduced pollution of newer Perl versions is an important thing. It's so -important that the old polluting ways of original Perl modules will not be -supported very far into the future, and your module will almost certainly -break! By adapting to it now, you'll gain compatibility and a sense of -having done the electronic ecology some good. - -=head2 How to use ppport.h - -Don't direct the users of your module to download C<Devel::PPPort>. -They are most probably no XS writers. Also, don't make F<ppport.h> -optional. Rather, just take the most recent copy of F<ppport.h> that -you can find (e.g. by generating it with the latest C<Devel::PPPort> -release from CPAN), copy it into your project, adjust your project to -use it, and distribute the header along with your module. - -=head2 Running ppport.h - -But F<ppport.h> is more than just a C header. It's also a Perl script -that can check your source code. It will suggest hints and portability -notes, and can even make suggestions on how to change your code. You -can run it like any other Perl program: - - perl ppport.h [options] [files] - -It also has embedded documentation, so you can use - - perldoc ppport.h - -to find out more about how to use it. - -=head1 FUNCTIONS - -=head2 WriteFile - -C<WriteFile> takes one optional argument. When called with one -argument, it expects to be passed a filename. When called with -no arguments, it defaults to the filename F<ppport.h>. - -The function returns a true value if the file was written successfully. -Otherwise it returns a false value. - -=head1 COMPATIBILITY - -F<ppport.h> supports Perl versions from 5.003 to 5.9.4 -in threaded and non-threaded configurations. - -=head2 Provided Perl compatibility API - -The header file written by this module, typically F<ppport.h>, provides -access to the following elements of the Perl API that is not available -in older Perl releases: - - _aMY_CXT - _pMY_CXT - aMY_CXT - aMY_CXT_ - aTHX - aTHX_ - AvFILLp - boolSV - call_argv - call_method - call_pv - call_sv - ckWARN - CopFILE - CopFILE_set - CopFILEAV - CopFILEGV - CopFILEGV_set - CopFILESV - CopSTASH - CopSTASH_eq - CopSTASH_set - CopSTASHPV - CopSTASHPV_set - CopyD - dAX - dAXMARK - DEFSV - dITEMS - dMY_CXT - dMY_CXT_SV - dNOOP - dTHR - dTHX - dTHXa - dTHXoa - dUNDERBAR - dVAR - dXCPT - dXSTARG - END_EXTERN_C - ERRSV - eval_pv - eval_sv - EXTERN_C - get_av - get_cv - get_hv - get_sv - grok_bin - grok_hex - grok_number - GROK_NUMERIC_RADIX - grok_numeric_radix - grok_oct - gv_stashpvn - hv_fetchs - hv_stores - IN_LOCALE - IN_LOCALE_COMPILETIME - IN_LOCALE_RUNTIME - IN_PERL_COMPILETIME - INT2PTR - IS_NUMBER_GREATER_THAN_UV_MAX - IS_NUMBER_IN_UV - IS_NUMBER_INFINITY - IS_NUMBER_NAN - IS_NUMBER_NEG - IS_NUMBER_NOT_INT - IVdf - IVSIZE - IVTYPE - memEQ - memNE - MoveD - mPUSHi - mPUSHn - mPUSHp - mPUSHu - mXPUSHi - mXPUSHn - mXPUSHp - mXPUSHu - MY_CXT - MY_CXT_CLONE - MY_CXT_INIT - my_snprintf - newCONSTSUB - newRV_inc - newRV_noinc - newSVpvn - newSVpvs - newSVuv - Newx - Newxc - Newxz - NOOP - NUM2PTR - NVef - NVff - NVgf - NVTYPE - packWARN - PERL_ABS - PERL_BCDVERSION - PERL_GCC_BRACE_GROUPS_FORBIDDEN - PERL_INT_MAX - PERL_INT_MIN - PERL_LONG_MAX - PERL_LONG_MIN - PERL_MAGIC_arylen - PERL_MAGIC_backref - PERL_MAGIC_bm - PERL_MAGIC_collxfrm - PERL_MAGIC_dbfile - PERL_MAGIC_dbline - PERL_MAGIC_defelem - PERL_MAGIC_env - PERL_MAGIC_envelem - PERL_MAGIC_ext - PERL_MAGIC_fm - PERL_MAGIC_glob - PERL_MAGIC_isa - PERL_MAGIC_isaelem - PERL_MAGIC_mutex - PERL_MAGIC_nkeys - PERL_MAGIC_overload - PERL_MAGIC_overload_elem - PERL_MAGIC_overload_table - PERL_MAGIC_pos - PERL_MAGIC_qr - PERL_MAGIC_regdata - PERL_MAGIC_regdatum - PERL_MAGIC_regex_global - PERL_MAGIC_shared - PERL_MAGIC_shared_scalar - PERL_MAGIC_sig - PERL_MAGIC_sigelem - PERL_MAGIC_substr - PERL_MAGIC_sv - PERL_MAGIC_taint - PERL_MAGIC_tied - PERL_MAGIC_tiedelem - PERL_MAGIC_tiedscalar - PERL_MAGIC_utf8 - PERL_MAGIC_uvar - PERL_MAGIC_uvar_elem - PERL_MAGIC_vec - PERL_MAGIC_vstring - PERL_QUAD_MAX - PERL_QUAD_MIN - PERL_REVISION - PERL_SCAN_ALLOW_UNDERSCORES - PERL_SCAN_DISALLOW_PREFIX - PERL_SCAN_GREATER_THAN_UV_MAX - PERL_SCAN_SILENT_ILLDIGIT - PERL_SHORT_MAX - PERL_SHORT_MIN - PERL_SIGNALS_UNSAFE_FLAG - PERL_SUBVERSION - PERL_UCHAR_MAX - PERL_UCHAR_MIN - PERL_UINT_MAX - PERL_UINT_MIN - PERL_ULONG_MAX - PERL_ULONG_MIN - PERL_UNUSED_ARG - PERL_UNUSED_CONTEXT - PERL_UNUSED_DECL - PERL_UNUSED_VAR - PERL_UQUAD_MAX - PERL_UQUAD_MIN - PERL_USE_GCC_BRACE_GROUPS - PERL_USHORT_MAX - PERL_USHORT_MIN - PERL_VERSION - Perl_warner - Perl_warner_nocontext - PL_compiling - PL_copline - PL_curcop - PL_curstash - PL_DBsingle - PL_DBsub - PL_debstash - PL_defgv - PL_diehook - PL_dirty - PL_dowarn - PL_errgv - PL_hexdigit - PL_hints - PL_na - PL_no_modify - PL_perl_destruct_level - PL_perldb - PL_ppaddr - PL_rsfp - PL_rsfp_filters - PL_signals - PL_stack_base - PL_stack_sp - PL_stdingv - PL_Sv - PL_sv_arenaroot - PL_sv_no - PL_sv_undef - PL_sv_yes - PL_tainted - PL_tainting - pMY_CXT - pMY_CXT_ - Poison - PoisonFree - PoisonNew - PoisonWith - pTHX - pTHX_ - PTR2IV - PTR2NV - PTR2ul - PTR2UV - PTRV - PUSHmortal - PUSHu - SAVE_DEFSV - START_EXTERN_C - START_MY_CXT - STMT_END - STMT_START - STR_WITH_LEN - sv_2pv_nolen - sv_2pvbyte - sv_2uv - sv_catpv_mg - sv_catpvf_mg - sv_catpvf_mg_nocontext - sv_catpvn_mg - sv_catpvn_nomg - sv_catpvs - sv_catsv_mg - sv_catsv_nomg - sv_pvn - sv_pvn_force - sv_pvn_nomg - sv_setiv_mg - sv_setnv_mg - sv_setpv_mg - sv_setpvf_mg - sv_setpvf_mg_nocontext - sv_setpvn_mg - sv_setpvs - sv_setsv_mg - sv_setsv_nomg - sv_setuv - sv_setuv_mg - sv_usepvn_mg - sv_uv - sv_vcatpvf - sv_vcatpvf_mg - sv_vsetpvf - sv_vsetpvf_mg - SVf - SvGETMAGIC - SvIV_nomg - SvMAGIC_set - SvPV_force_nomg - SvPV_nolen - SvPV_nomg - SvPVbyte - SvPVX_const - SvPVX_mutable - SvREFCNT_inc - SvREFCNT_inc_NN - SvREFCNT_inc_simple - SvREFCNT_inc_simple_NN - SvREFCNT_inc_simple_void - SvREFCNT_inc_simple_void_NN - SvREFCNT_inc_void - SvREFCNT_inc_void_NN - SvRV_set - SvSTASH_set - SvUV - SvUV_nomg - SvUV_set - SvUVX - SvUVx - SvUVXx - SvVSTRING_mg - UNDERBAR - UVof - UVSIZE - UVTYPE - UVuf - UVXf - UVxf - vnewSVpvf - WARN_ALL - WARN_AMBIGUOUS - WARN_ASSERTIONS - WARN_BAREWORD - WARN_CLOSED - WARN_CLOSURE - WARN_DEBUGGING - WARN_DEPRECATED - WARN_DIGIT - WARN_EXEC - WARN_EXITING - WARN_GLOB - WARN_INPLACE - WARN_INTERNAL - WARN_IO - WARN_LAYER - WARN_MALLOC - WARN_MISC - WARN_NEWLINE - WARN_NUMERIC - WARN_ONCE - WARN_OVERFLOW - WARN_PACK - WARN_PARENTHESIS - WARN_PIPE - WARN_PORTABLE - WARN_PRECEDENCE - WARN_PRINTF - WARN_PROTOTYPE - WARN_QW - WARN_RECURSION - WARN_REDEFINE - WARN_REGEXP - WARN_RESERVED - WARN_SEMICOLON - WARN_SEVERE - WARN_SIGNAL - WARN_SUBSTR - WARN_SYNTAX - WARN_TAINT - WARN_THREADS - WARN_UNINITIALIZED - WARN_UNOPENED - WARN_UNPACK - WARN_UNTIE - WARN_UTF8 - WARN_VOID - warner - XCPT_CATCH - XCPT_RETHROW - XCPT_TRY_END - XCPT_TRY_START - XPUSHmortal - XPUSHu - XSprePUSH - XSRETURN - XSRETURN_UV - XST_mUV - ZeroD - -=head2 Perl API not supported by ppport.h - -There is still a big part of the API not supported by F<ppport.h>. -Either because it doesn't make sense to back-port that part of the API, -or simply because it hasn't been implemented yet. Patches welcome! - -Here's a list of the currently unsupported API, and also the version of -Perl below which it is unsupported: - -=over 4 - -=item perl 5.9.4 - - MULTICALL - POP_MULTICALL - PUSH_MULTICALL - PerlIO_context_layers - gv_name_set - my_vsnprintf - newXS_flags - pad_sv - regclass_swash - stashpv_hvname_match - sv_usepvn_flags - -=item perl 5.9.3 - - av_arylen_p - ckwarn - ckwarn_d - csighandler - dMULTICALL - doref - gv_const_sv - gv_stashpvs - hv_eiter_p - hv_eiter_set - hv_name_set - hv_placeholders_get - hv_placeholders_p - hv_placeholders_set - hv_riter_p - hv_riter_set - is_utf8_string_loclen - my_sprintf - newGIVENOP - newSVhek - newSVpvs_share - newWHENOP - newWHILEOP - ref - savepvs - sortsv_flags - vverify - -=item perl 5.9.2 - - SvPVbyte_force - find_rundefsvoffset - gv_fetchpvn_flags - gv_fetchsv - op_refcnt_lock - op_refcnt_unlock - savesvpv - vnormal - -=item perl 5.9.1 - - hv_assert - hv_clear_placeholders - hv_scalar - scan_version - sv_2iv_flags - sv_2uv_flags - -=item perl 5.9.0 - - new_version - save_set_svflags - upg_version - vcmp - vnumify - vstringify - -=item perl 5.8.3 - - SvIsCOW - SvIsCOW_shared_hash - -=item perl 5.8.1 - - SvVOK - doing_taint - is_utf8_string_loc - packlist - save_bool - savestack_grow_cnt - scan_vstring - seed - sv_cat_decode - sv_compile_2op - sv_setpviv - sv_setpviv_mg - unpackstring - -=item perl 5.8.0 - - hv_iternext_flags - hv_store_flags - is_utf8_idcont - nothreadhook - -=item perl 5.7.3 - - PerlIO_clearerr - PerlIO_close - PerlIO_eof - PerlIO_error - PerlIO_fileno - PerlIO_fill - PerlIO_flush - PerlIO_get_base - PerlIO_get_bufsiz - PerlIO_get_cnt - PerlIO_get_ptr - PerlIO_read - PerlIO_seek - PerlIO_set_cnt - PerlIO_set_ptrcnt - PerlIO_setlinebuf - PerlIO_stderr - PerlIO_stdin - PerlIO_stdout - PerlIO_tell - PerlIO_unread - PerlIO_write - SvLOCK - SvSHARE - SvUNLOCK - atfork_lock - atfork_unlock - custom_op_desc - custom_op_name - deb - debstack - debstackptrs - gv_fetchmeth_autoload - ibcmp_utf8 - my_fork - my_socketpair - pack_cat - perl_destruct - pv_uni_display - save_shared_pvref - savesharedpv - sortsv - sv_copypv - sv_magicext - sv_nolocking - sv_nosharing - sv_recode_to_utf8 - sv_uni_display - to_uni_fold - to_uni_lower - to_uni_title - to_uni_upper - to_utf8_case - to_utf8_fold - to_utf8_lower - to_utf8_title - to_utf8_upper - unpack_str - uvchr_to_utf8_flags - uvuni_to_utf8_flags - vdeb - -=item perl 5.7.2 - - calloc - getcwd_sv - init_tm - malloc - mfree - mini_mktime - my_atof2 - my_strftime - op_null - realloc - sv_2pv_flags - sv_catpvn_flags - sv_catsv_flags - sv_pvn_force_flags - sv_setsv_flags - sv_utf8_upgrade_flags - swash_fetch - -=item perl 5.7.1 - - POPpbytex - SvUOK - bytes_from_utf8 - despatch_signals - do_openn - gv_handler - is_lvalue_sub - my_popen_list - newSVpvn_share - save_mortalizesv - save_padsv - scan_num - sv_force_normal_flags - sv_setref_uv - sv_unref_flags - sv_utf8_upgrade - utf8_length - utf8_to_uvchr - utf8_to_uvuni - utf8n_to_uvuni - uvuni_to_utf8 - -=item perl 5.6.1 - - SvGAMAGIC - apply_attrs_string - bytes_to_utf8 - gv_efullname4 - gv_fullname4 - is_utf8_string - save_generic_pvref - utf16_to_utf8 - utf16_to_utf8_reversed - utf8_to_bytes - -=item perl 5.6.0 - - SvIOK_UV - SvIOK_notUV - SvIOK_only_UV - SvPOK_only_UTF8 - SvPVbyte_nolen - SvPVbytex - SvPVbytex_force - SvPVutf8 - SvPVutf8_force - SvPVutf8_nolen - SvPVutf8x - SvPVutf8x_force - SvUTF8 - SvUTF8_off - SvUTF8_on - av_delete - av_exists - call_atexit - cast_i32 - cast_iv - cast_ulong - cast_uv - do_gv_dump - do_gvgv_dump - do_hv_dump - do_magic_dump - do_op_dump - do_open9 - do_pmop_dump - do_sv_dump - dump_all - dump_eval - dump_form - dump_indent - dump_packsubs - dump_sub - dump_vindent - get_context - get_ppaddr - gv_dump - init_i18nl10n - init_i18nl14n - is_uni_alnum - is_uni_alnum_lc - is_uni_alnumc - is_uni_alnumc_lc - is_uni_alpha - is_uni_alpha_lc - is_uni_ascii - is_uni_ascii_lc - is_uni_cntrl - is_uni_cntrl_lc - is_uni_digit - is_uni_digit_lc - is_uni_graph - is_uni_graph_lc - is_uni_idfirst - is_uni_idfirst_lc - is_uni_lower - is_uni_lower_lc - is_uni_print - is_uni_print_lc - is_uni_punct - is_uni_punct_lc - is_uni_space - is_uni_space_lc - is_uni_upper - is_uni_upper_lc - is_uni_xdigit - is_uni_xdigit_lc - is_utf8_alnum - is_utf8_alnumc - is_utf8_alpha - is_utf8_ascii - is_utf8_char - is_utf8_cntrl - is_utf8_digit - is_utf8_graph - is_utf8_idfirst - is_utf8_lower - is_utf8_mark - is_utf8_print - is_utf8_punct - is_utf8_space - is_utf8_upper - is_utf8_xdigit - load_module - magic_dump - mess - my_atof - my_fflush_all - newANONATTRSUB - newATTRSUB - newPADOP - newXS - newXSproto - new_collate - new_ctype - new_numeric - op_dump - perl_parse - pmop_dump - pv_display - re_intuit_start - re_intuit_string - reginitcolors - require_pv - safesyscalloc - safesysfree - safesysmalloc - safesysrealloc - save_I8 - save_alloc - save_destructor - save_destructor_x - save_re_context - save_vptr - scan_bin - set_context - set_numeric_local - set_numeric_radix - set_numeric_standard - str_to_version - sv_2pvutf8 - sv_2pvutf8_nolen - sv_force_normal - sv_len_utf8 - sv_pos_b2u - sv_pos_u2b - sv_pv - sv_pvbyte - sv_pvbyten - sv_pvbyten_force - sv_pvutf8 - sv_pvutf8n - sv_pvutf8n_force - sv_rvweaken - sv_utf8_decode - sv_utf8_downgrade - sv_utf8_encode - swash_init - tmps_grow - to_uni_lower_lc - to_uni_title_lc - to_uni_upper_lc - utf8_distance - utf8_hop - vcroak - vform - vload_module - vmess - vwarn - vwarner - -=item perl 5.005_03 - - POPpx - get_vtbl - save_generic_svref - -=item perl 5.005 - - PL_modglobal - cx_dump - debop - debprofdump - fbm_compile - fbm_instr - get_op_descs - get_op_names - init_stacks - mg_length - mg_size - newHVhv - new_stackinfo - regdump - regexec_flags - regnext - runops_debug - runops_standard - save_hints - save_iv - screaminstr - sv_iv - sv_nv - sv_peek - sv_true - -=item perl 5.004_05 - - do_binmode - save_aelem - save_helem - -=item perl 5.004 - - GIMME_V - G_VOID - HEf_SVKEY - HeHASH - HeKEY - HeKLEN - HePV - HeSVKEY - HeSVKEY_force - HeSVKEY_set - HeVAL - SvSetMagicSV - SvSetMagicSV_nosteal - SvSetSV_nosteal - SvTAINTED - SvTAINTED_off - SvTAINTED_on - block_gimme - call_list - cv_const_sv - delimcpy - do_open - form - gv_autoload4 - gv_efullname3 - gv_fetchmethod_autoload - gv_fullname3 - hv_delayfree_ent - hv_delete_ent - hv_exists_ent - hv_fetch_ent - hv_free_ent - hv_iterkeysv - hv_ksplit - hv_store_ent - ibcmp_locale - my_failure_exit - my_memcmp - my_pclose - my_popen - newSVpvf - rsignal - rsignal_state - save_I16 - save_gp - share_hek - start_subparse - sv_catpvf - sv_catpvf_mg - sv_cmp_locale - sv_derived_from - sv_gets - sv_setpvf - sv_setpvf_mg - sv_taint - sv_tainted - sv_untaint - sv_vcatpvf - sv_vcatpvf_mg - sv_vcatpvfn - sv_vsetpvf - sv_vsetpvf_mg - sv_vsetpvfn - unsharepvn - vnewSVpvf - warner - -=back - -=head1 BUGS - -If you find any bugs, C<Devel::PPPort> doesn't seem to build on your -system or any of its tests fail, please use the CPAN Request Tracker -at L<http://rt.cpan.org/> to create a ticket for the module. - -=head1 AUTHORS - -=over 2 - -=item * - -Version 1.x of Devel::PPPort was written by Kenneth Albanowski. - -=item * - -Version 2.x was ported to the Perl core by Paul Marquess. - -=item * - -Version 3.x was ported back to CPAN by Marcus Holland-Moritz. - -=back - -=head1 COPYRIGHT - -Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz. - -Version 2.x, Copyright (C) 2001, Paul Marquess. - -Version 1.x, Copyright (C) 1999, Kenneth Albanowski. - -This program is free software; you can redistribute it and/or -modify it under the same terms as Perl itself. - -=head1 SEE ALSO - -See L<h2xs>, L<ppport.h>. - -=cut - -package Devel::PPPort; - -require DynaLoader; -use strict; -use vars qw($VERSION @ISA $data); - -$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_04 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; - -@ISA = qw(DynaLoader); - -bootstrap Devel::PPPort; - -sub _init_data -{ - $data = do { local $/; <DATA> }; - my $now = localtime; - my $pkg = 'Devel::PPPort'; - $data =~ s/__PERL_VERSION__/$]/g; - $data =~ s/__VERSION__/$VERSION/g; - $data =~ s/__DATE__/$now/g; - $data =~ s/__PKG__/$pkg/g; - $data =~ s/^\|>//gm; -} - -sub WriteFile -{ - my $file = shift || 'ppport.h'; - defined $data or _init_data(); - my $copy = $data; - $copy =~ s/\bppport\.h\b/$file/g; - - open F, ">$file" or return undef; - print F $copy; - close F; - - return 1; -} - -1; - -__DATA__ -#if 0 -<<'SKIP'; -#endif -/* ----------------------------------------------------------------------- - - ppport.h -- Perl/Pollution/Portability Version __VERSION__ - - Automatically created by __PKG__ running under - perl __PERL_VERSION__ on __DATE__. - - Do NOT edit this file directly! -- Edit PPPort_pm.PL and the - includes in parts/inc/ instead. - - Use 'perldoc ppport.h' to view the documentation below. - ----------------------------------------------------------------------- - -SKIP - -|>=pod -|> -|>=head1 NAME -|> -|>ppport.h - Perl/Pollution/Portability version __VERSION__ -|> -|>=head1 SYNOPSIS -|> -|> perl ppport.h [options] [source files] -|> -|> Searches current directory for files if no [source files] are given -|> -|> --help show short help -|> -|> --patch=file write one patch file with changes -|> --copy=suffix write changed copies with suffix -|> --diff=program use diff program and options -|> -|> --compat-version=version provide compatibility with Perl version -|> --cplusplus accept C++ comments -|> -|> --quiet don't output anything except fatal errors -|> --nodiag don't show diagnostics -|> --nohints don't show hints -|> --nochanges don't suggest changes -|> --nofilter don't filter input files -|> -|> --strip strip all script and doc functionality from -|> ppport.h (this, obviously, cannot be undone) -|> -|> --list-provided list provided API -|> --list-unsupported list unsupported API -|> --api-info=name show Perl API portability information -|> -|>=head1 COMPATIBILITY -|> -|>This version of F<ppport.h> is designed to support operation with Perl -|>installations back to 5.003, and has been tested up to 5.9.4. -|> -|>=head1 OPTIONS -|> -|>=head2 --help -|> -|>Display a brief usage summary. -|> -|>=head2 --patch=I<file> -|> -|>If this option is given, a single patch file will be created if -|>any changes are suggested. This requires a working diff program -|>to be installed on your system. -|> -|>=head2 --copy=I<suffix> -|> -|>If this option is given, a copy of each file will be saved with -|>the given suffix that contains the suggested changes. This does -|>not require any external programs. -|> -|>If neither C<--patch> or C<--copy> are given, the default is to -|>simply print the diffs for each file. This requires either -|>C<Text::Diff> or a C<diff> program to be installed. -|> -|>=head2 --diff=I<program> -|> -|>Manually set the diff program and options to use. The default -|>is to use C<Text::Diff>, when installed, and output unified -|>context diffs. -|> -|>=head2 --compat-version=I<version> -|> -|>Tell F<ppport.h> to check for compatibility with the given -|>Perl version. The default is to check for compatibility with Perl -|>version 5.003. You can use this option to reduce the output -|>of F<ppport.h> if you intend to be backward compatible only -|>down to a certain Perl version. -|> -|>=head2 --cplusplus -|> -|>Usually, F<ppport.h> will detect C++ style comments and -|>replace them with C style comments for portability reasons. -|>Using this option instructs F<ppport.h> to leave C++ -|>comments untouched. -|> -|>=head2 --quiet -|> -|>Be quiet. Don't print anything except fatal errors. -|> -|>=head2 --nodiag -|> -|>Don't output any diagnostic messages. Only portability -|>alerts will be printed. -|> -|>=head2 --nohints -|> -|>Don't output any hints. Hints often contain useful portability -|>notes. -|> -|>=head2 --nochanges -|> -|>Don't suggest any changes. Only give diagnostic output and hints -|>unless these are also deactivated. -|> -|>=head2 --nofilter -|> -|>Don't filter the list of input files. By default, files not looking -|>like source code (i.e. not *.xs, *.c, *.cc, *.cpp or *.h) are skipped. -|> -|>=head2 --strip -|> -|>Strip all script and documentation functionality from F<ppport.h>. -|>This reduces the size of F<ppport.h> dramatically and may be useful -|>if you want to include F<ppport.h> in smaller modules without -|>increasing their distribution size too much. -|> -|>=head2 --list-provided -|> -|>Lists the API elements for which compatibility is provided by -|>F<ppport.h>. Also lists if it must be explicitly requested, -|>if it has dependencies, and if there are hints for it. -|> -|>=head2 --list-unsupported -|> -|>Lists the API elements that are known not to be supported by -|>F<ppport.h> and below which version of Perl they probably -|>won't be available or work. -|> -|>=head2 --api-info=I<name> -|> -|>Show portability information for API elements matching I<name>. -|>If I<name> is surrounded by slashes, it is interpreted as a regular -|>expression. -|> -|>=head1 DESCRIPTION -|> -|>In order for a Perl extension (XS) module to be as portable as possible -|>across differing versions of Perl itself, certain steps need to be taken. -|> -|>=over 4 -|> -|>=item * -|> -|>Including this header is the first major one. This alone will give you -|>access to a large part of the Perl API that hasn't been available in -|>earlier Perl releases. Use -|> -|> perl ppport.h --list-provided -|> -|>to see which API elements are provided by ppport.h. -|> -|>=item * -|> -|>You should avoid using deprecated parts of the API. For example, using -|>global Perl variables without the C<PL_> prefix is deprecated. Also, -|>some API functions used to have a C<perl_> prefix. Using this form is -|>also deprecated. You can safely use the supported API, as F<ppport.h> -|>will provide wrappers for older Perl versions. -|> -|>=item * -|> -|>If you use one of a few functions or variables that were not present in -|>earlier versions of Perl, and that can't be provided using a macro, you -|>have to explicitly request support for these functions by adding one or -|>more C<#define>s in your source code before the inclusion of F<ppport.h>. -|> -|>These functions or variables will be marked C<explicit> in the list shown -|>by C<--list-provided>. -|> -|>Depending on whether you module has a single or multiple files that -|>use such functions or variables, you want either C<static> or global -|>variants. -|> -|>For a C<static> function or variable (used only in a single source -|>file), use: -|> -|> #define NEED_function -|> #define NEED_variable -|> -|>For a global function or variable (used in multiple source files), -|>use: -|> -|> #define NEED_function_GLOBAL -|> #define NEED_variable_GLOBAL -|> -|>Note that you mustn't have more than one global request for the -|>same function or variable in your project. -|> -|> Function / Variable Static Request Global Request -|> ----------------------------------------------------------------------------------------- -|> PL_signals NEED_PL_signals NEED_PL_signals_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 -|> my_snprintf() NEED_my_snprintf NEED_my_snprintf_GLOBAL -|> newCONSTSUB() NEED_newCONSTSUB NEED_newCONSTSUB_GLOBAL -|> newRV_noinc() NEED_newRV_noinc NEED_newRV_noinc_GLOBAL -|> sv_2pv_nolen() NEED_sv_2pv_nolen NEED_sv_2pv_nolen_GLOBAL -|> sv_2pvbyte() NEED_sv_2pvbyte NEED_sv_2pvbyte_GLOBAL -|> sv_catpvf_mg() NEED_sv_catpvf_mg NEED_sv_catpvf_mg_GLOBAL -|> sv_catpvf_mg_nocontext() NEED_sv_catpvf_mg_nocontext NEED_sv_catpvf_mg_nocontext_GLOBAL -|> sv_setpvf_mg() NEED_sv_setpvf_mg NEED_sv_setpvf_mg_GLOBAL -|> sv_setpvf_mg_nocontext() NEED_sv_setpvf_mg_nocontext NEED_sv_setpvf_mg_nocontext_GLOBAL -|> vnewSVpvf() NEED_vnewSVpvf NEED_vnewSVpvf_GLOBAL -|> warner() NEED_warner NEED_warner_GLOBAL -|> -|>To avoid namespace conflicts, you can change the namespace of the -|>explicitly exported functions / variables using the C<DPPP_NAMESPACE> -|>macro. Just C<#define> the macro before including C<ppport.h>: -|> -|> #define DPPP_NAMESPACE MyOwnNamespace_ -|> #include "ppport.h" -|> -|>The default namespace is C<DPPP_>. -|> -|>=back -|> -|>The good thing is that most of the above can be checked by running -|>F<ppport.h> on your source code. See the next section for -|>details. -|> -|>=head1 EXAMPLES -|> -|>To verify whether F<ppport.h> is needed for your module, whether you -|>should make any changes to your code, and whether any special defines -|>should be used, F<ppport.h> can be run as a Perl script to check your -|>source code. Simply say: -|> -|> perl ppport.h -|> -|>The result will usually be a list of patches suggesting changes -|>that should at least be acceptable, if not necessarily the most -|>efficient solution, or a fix for all possible problems. -|> -|>If you know that your XS module uses features only available in -|>newer Perl releases, if you're aware that it uses C++ comments, -|>and if you want all suggestions as a single patch file, you could -|>use something like this: -|> -|> perl ppport.h --compat-version=5.6.0 --cplusplus --patch=test.diff -|> -|>If you only want your code to be scanned without any suggestions -|>for changes, use: -|> -|> perl ppport.h --nochanges -|> -|>You can specify a different C<diff> program or options, using -|>the C<--diff> option: -|> -|> perl ppport.h --diff='diff -C 10' -|> -|>This would output context diffs with 10 lines of context. -|> -|>To display portability information for the C<newSVpvn> function, -|>use: -|> -|> perl ppport.h --api-info=newSVpvn -|> -|>Since the argument to C<--api-info> can be a regular expression, -|>you can use -|> -|> perl ppport.h --api-info=/_nomg$/ -|> -|>to display portability information for all C<_nomg> functions or -|> -|> perl ppport.h --api-info=/./ -|> -|>to display information for all known API elements. -|> -|>=head1 BUGS -|> -|>If this version of F<ppport.h> is causing failure during -|>the compilation of this module, please check if newer versions -|>of either this module or C<Devel::PPPort> are available on CPAN -|>before sending a bug report. -|> -|>If F<ppport.h> was generated using the latest version of -|>C<Devel::PPPort> and is causing failure of this module, please -|>file a bug report using the CPAN Request Tracker at L<http://rt.cpan.org/>. -|> -|>Please include the following information: -|> -|>=over 4 -|> -|>=item 1. -|> -|>The complete output from running "perl -V" -|> -|>=item 2. -|> -|>This file. -|> -|>=item 3. -|> -|>The name and version of the module you were trying to build. -|> -|>=item 4. -|> -|>A full log of the build that failed. -|> -|>=item 5. -|> -|>Any other information that you think could be relevant. -|> -|>=back -|> -|>For the latest version of this code, please get the C<Devel::PPPort> -|>module from CPAN. -|> -|>=head1 COPYRIGHT -|> -|>Version 3.x, Copyright (c) 2004-2006, Marcus Holland-Moritz. -|> -|>Version 2.x, Copyright (C) 2001, Paul Marquess. -|> -|>Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -|> -|>This program is free software; you can redistribute it and/or -|>modify it under the same terms as Perl itself. -|> -|>=head1 SEE ALSO -|> -|>See L<Devel::PPPort>. -|> -|>=cut - -use strict; - -my %opt = ( - quiet => 0, - diag => 1, - hints => 1, - changes => 1, - cplusplus => 0, - filter => 1, - strip => 0, -); - -my($ppport) = $0 =~ /([\w.]+)$/; -my $LF = '(?:\r\n|[\r\n])'; # line feed -my $HS = "[ \t]"; # horizontal whitespace - -eval { - require Getopt::Long; - Getopt::Long::GetOptions(\%opt, qw( - help quiet diag! filter! hints! changes! cplusplus strip - patch=s copy=s diff=s compat-version=s - list-provided list-unsupported api-info=s - )) or usage(); -}; - -if ($@ and grep /^-/, @ARGV) { - usage() if "@ARGV" =~ /^--?h(?:elp)?$/; - die "Getopt::Long not found. Please don't use any options.\n"; -} - -usage() if $opt{help}; -strip() if $opt{strip}; - -if (exists $opt{'compat-version'}) { - my($r,$v,$s) = eval { parse_version($opt{'compat-version'}) }; - if ($@) { - die "Invalid version number format: '$opt{'compat-version'}'\n"; - } - die "Only Perl 5 is supported\n" if $r != 5; - die "Invalid version number: $opt{'compat-version'}\n" if $v >= 1000 || $s >= 1000; - $opt{'compat-version'} = sprintf "%d.%03d%03d", $r, $v, $s; -} -else { - $opt{'compat-version'} = 5; -} - -# Never use C comments in this file!!!!! -my $ccs = '/'.'*'; -my $cce = '*'.'/'; -my $rccs = quotemeta $ccs; -my $rcce = quotemeta $cce; - -my %API = map { /^(\w+)\|([^|]*)\|([^|]*)\|(\w*)$/ - ? ( $1 => { - ($2 ? ( base => $2 ) : ()), - ($3 ? ( todo => $3 ) : ()), - (index($4, 'v') >= 0 ? ( varargs => 1 ) : ()), - (index($4, 'p') >= 0 ? ( provided => 1 ) : ()), - (index($4, 'n') >= 0 ? ( nothxarg => 1 ) : ()), - } ) - : die "invalid spec: $_" } qw( -AvFILLp|5.004050||p -AvFILL||| -CLASS|||n -CX_CURPAD_SAVE||| -CX_CURPAD_SV||| -CopFILEAV|5.006000||p -CopFILEGV_set|5.006000||p -CopFILEGV|5.006000||p -CopFILESV|5.006000||p -CopFILE_set|5.006000||p -CopFILE|5.006000||p -CopSTASHPV_set|5.006000||p -CopSTASHPV|5.006000||p -CopSTASH_eq|5.006000||p -CopSTASH_set|5.006000||p -CopSTASH|5.006000||p -CopyD|5.009002||p -Copy||| -CvPADLIST||| -CvSTASH||| -CvWEAKOUTSIDE||| -DEFSV|5.004050||p -END_EXTERN_C|5.005000||p -ENTER||| -ERRSV|5.004050||p -EXTEND||| -EXTERN_C|5.005000||p -F0convert|||n -FREETMPS||| -GIMME_V||5.004000|n -GIMME|||n -GROK_NUMERIC_RADIX|5.007002||p -G_ARRAY||| -G_DISCARD||| -G_EVAL||| -G_NOARGS||| -G_SCALAR||| -G_VOID||5.004000| -GetVars||| -GvSV||| -Gv_AMupdate||| -HEf_SVKEY||5.004000| -HeHASH||5.004000| -HeKEY||5.004000| -HeKLEN||5.004000| -HePV||5.004000| -HeSVKEY_force||5.004000| -HeSVKEY_set||5.004000| -HeSVKEY||5.004000| -HeVAL||5.004000| -HvNAME||| -INT2PTR|5.006000||p -IN_LOCALE_COMPILETIME|5.007002||p -IN_LOCALE_RUNTIME|5.007002||p -IN_LOCALE|5.007002||p -IN_PERL_COMPILETIME|5.008001||p -IS_NUMBER_GREATER_THAN_UV_MAX|5.007002||p -IS_NUMBER_INFINITY|5.007002||p -IS_NUMBER_IN_UV|5.007002||p -IS_NUMBER_NAN|5.007003||p -IS_NUMBER_NEG|5.007002||p -IS_NUMBER_NOT_INT|5.007002||p -IVSIZE|5.006000||p -IVTYPE|5.006000||p -IVdf|5.006000||p -LEAVE||| -LVRET||| -MARK||| -MULTICALL||5.009004| -MY_CXT_CLONE|5.009002||p -MY_CXT_INIT|5.007003||p -MY_CXT|5.007003||p -MoveD|5.009002||p -Move||| -NOOP|5.005000||p -NUM2PTR|5.006000||p -NVTYPE|5.006000||p -NVef|5.006001||p -NVff|5.006001||p -NVgf|5.006001||p -Newxc|5.009003||p -Newxz|5.009003||p -Newx|5.009003||p -Nullav||| -Nullch||| -Nullcv||| -Nullhv||| -Nullsv||| -ORIGMARK||| -PAD_BASE_SV||| -PAD_CLONE_VARS||| -PAD_COMPNAME_FLAGS||| -PAD_COMPNAME_GEN_set||| -PAD_COMPNAME_GEN||| -PAD_COMPNAME_OURSTASH||| -PAD_COMPNAME_PV||| -PAD_COMPNAME_TYPE||| -PAD_RESTORE_LOCAL||| -PAD_SAVE_LOCAL||| -PAD_SAVE_SETNULLPAD||| -PAD_SETSV||| -PAD_SET_CUR_NOSAVE||| -PAD_SET_CUR||| -PAD_SVl||| -PAD_SV||| -PERL_ABS|5.008001||p -PERL_BCDVERSION|5.009004||p -PERL_GCC_BRACE_GROUPS_FORBIDDEN|5.008001||p -PERL_INT_MAX|5.004000||p -PERL_INT_MIN|5.004000||p -PERL_LONG_MAX|5.004000||p -PERL_LONG_MIN|5.004000||p -PERL_MAGIC_arylen|5.007002||p -PERL_MAGIC_backref|5.007002||p -PERL_MAGIC_bm|5.007002||p -PERL_MAGIC_collxfrm|5.007002||p -PERL_MAGIC_dbfile|5.007002||p -PERL_MAGIC_dbline|5.007002||p -PERL_MAGIC_defelem|5.007002||p -PERL_MAGIC_envelem|5.007002||p -PERL_MAGIC_env|5.007002||p -PERL_MAGIC_ext|5.007002||p -PERL_MAGIC_fm|5.007002||p -PERL_MAGIC_glob|5.007002||p -PERL_MAGIC_isaelem|5.007002||p -PERL_MAGIC_isa|5.007002||p -PERL_MAGIC_mutex|5.007002||p -PERL_MAGIC_nkeys|5.007002||p -PERL_MAGIC_overload_elem|5.007002||p -PERL_MAGIC_overload_table|5.007002||p -PERL_MAGIC_overload|5.007002||p -PERL_MAGIC_pos|5.007002||p -PERL_MAGIC_qr|5.007002||p -PERL_MAGIC_regdata|5.007002||p -PERL_MAGIC_regdatum|5.007002||p -PERL_MAGIC_regex_global|5.007002||p -PERL_MAGIC_shared_scalar|5.007003||p -PERL_MAGIC_shared|5.007003||p -PERL_MAGIC_sigelem|5.007002||p -PERL_MAGIC_sig|5.007002||p -PERL_MAGIC_substr|5.007002||p -PERL_MAGIC_sv|5.007002||p -PERL_MAGIC_taint|5.007002||p -PERL_MAGIC_tiedelem|5.007002||p -PERL_MAGIC_tiedscalar|5.007002||p -PERL_MAGIC_tied|5.007002||p -PERL_MAGIC_utf8|5.008001||p -PERL_MAGIC_uvar_elem|5.007003||p -PERL_MAGIC_uvar|5.007002||p -PERL_MAGIC_vec|5.007002||p -PERL_MAGIC_vstring|5.008001||p -PERL_QUAD_MAX|5.004000||p -PERL_QUAD_MIN|5.004000||p -PERL_REVISION|5.006000||p -PERL_SCAN_ALLOW_UNDERSCORES|5.007003||p -PERL_SCAN_DISALLOW_PREFIX|5.007003||p -PERL_SCAN_GREATER_THAN_UV_MAX|5.007003||p -PERL_SCAN_SILENT_ILLDIGIT|5.008001||p -PERL_SHORT_MAX|5.004000||p -PERL_SHORT_MIN|5.004000||p -PERL_SIGNALS_UNSAFE_FLAG|5.008001||p -PERL_SUBVERSION|5.006000||p -PERL_UCHAR_MAX|5.004000||p -PERL_UCHAR_MIN|5.004000||p -PERL_UINT_MAX|5.004000||p -PERL_UINT_MIN|5.004000||p -PERL_ULONG_MAX|5.004000||p -PERL_ULONG_MIN|5.004000||p -PERL_UNUSED_ARG|5.009003||p -PERL_UNUSED_CONTEXT|5.009004||p -PERL_UNUSED_DECL|5.007002||p -PERL_UNUSED_VAR|5.007002||p -PERL_UQUAD_MAX|5.004000||p -PERL_UQUAD_MIN|5.004000||p -PERL_USE_GCC_BRACE_GROUPS|5.009004||p -PERL_USHORT_MAX|5.004000||p -PERL_USHORT_MIN|5.004000||p -PERL_VERSION|5.006000||p -PL_DBsingle|||pn -PL_DBsub|||pn -PL_DBtrace|||n -PL_Sv|5.005000||p -PL_compiling|5.004050||p -PL_copline|5.005000||p -PL_curcop|5.004050||p -PL_curstash|5.004050||p -PL_debstash|5.004050||p -PL_defgv|5.004050||p -PL_diehook|5.004050||p -PL_dirty|5.004050||p -PL_dowarn|||pn -PL_errgv|5.004050||p -PL_hexdigit|5.005000||p -PL_hints|5.005000||p -PL_last_in_gv|||n -PL_modglobal||5.005000|n -PL_na|5.004050||pn -PL_no_modify|5.006000||p -PL_ofs_sv|||n -PL_perl_destruct_level|5.004050||p -PL_perldb|5.004050||p -PL_ppaddr|5.006000||p -PL_rsfp_filters|5.004050||p -PL_rsfp|5.004050||p -PL_rs|||n -PL_signals|5.008001||p -PL_stack_base|5.004050||p -PL_stack_sp|5.004050||p -PL_stdingv|5.004050||p -PL_sv_arenaroot|5.004050||p -PL_sv_no|5.004050||pn -PL_sv_undef|5.004050||pn -PL_sv_yes|5.004050||pn -PL_tainted|5.004050||p -PL_tainting|5.004050||p -POP_MULTICALL||5.009004| -POPi|||n -POPl|||n -POPn|||n -POPpbytex||5.007001|n -POPpx||5.005030|n -POPp|||n -POPs|||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.009004| -PUSHi||| -PUSHmortal|5.009002||p -PUSHn||| -PUSHp||| -PUSHs||| -PUSHu|5.004000||p -PUTBACK||| -PerlIO_clearerr||5.007003| -PerlIO_close||5.007003| -PerlIO_context_layers||5.009004| -PerlIO_eof||5.007003| -PerlIO_error||5.007003| -PerlIO_fileno||5.007003| -PerlIO_fill||5.007003| -PerlIO_flush||5.007003| -PerlIO_get_base||5.007003| -PerlIO_get_bufsiz||5.007003| -PerlIO_get_cnt||5.007003| -PerlIO_get_ptr||5.007003| -PerlIO_read||5.007003| -PerlIO_seek||5.007003| -PerlIO_set_cnt||5.007003| -PerlIO_set_ptrcnt||5.007003| -PerlIO_setlinebuf||5.007003| -PerlIO_stderr||5.007003| -PerlIO_stdin||5.007003| -PerlIO_stdout||5.007003| -PerlIO_tell||5.007003| -PerlIO_unread||5.007003| -PerlIO_write||5.007003| -Perl_warner_nocontext|5.006000||p -Perl_warner|5.006000||p -PoisonFree|5.009004||p -PoisonNew|5.009004||p -PoisonWith|5.009004||p -Poison|5.008000||p -RETVAL|||n -Renewc||| -Renew||| -SAVECLEARSV||| -SAVECOMPPAD||| -SAVEPADSV||| -SAVETMPS||| -SAVE_DEFSV|5.004050||p -SPAGAIN||| -SP||| -START_EXTERN_C|5.005000||p -START_MY_CXT|5.007003||p -STMT_END|||p -STMT_START|||p -STR_WITH_LEN|5.009003||p -ST||| -SVf|5.006000||p -SVt_IV||| -SVt_NV||| -SVt_PVAV||| -SVt_PVCV||| -SVt_PVHV||| -SVt_PVMG||| -SVt_PV||| -Safefree||| -Slab_Alloc||| -Slab_Free||| -StructCopy||| -SvCUR_set||| -SvCUR||| -SvEND||| -SvGAMAGIC||5.006001| -SvGETMAGIC|5.004050||p -SvGROW||| -SvIOK_UV||5.006000| -SvIOK_notUV||5.006000| -SvIOK_off||| -SvIOK_only_UV||5.006000| -SvIOK_only||| -SvIOK_on||| -SvIOKp||| -SvIOK||| -SvIVX||| -SvIV_nomg|5.009001||p -SvIV_set||| -SvIVx||| -SvIV||| -SvIsCOW_shared_hash||5.008003| -SvIsCOW||5.008003| -SvLEN_set||| -SvLEN||| -SvLOCK||5.007003| -SvMAGIC_set|5.009003||p -SvNIOK_off||| -SvNIOKp||| -SvNIOK||| -SvNOK_off||| -SvNOK_only||| -SvNOK_on||| -SvNOKp||| -SvNOK||| -SvNVX||| -SvNV_set||| -SvNVx||| -SvNV||| -SvOK||| -SvOOK||| -SvPOK_off||| -SvPOK_only_UTF8||5.006000| -SvPOK_only||| -SvPOK_on||| -SvPOKp||| -SvPOK||| -SvPVX_const|5.009003||p -SvPVX_mutable|5.009003||p -SvPVX||| -SvPV_force_nomg|5.007002||p -SvPV_force||| -SvPV_nolen|5.006000||p -SvPV_nomg|5.007002||p -SvPV_set||| -SvPVbyte_force||5.009002| -SvPVbyte_nolen||5.006000| -SvPVbytex_force||5.006000| -SvPVbytex||5.006000| -SvPVbyte|5.006000||p -SvPVutf8_force||5.006000| -SvPVutf8_nolen||5.006000| -SvPVutf8x_force||5.006000| -SvPVutf8x||5.006000| -SvPVutf8||5.006000| -SvPVx||| -SvPV||| -SvREFCNT_dec||| -SvREFCNT_inc_NN|5.009004||p -SvREFCNT_inc_simple_NN|5.009004||p -SvREFCNT_inc_simple_void_NN|5.009004||p -SvREFCNT_inc_simple_void|5.009004||p -SvREFCNT_inc_simple|5.009004||p -SvREFCNT_inc_void_NN|5.009004||p -SvREFCNT_inc_void|5.009004||p -SvREFCNT_inc|||p -SvREFCNT||| -SvROK_off||| -SvROK_on||| -SvROK||| -SvRV_set|5.009003||p -SvRV||| -SvSETMAGIC||| -SvSHARE||5.007003| -SvSTASH_set|5.009003||p -SvSTASH||| -SvSetMagicSV_nosteal||5.004000| -SvSetMagicSV||5.004000| -SvSetSV_nosteal||5.004000| -SvSetSV||| -SvTAINTED_off||5.004000| -SvTAINTED_on||5.004000| -SvTAINTED||5.004000| -SvTAINT||| -SvTRUE||| -SvTYPE||| -SvUNLOCK||5.007003| -SvUOK||5.007001| -SvUPGRADE||| -SvUTF8_off||5.006000| -SvUTF8_on||5.006000| -SvUTF8||5.006000| -SvUVXx|5.004000||p -SvUVX|5.004000||p -SvUV_nomg|5.009001||p -SvUV_set|5.009003||p -SvUVx|5.004000||p -SvUV|5.004000||p -SvVOK||5.008001| -SvVSTRING_mg|5.009004||p -THIS|||n -UNDERBAR|5.009002||p -UVSIZE|5.006000||p -UVTYPE|5.006000||p -UVXf|5.007001||p -UVof|5.006000||p -UVuf|5.006000||p -UVxf|5.006000||p -WARN_ALL|5.006000||p -WARN_AMBIGUOUS|5.006000||p -WARN_ASSERTIONS|5.009000||p -WARN_BAREWORD|5.006000||p -WARN_CLOSED|5.006000||p -WARN_CLOSURE|5.006000||p -WARN_DEBUGGING|5.006000||p -WARN_DEPRECATED|5.006000||p -WARN_DIGIT|5.006000||p -WARN_EXEC|5.006000||p -WARN_EXITING|5.006000||p -WARN_GLOB|5.006000||p -WARN_INPLACE|5.006000||p -WARN_INTERNAL|5.006000||p -WARN_IO|5.006000||p -WARN_LAYER|5.008000||p -WARN_MALLOC|5.006000||p -WARN_MISC|5.006000||p -WARN_NEWLINE|5.006000||p -WARN_NUMERIC|5.006000||p -WARN_ONCE|5.006000||p -WARN_OVERFLOW|5.006000||p -WARN_PACK|5.006000||p -WARN_PARENTHESIS|5.006000||p -WARN_PIPE|5.006000||p -WARN_PORTABLE|5.006000||p -WARN_PRECEDENCE|5.006000||p -WARN_PRINTF|5.006000||p -WARN_PROTOTYPE|5.006000||p -WARN_QW|5.006000||p -WARN_RECURSION|5.006000||p -WARN_REDEFINE|5.006000||p -WARN_REGEXP|5.006000||p -WARN_RESERVED|5.006000||p -WARN_SEMICOLON|5.006000||p -WARN_SEVERE|5.006000||p -WARN_SIGNAL|5.006000||p -WARN_SUBSTR|5.006000||p -WARN_SYNTAX|5.006000||p -WARN_TAINT|5.006000||p -WARN_THREADS|5.008000||p -WARN_UNINITIALIZED|5.006000||p -WARN_UNOPENED|5.006000||p -WARN_UNPACK|5.006000||p -WARN_UNTIE|5.006000||p -WARN_UTF8|5.006000||p -WARN_VOID|5.006000||p -XCPT_CATCH|5.009002||p -XCPT_RETHROW|5.009002||p -XCPT_TRY_END|5.009002||p -XCPT_TRY_START|5.009002||p -XPUSHi||| -XPUSHmortal|5.009002||p -XPUSHn||| -XPUSHp||| -XPUSHs||| -XPUSHu|5.004000||p -XSRETURN_EMPTY||| -XSRETURN_IV||| -XSRETURN_NO||| -XSRETURN_NV||| -XSRETURN_PV||| -XSRETURN_UNDEF||| -XSRETURN_UV|5.008001||p -XSRETURN_YES||| -XSRETURN|||p -XST_mIV||| -XST_mNO||| -XST_mNV||| -XST_mPV||| -XST_mUNDEF||| -XST_mUV|5.008001||p -XST_mYES||| -XS_VERSION_BOOTCHECK||| -XS_VERSION||| -XSprePUSH|5.006000||p -XS||| -ZeroD|5.009002||p -Zero||| -_aMY_CXT|5.007003||p -_pMY_CXT|5.007003||p -aMY_CXT_|5.007003||p -aMY_CXT|5.007003||p -aTHX_|5.006000||p -aTHX|5.006000||p -add_data|||n -addmad||| -allocmy||| -amagic_call||| -amagic_cmp_locale||| -amagic_cmp||| -amagic_i_ncmp||| -amagic_ncmp||| -any_dup||| -ao||| -append_elem||| -append_list||| -append_madprops||| -apply_attrs_my||| -apply_attrs_string||5.006001| -apply_attrs||| -apply||| -atfork_lock||5.007003|n -atfork_unlock||5.007003|n -av_arylen_p||5.009003| -av_clear||| -av_delete||5.006000| -av_exists||5.006000| -av_extend||| -av_fake||| -av_fetch||| -av_fill||| -av_len||| -av_make||| -av_pop||| -av_push||| -av_reify||| -av_shift||| -av_store||| -av_undef||| -av_unshift||| -ax|||n -bad_type||| -bind_match||| -block_end||| -block_gimme||5.004000| -block_start||| -boolSV|5.004000||p -boot_core_PerlIO||| -boot_core_UNIVERSAL||| -boot_core_xsutils||| -bytes_from_utf8||5.007001| -bytes_to_uni|||n -bytes_to_utf8||5.006001| -call_argv|5.006000||p -call_atexit||5.006000| -call_list||5.004000| -call_method|5.006000||p -call_pv|5.006000||p -call_sv|5.006000||p -calloc||5.007002|n -cando||| -cast_i32||5.006000| -cast_iv||5.006000| -cast_ulong||5.006000| -cast_uv||5.006000| -check_type_and_open||| -check_uni||| -checkcomma||| -checkposixcc||| -ckWARN|5.006000||p -ck_anoncode||| -ck_bitop||| -ck_concat||| -ck_defined||| -ck_delete||| -ck_die||| -ck_eof||| -ck_eval||| -ck_exec||| -ck_exists||| -ck_exit||| -ck_ftst||| -ck_fun||| -ck_glob||| -ck_grep||| -ck_index||| -ck_join||| -ck_lengthconst||| -ck_lfun||| -ck_listiob||| -ck_match||| -ck_method||| -ck_null||| -ck_open||| -ck_repeat||| -ck_require||| -ck_retarget||| -ck_return||| -ck_rfun||| -ck_rvconst||| -ck_sassign||| -ck_say||| -ck_select||| -ck_shift||| -ck_sort||| -ck_spair||| -ck_split||| -ck_subr||| -ck_substr||| -ck_svconst||| -ck_trunc||| -ck_unpack||| -ckwarn_d||5.009003| -ckwarn||5.009003| -cl_and|||n -cl_anything|||n -cl_init_zero|||n -cl_init|||n -cl_is_anything|||n -cl_or|||n -clear_placeholders||| -closest_cop||| -convert||| -cop_free||| -cr_textfilter||| -create_eval_scope||| -croak_nocontext|||vn -croak|||v -csighandler||5.009003|n -curmad||| -custom_op_desc||5.007003| -custom_op_name||5.007003| -cv_ckproto_len||| -cv_ckproto||| -cv_clone||| -cv_const_sv||5.004000| -cv_dump||| -cv_undef||| -cx_dump||5.005000| -cx_dup||| -cxinc||| -dAXMARK|5.009003||p -dAX|5.007002||p -dITEMS|5.007002||p -dMARK||| -dMULTICALL||5.009003| -dMY_CXT_SV|5.007003||p -dMY_CXT|5.007003||p -dNOOP|5.006000||p -dORIGMARK||| -dSP||| -dTHR|5.004050||p -dTHXa|5.006000||p -dTHXoa|5.006000||p -dTHX|5.006000||p -dUNDERBAR|5.009002||p -dVAR|5.009003||p -dXCPT|5.009002||p -dXSARGS||| -dXSI32||| -dXSTARG|5.006000||p -deb_curcv||| -deb_nocontext|||vn -deb_stack_all||| -deb_stack_n||| -debop||5.005000| -debprofdump||5.005000| -debprof||| -debstackptrs||5.007003| -debstack||5.007003| -deb||5.007003|v -del_sv||| -delete_eval_scope||| -delimcpy||5.004000| -deprecate_old||| -deprecate||| -despatch_signals||5.007001| -destroy_matcher||| -die_nocontext|||vn -die_where||| -die|||v -dirp_dup||| -div128||| -djSP||| -do_aexec5||| -do_aexec||| -do_aspawn||| -do_binmode||5.004050| -do_chomp||| -do_chop||| -do_close||| -do_dump_pad||| -do_eof||| -do_exec3||| -do_execfree||| -do_exec||| -do_gv_dump||5.006000| -do_gvgv_dump||5.006000| -do_hv_dump||5.006000| -do_ipcctl||| -do_ipcget||| -do_join||| -do_kv||| -do_magic_dump||5.006000| -do_msgrcv||| -do_msgsnd||| -do_oddball||| -do_op_dump||5.006000| -do_op_xmldump||| -do_open9||5.006000| -do_openn||5.007001| -do_open||5.004000| -do_pipe||| -do_pmop_dump||5.006000| -do_pmop_xmldump||| -do_print||| -do_readline||| -do_seek||| -do_semop||| -do_shmio||| -do_smartmatch||| -do_spawn_nowait||| -do_spawn||| -do_sprintf||| -do_sv_dump||5.006000| -do_sysseek||| -do_tell||| -do_trans_complex_utf8||| -do_trans_complex||| -do_trans_count_utf8||| -do_trans_count||| -do_trans_simple_utf8||| -do_trans_simple||| -do_trans||| -do_vecget||| -do_vecset||| -do_vop||| -docatch_body||| -docatch||| -doeval||| -dofile||| -dofindlabel||| -doform||| -doing_taint||5.008001|n -dooneliner||| -doopen_pm||| -doparseform||| -dopoptoeval||| -dopoptogiven||| -dopoptolabel||| -dopoptoloop||| -dopoptosub_at||| -dopoptosub||| -dopoptowhen||| -doref||5.009003| -dounwind||| -dowantarray||| -dump_all||5.006000| -dump_eval||5.006000| -dump_fds||| -dump_form||5.006000| -dump_indent||5.006000|v -dump_mstats||| -dump_packsubs||5.006000| -dump_sub||5.006000| -dump_sv_child||| -dump_vindent||5.006000| -dumpuntil||| -dup_attrlist||| -emulate_eaccess||| -eval_pv|5.006000||p -eval_sv|5.006000||p -expect_number||| -fbm_compile||5.005000| -fbm_instr||5.005000| -fd_on_nosuid_fs||| -feature_is_enabled||| -filter_add||| -filter_del||| -filter_gets||| -filter_read||| -find_array_subscript||| -find_beginning||| -find_byclass||| -find_hash_subscript||| -find_in_my_stash||| -find_runcv||| -find_rundefsvoffset||5.009002| -find_script||| -find_uninit_var||| -first_symbol|||n -fold_constants||| -forbid_setid||| -force_ident||| -force_list||| -force_next||| -force_version||| -force_word||| -form_nocontext|||vn -form||5.004000|v -fp_dup||| -fprintf_nocontext|||vn -free_global_struct||| -free_tied_hv_pool||| -free_tmps||| -gen_constant_list||| -get_arena||| -get_av|5.006000||p -get_context||5.006000|n -get_cv|5.006000||p -get_db_sub||| -get_debug_opts||| -get_hash_seed||| -get_hv|5.006000||p -get_mstats||| -get_no_modify||| -get_num||| -get_op_descs||5.005000| -get_op_names||5.005000| -get_opargs||| -get_ppaddr||5.006000| -get_sv|5.006000||p -get_vtbl||5.005030| -getcwd_sv||5.007002| -getenv_len||| -glob_2number||| -glob_2pv||| -glob_assign_glob||| -glob_assign_ref||| -gp_dup||| -gp_free||| -gp_ref||| -grok_bin|5.007003||p -grok_hex|5.007003||p -grok_number|5.007002||p -grok_numeric_radix|5.007002||p -grok_oct|5.007003||p -group_end||| -gv_AVadd||| -gv_HVadd||| -gv_IOadd||| -gv_SVadd||| -gv_autoload4||5.004000| -gv_check||| -gv_const_sv||5.009003| -gv_dump||5.006000| -gv_efullname3||5.004000| -gv_efullname4||5.006001| -gv_efullname||| -gv_ename||| -gv_fetchfile||| -gv_fetchmeth_autoload||5.007003| -gv_fetchmethod_autoload||5.004000| -gv_fetchmethod||| -gv_fetchmeth||| -gv_fetchpvn_flags||5.009002| -gv_fetchpv||| -gv_fetchsv||5.009002| -gv_fullname3||5.004000| -gv_fullname4||5.006001| -gv_fullname||| -gv_handler||5.007001| -gv_init_sv||| -gv_init||| -gv_name_set||5.009004| -gv_stashpvn|5.004000||p -gv_stashpvs||5.009003| -gv_stashpv||| -gv_stashsv||| -he_dup||| -hek_dup||| -hfreeentries||| -hsplit||| -hv_assert||5.009001| -hv_auxinit|||n -hv_backreferences_p||| -hv_clear_placeholders||5.009001| -hv_clear||| -hv_copy_hints_hv||| -hv_delayfree_ent||5.004000| -hv_delete_common||| -hv_delete_ent||5.004000| -hv_delete||| -hv_eiter_p||5.009003| -hv_eiter_set||5.009003| -hv_exists_ent||5.004000| -hv_exists||| -hv_fetch_common||| -hv_fetch_ent||5.004000| -hv_fetchs|5.009003||p -hv_fetch||| -hv_free_ent||5.004000| -hv_iterinit||| -hv_iterkeysv||5.004000| -hv_iterkey||| -hv_iternext_flags||5.008000| -hv_iternextsv||| -hv_iternext||| -hv_iterval||| -hv_kill_backrefs||| -hv_ksplit||5.004000| -hv_magic_check|||n -hv_magic||| -hv_name_set||5.009003| -hv_notallowed||| -hv_placeholders_get||5.009003| -hv_placeholders_p||5.009003| -hv_placeholders_set||5.009003| -hv_riter_p||5.009003| -hv_riter_set||5.009003| -hv_scalar||5.009001| -hv_store_ent||5.004000| -hv_store_flags||5.008000| -hv_stores|5.009004||p -hv_store||| -hv_undef||| -ibcmp_locale||5.004000| -ibcmp_utf8||5.007003| -ibcmp||| -incl_perldb||| -incline||| -incpush_if_exists||| -incpush||| -ingroup||| -init_argv_symbols||| -init_debugger||| -init_global_struct||| -init_i18nl10n||5.006000| -init_i18nl14n||5.006000| -init_ids||| -init_interp||| -init_lexer||| -init_main_stash||| -init_perllib||| -init_postdump_symbols||| -init_predump_symbols||| -init_stacks||5.005000| -init_tm||5.007002| -instr||| -intro_my||| -intuit_method||| -intuit_more||| -invert||| -io_close||| -isALNUM||| -isALPHA||| -isDIGIT||| -isLOWER||| -isSPACE||| -isUPPER||| -is_an_int||| -is_gv_magical_sv||| -is_gv_magical||| -is_handle_constructor|||n -is_list_assignment||| -is_lvalue_sub||5.007001| -is_uni_alnum_lc||5.006000| -is_uni_alnumc_lc||5.006000| -is_uni_alnumc||5.006000| -is_uni_alnum||5.006000| -is_uni_alpha_lc||5.006000| -is_uni_alpha||5.006000| -is_uni_ascii_lc||5.006000| -is_uni_ascii||5.006000| -is_uni_cntrl_lc||5.006000| -is_uni_cntrl||5.006000| -is_uni_digit_lc||5.006000| -is_uni_digit||5.006000| -is_uni_graph_lc||5.006000| -is_uni_graph||5.006000| -is_uni_idfirst_lc||5.006000| -is_uni_idfirst||5.006000| -is_uni_lower_lc||5.006000| -is_uni_lower||5.006000| -is_uni_print_lc||5.006000| -is_uni_print||5.006000| -is_uni_punct_lc||5.006000| -is_uni_punct||5.006000| -is_uni_space_lc||5.006000| -is_uni_space||5.006000| -is_uni_upper_lc||5.006000| -is_uni_upper||5.006000| -is_uni_xdigit_lc||5.006000| -is_uni_xdigit||5.006000| -is_utf8_alnumc||5.006000| -is_utf8_alnum||5.006000| -is_utf8_alpha||5.006000| -is_utf8_ascii||5.006000| -is_utf8_char_slow|||n -is_utf8_char||5.006000| -is_utf8_cntrl||5.006000| -is_utf8_common||| -is_utf8_digit||5.006000| -is_utf8_graph||5.006000| -is_utf8_idcont||5.008000| -is_utf8_idfirst||5.006000| -is_utf8_lower||5.006000| -is_utf8_mark||5.006000| -is_utf8_print||5.006000| -is_utf8_punct||5.006000| -is_utf8_space||5.006000| -is_utf8_string_loclen||5.009003| -is_utf8_string_loc||5.008001| -is_utf8_string||5.006001| -is_utf8_upper||5.006000| -is_utf8_xdigit||5.006000| -isa_lookup||| -items|||n -ix|||n -jmaybe||| -keyword||| -leave_scope||| -lex_end||| -lex_start||| -linklist||| -listkids||| -list||| -load_module_nocontext|||vn -load_module||5.006000|v -localize||| -looks_like_bool||| -looks_like_number||| -lop||| -mPUSHi|5.009002||p -mPUSHn|5.009002||p -mPUSHp|5.009002||p -mPUSHu|5.009002||p -mXPUSHi|5.009002||p -mXPUSHn|5.009002||p -mXPUSHp|5.009002||p -mXPUSHu|5.009002||p -mad_free||| -madlex||| -madparse||| -magic_clear_all_env||| -magic_clearenv||| -magic_clearhint||| -magic_clearpack||| -magic_clearsig||| -magic_dump||5.006000| -magic_existspack||| -magic_freearylen_p||| -magic_freeovrld||| -magic_freeregexp||| -magic_getarylen||| -magic_getdefelem||| -magic_getnkeys||| -magic_getpack||| -magic_getpos||| -magic_getsig||| -magic_getsubstr||| -magic_gettaint||| -magic_getuvar||| -magic_getvec||| -magic_get||| -magic_killbackrefs||| -magic_len||| -magic_methcall||| -magic_methpack||| -magic_nextpack||| -magic_regdata_cnt||| -magic_regdatum_get||| -magic_regdatum_set||| -magic_scalarpack||| -magic_set_all_env||| -magic_setamagic||| -magic_setarylen||| -magic_setbm||| -magic_setcollxfrm||| -magic_setdbline||| -magic_setdefelem||| -magic_setenv||| -magic_setfm||| -magic_setglob||| -magic_sethint||| -magic_setisa||| -magic_setmglob||| -magic_setnkeys||| -magic_setpack||| -magic_setpos||| -magic_setregexp||| -magic_setsig||| -magic_setsubstr||| -magic_settaint||| -magic_setutf8||| -magic_setuvar||| -magic_setvec||| -magic_set||| -magic_sizepack||| -magic_wipepack||| -magicname||| -make_matcher||| -make_trie||| -malloced_size|||n -malloc||5.007002|n -markstack_grow||| -matcher_matches_sv||| -measure_struct||| -memEQ|5.004000||p -memNE|5.004000||p -mem_collxfrm||| -mess_alloc||| -mess_nocontext|||vn -mess||5.006000|v -method_common||| -mfree||5.007002|n -mg_clear||| -mg_copy||| -mg_dup||| -mg_find||| -mg_free||| -mg_get||| -mg_length||5.005000| -mg_localize||| -mg_magical||| -mg_set||| -mg_size||5.005000| -mini_mktime||5.007002| -missingterm||| -mode_from_discipline||| -modkids||| -mod||| -more_bodies||| -more_sv||| -moreswitches||| -mul128||| -mulexp10|||n -my_atof2||5.007002| -my_atof||5.006000| -my_attrs||| -my_bcopy|||n -my_betoh16|||n -my_betoh32|||n -my_betoh64|||n -my_betohi|||n -my_betohl|||n -my_betohs|||n -my_bzero|||n -my_chsize||| -my_clearenv||| -my_cxt_init||| -my_exit_jump||| -my_exit||| -my_failure_exit||5.004000| -my_fflush_all||5.006000| -my_fork||5.007003|n -my_htobe16|||n -my_htobe32|||n -my_htobe64|||n -my_htobei|||n -my_htobel|||n -my_htobes|||n -my_htole16|||n -my_htole32|||n -my_htole64|||n -my_htolei|||n -my_htolel|||n -my_htoles|||n -my_htonl||| -my_kid||| -my_letoh16|||n -my_letoh32|||n -my_letoh64|||n -my_letohi|||n -my_letohl|||n -my_letohs|||n -my_lstat||| -my_memcmp||5.004000|n -my_memset|||n -my_ntohl||| -my_pclose||5.004000| -my_popen_list||5.007001| -my_popen||5.004000| -my_setenv||| -my_snprintf|5.009004||pvn -my_socketpair||5.007003|n -my_sprintf||5.009003|vn -my_stat||| -my_strftime||5.007002| -my_swabn|||n -my_swap||| -my_unexec||| -my_vsnprintf||5.009004|n -my||| -need_utf8|||n -newANONATTRSUB||5.006000| -newANONHASH||| -newANONLIST||| -newANONSUB||| -newASSIGNOP||| -newATTRSUB||5.006000| -newAVREF||| -newAV||| -newBINOP||| -newCONDOP||| -newCONSTSUB|5.004050||p -newCVREF||| -newDEFSVOP||| -newFORM||| -newFOROP||| -newGIVENOP||5.009003| -newGIVWHENOP||| -newGP||| -newGVOP||| -newGVREF||| -newGVgen||| -newHVREF||| -newHVhv||5.005000| -newHV||| -newIO||| -newLISTOP||| -newLOGOP||| -newLOOPEX||| -newLOOPOP||| -newMADPROP||| -newMADsv||| -newMYSUB||| -newNULLLIST||| -newOP||| -newPADOP||5.006000| -newPMOP||| -newPROG||| -newPVOP||| -newRANGE||| -newRV_inc|5.004000||p -newRV_noinc|5.004000||p -newRV||| -newSLICEOP||| -newSTATEOP||| -newSUB||| -newSVOP||| -newSVREF||| -newSVhek||5.009003| -newSViv||| -newSVnv||| -newSVpvf_nocontext|||vn -newSVpvf||5.004000|v -newSVpvn_share||5.007001| -newSVpvn|5.004050||p -newSVpvs_share||5.009003| -newSVpvs|5.009003||p -newSVpv||| -newSVrv||| -newSVsv||| -newSVuv|5.006000||p -newSV||| -newTOKEN||| -newUNOP||| -newWHENOP||5.009003| -newWHILEOP||5.009003| -newXS_flags||5.009004| -newXSproto||5.006000| -newXS||5.006000| -new_collate||5.006000| -new_constant||| -new_ctype||5.006000| -new_he||| -new_logop||| -new_numeric||5.006000| -new_stackinfo||5.005000| -new_version||5.009000| -new_warnings_bitfield||| -next_symbol||| -nextargv||| -nextchar||| -ninstr||| -no_bareword_allowed||| -no_fh_allowed||| -no_op||| -not_a_number||| -nothreadhook||5.008000| -nuke_stacks||| -num_overflow|||n -offer_nice_chunk||| -oopsAV||| -oopsCV||| -oopsHV||| -op_clear||| -op_const_sv||| -op_dump||5.006000| -op_free||| -op_getmad_weak||| -op_getmad||| -op_null||5.007002| -op_refcnt_lock||5.009002| -op_refcnt_unlock||5.009002| -op_xmldump||| -open_script||| -pMY_CXT_|5.007003||p -pMY_CXT|5.007003||p -pTHX_|5.006000||p -pTHX|5.006000||p -packWARN|5.007003||p -pack_cat||5.007003| -pack_rec||| -package||| -packlist||5.008001| -pad_add_anon||| -pad_add_name||| -pad_alloc||| -pad_block_start||| -pad_check_dup||| -pad_compname_type||| -pad_findlex||| -pad_findmy||| -pad_fixup_inner_anons||| -pad_free||| -pad_leavemy||| -pad_new||| -pad_peg|||n -pad_push||| -pad_reset||| -pad_setsv||| -pad_sv||5.009004| -pad_swipe||| -pad_tidy||| -pad_undef||| -parse_body||| -parse_unicode_opts||| -path_is_absolute|||n -peep||| -pending_ident||| -perl_alloc_using|||n -perl_alloc|||n -perl_clone_using|||n -perl_clone|||n -perl_construct|||n -perl_destruct||5.007003|n -perl_free|||n -perl_parse||5.006000|n -perl_run|||n -pidgone||| -pm_description||| -pmflag||| -pmop_dump||5.006000| -pmop_xmldump||| -pmruntime||| -pmtrans||| -pop_scope||| -pregcomp||| -pregexec||| -pregfree||| -prepend_elem||| -prepend_madprops||| -printbuf||| -printf_nocontext|||vn -ptr_table_clear||| -ptr_table_fetch||| -ptr_table_find|||n -ptr_table_free||| -ptr_table_new||| -ptr_table_split||| -ptr_table_store||| -push_scope||| -put_byte||| -pv_display||5.006000| -pv_uni_display||5.007003| -qerror||| -re_croak2||| -re_dup||| -re_intuit_start||5.006000| -re_intuit_string||5.006000| -realloc||5.007002|n -reentrant_free||| -reentrant_init||| -reentrant_retry|||vn -reentrant_size||| -ref_array_or_hash||| -refcounted_he_chain_2hv||| -refcounted_he_fetch||| -refcounted_he_free||| -refcounted_he_new||| -refcounted_he_value||| -refkids||| -refto||| -ref||5.009003| -reg_node||| -reganode||| -regatom||| -regbranch||| -regclass_swash||5.009004| -regclass||| -regcppop||| -regcppush||| -regcurly|||n -regdump||5.005000| -regexec_flags||5.005000| -reghop3|||n -reghopmaybe3|||n -reginclass||| -reginitcolors||5.006000| -reginsert||| -regmatch||| -regnext||5.005000| -regpiece||| -regpposixcc||| -regprop||| -regrepeat||| -regtail||| -regtry||| -reguni||| -regwhite|||n -reg||| -repeatcpy||| -report_evil_fh||| -report_uninit||| -require_errno||| -require_pv||5.006000| -restore_magic||| -rninstr||| -rsignal_restore||| -rsignal_save||| -rsignal_state||5.004000| -rsignal||5.004000| -run_body||| -run_user_filter||| -runops_debug||5.005000| -runops_standard||5.005000| -rvpv_dup||| -rxres_free||| -rxres_restore||| -rxres_save||| -safesyscalloc||5.006000|n -safesysfree||5.006000|n -safesysmalloc||5.006000|n -safesysrealloc||5.006000|n -same_dirent||| -save_I16||5.004000| -save_I32||| -save_I8||5.006000| -save_aelem||5.004050| -save_alloc||5.006000| -save_aptr||| -save_ary||| -save_bool||5.008001| -save_clearsv||| -save_delete||| -save_destructor_x||5.006000| -save_destructor||5.006000| -save_freeop||| -save_freepv||| -save_freesv||| -save_generic_pvref||5.006001| -save_generic_svref||5.005030| -save_gp||5.004000| -save_hash||| -save_hek_flags|||n -save_helem||5.004050| -save_hints||5.005000| -save_hptr||| -save_int||| -save_item||| -save_iv||5.005000| -save_lines||| -save_list||| -save_long||| -save_magic||| -save_mortalizesv||5.007001| -save_nogv||| -save_op||| -save_padsv||5.007001| -save_pptr||| -save_re_context||5.006000| -save_scalar_at||| -save_scalar||| -save_set_svflags||5.009000| -save_shared_pvref||5.007003| -save_sptr||| -save_svref||| -save_vptr||5.006000| -savepvn||| -savepvs||5.009003| -savepv||| -savesharedpv||5.007003| -savestack_grow_cnt||5.008001| -savestack_grow||| -savesvpv||5.009002| -sawparens||| -scalar_mod_type|||n -scalarboolean||| -scalarkids||| -scalarseq||| -scalarvoid||| -scalar||| -scan_bin||5.006000| -scan_commit||| -scan_const||| -scan_formline||| -scan_heredoc||| -scan_hex||| -scan_ident||| -scan_inputsymbol||| -scan_num||5.007001| -scan_oct||| -scan_pat||| -scan_str||| -scan_subst||| -scan_trans||| -scan_version||5.009001| -scan_vstring||5.008001| -scan_word||| -scope||| -screaminstr||5.005000| -seed||5.008001| -sequence_num||| -sequence_tail||| -sequence||| -set_context||5.006000|n -set_csh||| -set_numeric_local||5.006000| -set_numeric_radix||5.006000| -set_numeric_standard||5.006000| -setdefout||| -setenv_getix||| -share_hek_flags||| -share_hek||5.004000| -si_dup||| -sighandler|||n -simplify_sort||| -skipspace0||| -skipspace1||| -skipspace2||| -skipspace||| -sortcv_stacked||| -sortcv_xsub||| -sortcv||| -sortsv_flags||5.009003| -sortsv||5.007003| -space_join_names_mortal||| -ss_dup||| -stack_grow||| -start_force||| -start_glob||| -start_subparse||5.004000| -stashpv_hvname_match||5.009004| -stdize_locale||| -strEQ||| -strGE||| -strGT||| -strLE||| -strLT||| -strNE||| -str_to_version||5.006000| -stringify_regexp||| -strip_return||| -strnEQ||| -strnNE||| -study_chunk||| -sub_crush_depth||| -sublex_done||| -sublex_push||| -sublex_start||| -sv_2bool||| -sv_2cv||| -sv_2io||| -sv_2iuv_common||| -sv_2iuv_non_preserve||| -sv_2iv_flags||5.009001| -sv_2iv||| -sv_2mortal||| -sv_2nv||| -sv_2pv_flags||5.007002| -sv_2pv_nolen|5.006000||p -sv_2pvbyte_nolen||| -sv_2pvbyte|5.006000||p -sv_2pvutf8_nolen||5.006000| -sv_2pvutf8||5.006000| -sv_2pv||| -sv_2uv_flags||5.009001| -sv_2uv|5.004000||p -sv_add_arena||| -sv_add_backref||| -sv_backoff||| -sv_bless||| -sv_cat_decode||5.008001| -sv_catpv_mg|5.004050||p -sv_catpvf_mg_nocontext|||pvn -sv_catpvf_mg|5.006000|5.004000|pv -sv_catpvf_nocontext|||vn -sv_catpvf||5.004000|v -sv_catpvn_flags||5.007002| -sv_catpvn_mg|5.004050||p -sv_catpvn_nomg|5.007002||p -sv_catpvn||| -sv_catpvs|5.009003||p -sv_catpv||| -sv_catsv_flags||5.007002| -sv_catsv_mg|5.004050||p -sv_catsv_nomg|5.007002||p -sv_catsv||| -sv_catxmlpvn||| -sv_catxmlsv||| -sv_chop||| -sv_clean_all||| -sv_clean_objs||| -sv_clear||| -sv_cmp_locale||5.004000| -sv_cmp||| -sv_collxfrm||| -sv_compile_2op||5.008001| -sv_copypv||5.007003| -sv_dec||| -sv_del_backref||| -sv_derived_from||5.004000| -sv_dump||| -sv_dup||| -sv_eq||| -sv_exp_grow||| -sv_force_normal_flags||5.007001| -sv_force_normal||5.006000| -sv_free2||| -sv_free_arenas||| -sv_free||| -sv_gets||5.004000| -sv_grow||| -sv_i_ncmp||| -sv_inc||| -sv_insert||| -sv_isa||| -sv_isobject||| -sv_iv||5.005000| -sv_kill_backrefs||| -sv_len_utf8||5.006000| -sv_len||| -sv_magicext||5.007003| -sv_magic||| -sv_mortalcopy||| -sv_ncmp||| -sv_newmortal||| -sv_newref||| -sv_nolocking||5.007003| -sv_nosharing||5.007003| -sv_nounlocking||| -sv_nv||5.005000| -sv_peek||5.005000| -sv_pos_b2u_forwards||| -sv_pos_b2u_midway||| -sv_pos_b2u||5.006000| -sv_pos_u2b_cached||| -sv_pos_u2b_forwards|||n -sv_pos_u2b_midway|||n -sv_pos_u2b||5.006000| -sv_pvbyten_force||5.006000| -sv_pvbyten||5.006000| -sv_pvbyte||5.006000| -sv_pvn_force_flags||5.007002| -sv_pvn_force|||p -sv_pvn_nomg|5.007003||p -sv_pvn|5.005000||p -sv_pvutf8n_force||5.006000| -sv_pvutf8n||5.006000| -sv_pvutf8||5.006000| -sv_pv||5.006000| -sv_recode_to_utf8||5.007003| -sv_reftype||| -sv_release_COW||| -sv_release_IVX||| -sv_replace||| -sv_report_used||| -sv_reset||| -sv_rvweaken||5.006000| -sv_setiv_mg|5.004050||p -sv_setiv||| -sv_setnv_mg|5.006000||p -sv_setnv||| -sv_setpv_mg|5.004050||p -sv_setpvf_mg_nocontext|||pvn -sv_setpvf_mg|5.006000|5.004000|pv -sv_setpvf_nocontext|||vn -sv_setpvf||5.004000|v -sv_setpviv_mg||5.008001| -sv_setpviv||5.008001| -sv_setpvn_mg|5.004050||p -sv_setpvn||| -sv_setpvs|5.009004||p -sv_setpv||| -sv_setref_iv||| -sv_setref_nv||| -sv_setref_pvn||| -sv_setref_pv||| -sv_setref_uv||5.007001| -sv_setsv_cow||| -sv_setsv_flags||5.007002| -sv_setsv_mg|5.004050||p -sv_setsv_nomg|5.007002||p -sv_setsv||| -sv_setuv_mg|5.004050||p -sv_setuv|5.004000||p -sv_tainted||5.004000| -sv_taint||5.004000| -sv_true||5.005000| -sv_unglob||| -sv_uni_display||5.007003| -sv_unmagic||| -sv_unref_flags||5.007001| -sv_unref||| -sv_untaint||5.004000| -sv_upgrade||| -sv_usepvn_flags||5.009004| -sv_usepvn_mg|5.004050||p -sv_usepvn||| -sv_utf8_decode||5.006000| -sv_utf8_downgrade||5.006000| -sv_utf8_encode||5.006000| -sv_utf8_upgrade_flags||5.007002| -sv_utf8_upgrade||5.007001| -sv_uv|5.005000||p -sv_vcatpvf_mg|5.006000|5.004000|p -sv_vcatpvfn||5.004000| -sv_vcatpvf|5.006000|5.004000|p -sv_vsetpvf_mg|5.006000|5.004000|p -sv_vsetpvfn||5.004000| -sv_vsetpvf|5.006000|5.004000|p -sv_xmlpeek||| -svtype||| -swallow_bom||| -swash_fetch||5.007002| -swash_get||| -swash_init||5.006000| -sys_intern_clear||| -sys_intern_dup||| -sys_intern_init||| -taint_env||| -taint_proper||| -tmps_grow||5.006000| -toLOWER||| -toUPPER||| -to_byte_substr||| -to_uni_fold||5.007003| -to_uni_lower_lc||5.006000| -to_uni_lower||5.007003| -to_uni_title_lc||5.006000| -to_uni_title||5.007003| -to_uni_upper_lc||5.006000| -to_uni_upper||5.007003| -to_utf8_case||5.007003| -to_utf8_fold||5.007003| -to_utf8_lower||5.007003| -to_utf8_substr||| -to_utf8_title||5.007003| -to_utf8_upper||5.007003| -token_free||| -token_getmad||| -tokenize_use||| -tokeq||| -tokereport||| -too_few_arguments||| -too_many_arguments||| -uiv_2buf|||n -unlnk||| -unpack_rec||| -unpack_str||5.007003| -unpackstring||5.008001| -unshare_hek_or_pvn||| -unshare_hek||| -unsharepvn||5.004000| -unwind_handler_stack||| -upg_version||5.009000| -usage||| -utf16_to_utf8_reversed||5.006001| -utf16_to_utf8||5.006001| -utf8_distance||5.006000| -utf8_hop||5.006000| -utf8_length||5.007001| -utf8_mg_pos_cache_update||| -utf8_to_bytes||5.006001| -utf8_to_uvchr||5.007001| -utf8_to_uvuni||5.007001| -utf8n_to_uvchr||| -utf8n_to_uvuni||5.007001| -utilize||| -uvchr_to_utf8_flags||5.007003| -uvchr_to_utf8||| -uvuni_to_utf8_flags||5.007003| -uvuni_to_utf8||5.007001| -validate_suid||| -varname||| -vcmp||5.009000| -vcroak||5.006000| -vdeb||5.007003| -vdie_common||| -vdie_croak_common||| -vdie||| -vform||5.006000| -visit||| -vivify_defelem||| -vivify_ref||| -vload_module||5.006000| -vmess||5.006000| -vnewSVpvf|5.006000|5.004000|p -vnormal||5.009002| -vnumify||5.009000| -vstringify||5.009000| -vverify||5.009003| -vwarner||5.006000| -vwarn||5.006000| -wait4pid||| -warn_nocontext|||vn -warner_nocontext|||vn -warner|5.006000|5.004000|pv -warn|||v -watch||| -whichsig||| -write_no_mem||| -write_to_stderr||| -xmldump_all||| -xmldump_attr||| -xmldump_eval||| -xmldump_form||| -xmldump_indent|||v -xmldump_packsubs||| -xmldump_sub||| -xmldump_vindent||| -yyerror||| -yylex||| -yyparse||| -yywarn||| -); - -if (exists $opt{'list-unsupported'}) { - my $f; - for $f (sort { lc $a cmp lc $b } keys %API) { - next unless $API{$f}{todo}; - print "$f ", '.'x(40-length($f)), " ", format_version($API{$f}{todo}), "\n"; - } - exit 0; -} - -# Scan for possible replacement candidates - -my(%replace, %need, %hints, %depends); -my $replace = 0; -my $hint = ''; - -while (<DATA>) { - if ($hint) { - if (m{^\s*\*\s(.*?)\s*$}) { - $hints{$hint} ||= ''; # suppress warning with older perls - $hints{$hint} .= "$1\n"; - } - else { - $hint = ''; - } - } - $hint = $1 if m{^\s*$rccs\sHint:\s+(\w+)\s*$}; - - $replace = $1 if m{^\s*$rccs\s+Replace:\s+(\d+)\s+$rcce\s*$}; - $replace{$2} = $1 if $replace and m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+)}; - $replace{$2} = $1 if m{^\s*#\s*define\s+(\w+)(?:\([^)]*\))?\s+(\w+).*$rccs\s+Replace\s+$rcce}; - $replace{$1} = $2 if m{^\s*$rccs\s+Replace (\w+) with (\w+)\s+$rcce\s*$}; - - if (m{^\s*$rccs\s+(\w+)\s+depends\s+on\s+(\w+(\s*,\s*\w+)*)\s+$rcce\s*$}) { - push @{$depends{$1}}, map { s/\s+//g; $_ } split /,/, $2; - } - - $need{$1} = 1 if m{^#if\s+defined\(NEED_(\w+)(?:_GLOBAL)?\)}; -} - -if (exists $opt{'api-info'}) { - my $f; - my $count = 0; - my $match = $opt{'api-info'} =~ m!^/(.*)/$! ? $1 : "^\Q$opt{'api-info'}\E\$"; - for $f (sort { lc $a cmp lc $b } keys %API) { - next unless $f =~ /$match/; - print "\n=== $f ===\n\n"; - my $info = 0; - if ($API{$f}{base} || $API{$f}{todo}) { - my $base = format_version($API{$f}{base} || $API{$f}{todo}); - print "Supported at least starting from perl-$base.\n"; - $info++; - } - if ($API{$f}{provided}) { - my $todo = $API{$f}{todo} ? format_version($API{$f}{todo}) : "5.003"; - print "Support by $ppport provided back to perl-$todo.\n"; - print "Support needs to be explicitly requested by NEED_$f.\n" if exists $need{$f}; - print "Depends on: ", join(', ', @{$depends{$f}}), ".\n" if exists $depends{$f}; - print "$hints{$f}" if exists $hints{$f}; - $info++; - } - unless ($info) { - print "No portability information available.\n"; - } - $count++; - } - if ($count > 0) { - print "\n"; - } - else { - print "Found no API matching '$opt{'api-info'}'.\n"; - } - exit 0; -} - -if (exists $opt{'list-provided'}) { - my $f; - for $f (sort { lc $a cmp lc $b } keys %API) { - next unless $API{$f}{provided}; - my @flags; - push @flags, 'explicit' if exists $need{$f}; - push @flags, 'depend' if exists $depends{$f}; - push @flags, 'hint' if exists $hints{$f}; - my $flags = @flags ? ' ['.join(', ', @flags).']' : ''; - print "$f$flags\n"; - } - exit 0; -} - -my @files; -my @srcext = qw( xs c h cc cpp ); -my $srcext = join '|', @srcext; - -if (@ARGV) { - my %seen; - @files = grep { -f && !exists $seen{$_} } map { glob $_ } @ARGV; -} -else { - eval { - require File::Find; - File::Find::find(sub { - $File::Find::name =~ /\.($srcext)$/i - and push @files, $File::Find::name; - }, '.'); - }; - if ($@) { - @files = map { glob "*.$_" } @srcext; - } -} - -if (!@ARGV || $opt{filter}) { - my(@in, @out); - my %xsc = map { /(.*)\.xs$/ ? ("$1.c" => 1, "$1.cc" => 1) : () } @files; - for (@files) { - my $out = exists $xsc{$_} || /\b\Q$ppport\E$/i || !/\.($srcext)$/i; - push @{ $out ? \@out : \@in }, $_; - } - if (@ARGV && @out) { - warning("Skipping the following files (use --nofilter to avoid this):\n| ", join "\n| ", @out); - } - @files = @in; -} - -unless (@files) { - die "No input files given!\n"; -} - -my(%files, %global, %revreplace); -%revreplace = reverse %replace; -my $filename; -my $patch_opened = 0; - -for $filename (@files) { - unless (open IN, "<$filename") { - warn "Unable to read from $filename: $!\n"; - next; - } - - info("Scanning $filename ..."); - - my $c = do { local $/; <IN> }; - close IN; - - my %file = (orig => $c, changes => 0); - - # temporarily remove C comments from the code - my @ccom; - $c =~ s{ - ( - [^"'/]+ - | - (?:"[^"\\]*(?:\\.[^"\\]*)*" [^"'/]*)+ - | - (?:'[^'\\]*(?:\\.[^'\\]*)*' [^"'/]*)+ - ) - | - (/ (?: - \*[^*]*\*+(?:[^$ccs][^*]*\*+)* / - | - /[^\r\n]* - )) - }{ - defined $2 and push @ccom, $2; - defined $1 ? $1 : "$ccs$#ccom$cce"; - }egsx; - - $file{ccom} = \@ccom; - $file{code} = $c; - $file{has_inc_ppport} = ($c =~ /#.*include.*\Q$ppport\E/); - - my $func; - - for $func (keys %API) { - my $match = $func; - $match .= "|$revreplace{$func}" if exists $revreplace{$func}; - if ($c =~ /\b(?:Perl_)?($match)\b/) { - $file{uses_replace}{$1}++ if exists $revreplace{$func} && $1 eq $revreplace{$func}; - $file{uses_Perl}{$func}++ if $c =~ /\bPerl_$func\b/; - if (exists $API{$func}{provided}) { - if (!exists $API{$func}{base} || $API{$func}{base} > $opt{'compat-version'}) { - $file{uses}{$func}++; - my @deps = rec_depend($func); - if (@deps) { - $file{uses_deps}{$func} = \@deps; - for (@deps) { - $file{uses}{$_} = 0 unless exists $file{uses}{$_}; - } - } - for ($func, @deps) { - if (exists $need{$_}) { - $file{needs}{$_} = 'static'; - } - } - } - } - if (exists $API{$func}{todo} && $API{$func}{todo} > $opt{'compat-version'}) { - if ($c =~ /\b$func\b/) { - $file{uses_todo}{$func}++; - } - } - } - } - - while ($c =~ /^$HS*#$HS*define$HS+(NEED_(\w+?)(_GLOBAL)?)\b/mg) { - if (exists $need{$2}) { - $file{defined $3 ? 'needed_global' : 'needed_static'}{$2}++; - } - else { - warning("Possibly wrong #define $1 in $filename"); - } - } - - for (qw(uses needs uses_todo needed_global needed_static)) { - for $func (keys %{$file{$_}}) { - push @{$global{$_}{$func}}, $filename; - } - } - - $files{$filename} = \%file; -} - -# Globally resolve NEED_'s -my $need; -for $need (keys %{$global{needs}}) { - if (@{$global{needs}{$need}} > 1) { - my @targets = @{$global{needs}{$need}}; - my @t = grep $files{$_}{needed_global}{$need}, @targets; - @targets = @t if @t; - @t = grep /\.xs$/i, @targets; - @targets = @t if @t; - my $target = shift @targets; - $files{$target}{needs}{$need} = 'global'; - for (@{$global{needs}{$need}}) { - $files{$_}{needs}{$need} = 'extern' if $_ ne $target; - } - } -} - -for $filename (@files) { - exists $files{$filename} or next; - - info("=== Analyzing $filename ==="); - - my %file = %{$files{$filename}}; - my $func; - my $c = $file{code}; - - for $func (sort keys %{$file{uses_Perl}}) { - if ($API{$func}{varargs}) { - my $changes = ($c =~ s{\b(Perl_$func\s*\(\s*)(?!aTHX_?)(\)|[^\s)]*\))} - { $1 . ($2 eq ')' ? 'aTHX' : 'aTHX_ ') . $2 }ge); - if ($changes) { - warning("Doesn't pass interpreter argument aTHX to Perl_$func"); - $file{changes} += $changes; - } - } - else { - warning("Uses Perl_$func instead of $func"); - $file{changes} += ($c =~ s{\bPerl_$func(\s*)\((\s*aTHX_?)?\s*} - {$func$1(}g); - } - } - - for $func (sort keys %{$file{uses_replace}}) { - warning("Uses $func instead of $replace{$func}"); - $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); - } - - for $func (sort keys %{$file{uses}}) { - next unless $file{uses}{$func}; # if it's only a dependency - if (exists $file{uses_deps}{$func}) { - diag("Uses $func, which depends on ", join(', ', @{$file{uses_deps}{$func}})); - } - elsif (exists $replace{$func}) { - warning("Uses $func instead of $replace{$func}"); - $file{changes} += ($c =~ s/\b$func\b/$replace{$func}/g); - } - else { - diag("Uses $func"); - } - hint($func); - } - - for $func (sort keys %{$file{uses_todo}}) { - warning("Uses $func, which may not be portable below perl ", - format_version($API{$func}{todo})); - } - - for $func (sort keys %{$file{needed_static}}) { - my $message = ''; - if (not exists $file{uses}{$func}) { - $message = "No need to define NEED_$func if $func is never used"; - } - elsif (exists $file{needs}{$func} && $file{needs}{$func} ne 'static') { - $message = "No need to define NEED_$func when already needed globally"; - } - if ($message) { - diag($message); - $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_$func\b.*$LF//mg); - } - } - - for $func (sort keys %{$file{needed_global}}) { - my $message = ''; - if (not exists $global{uses}{$func}) { - $message = "No need to define NEED_${func}_GLOBAL if $func is never used"; - } - elsif (exists $file{needs}{$func}) { - if ($file{needs}{$func} eq 'extern') { - $message = "No need to define NEED_${func}_GLOBAL when already needed globally"; - } - elsif ($file{needs}{$func} eq 'static') { - $message = "No need to define NEED_${func}_GLOBAL when only used in this file"; - } - } - if ($message) { - diag($message); - $file{changes} += ($c =~ s/^$HS*#$HS*define$HS+NEED_${func}_GLOBAL\b.*$LF//mg); - } - } - - $file{needs_inc_ppport} = keys %{$file{uses}}; - - if ($file{needs_inc_ppport}) { - my $pp = ''; - - for $func (sort keys %{$file{needs}}) { - my $type = $file{needs}{$func}; - next if $type eq 'extern'; - my $suffix = $type eq 'global' ? '_GLOBAL' : ''; - unless (exists $file{"needed_$type"}{$func}) { - if ($type eq 'global') { - diag("Files [@{$global{needs}{$func}}] need $func, adding global request"); - } - else { - diag("File needs $func, adding static request"); - } - $pp .= "#define NEED_$func$suffix\n"; - } - } - - if ($pp && ($c =~ s/^(?=$HS*#$HS*define$HS+NEED_\w+)/$pp/m)) { - $pp = ''; - $file{changes}++; - } - - unless ($file{has_inc_ppport}) { - diag("Needs to include '$ppport'"); - $pp .= qq(#include "$ppport"\n) - } - - if ($pp) { - $file{changes} += ($c =~ s/^($HS*#$HS*define$HS+NEED_\w+.*?)^/$1$pp/ms) - || ($c =~ s/^(?=$HS*#$HS*include.*\Q$ppport\E)/$pp/m) - || ($c =~ s/^($HS*#$HS*include.*XSUB.*\s*?)^/$1$pp/m) - || ($c =~ s/^/$pp/); - } - } - else { - if ($file{has_inc_ppport}) { - diag("No need to include '$ppport'"); - $file{changes} += ($c =~ s/^$HS*?#$HS*include.*\Q$ppport\E.*?$LF//m); - } - } - - # put back in our C comments - my $ix; - my $cppc = 0; - my @ccom = @{$file{ccom}}; - for $ix (0 .. $#ccom) { - if (!$opt{cplusplus} && $ccom[$ix] =~ s!^//!!) { - $cppc++; - $file{changes} += $c =~ s/$rccs$ix$rcce/$ccs$ccom[$ix] $cce/; - } - else { - $c =~ s/$rccs$ix$rcce/$ccom[$ix]/; - } - } - - if ($cppc) { - my $s = $cppc != 1 ? 's' : ''; - warning("Uses $cppc C++ style comment$s, which is not portable"); - } - - if ($file{changes}) { - if (exists $opt{copy}) { - my $newfile = "$filename$opt{copy}"; - if (-e $newfile) { - error("'$newfile' already exists, refusing to write copy of '$filename'"); - } - else { - local *F; - if (open F, ">$newfile") { - info("Writing copy of '$filename' with changes to '$newfile'"); - print F $c; - close F; - } - else { - error("Cannot open '$newfile' for writing: $!"); - } - } - } - elsif (exists $opt{patch} || $opt{changes}) { - if (exists $opt{patch}) { - unless ($patch_opened) { - if (open PATCH, ">$opt{patch}") { - $patch_opened = 1; - } - else { - error("Cannot open '$opt{patch}' for writing: $!"); - delete $opt{patch}; - $opt{changes} = 1; - goto fallback; - } - } - mydiff(\*PATCH, $filename, $c); - } - else { -fallback: - info("Suggested changes:"); - mydiff(\*STDOUT, $filename, $c); - } - } - else { - my $s = $file{changes} == 1 ? '' : 's'; - info("$file{changes} potentially required change$s detected"); - } - } - else { - info("Looks good"); - } -} - -close PATCH if $patch_opened; - -exit 0; - - -sub mydiff -{ - local *F = shift; - my($file, $str) = @_; - my $diff; - - if (exists $opt{diff}) { - $diff = run_diff($opt{diff}, $file, $str); - } - - if (!defined $diff and can_use('Text::Diff')) { - $diff = Text::Diff::diff($file, \$str, { STYLE => 'Unified' }); - $diff = <<HEADER . $diff; ---- $file -+++ $file.patched -HEADER - } - - if (!defined $diff) { - $diff = run_diff('diff -u', $file, $str); - } - - if (!defined $diff) { - $diff = run_diff('diff', $file, $str); - } - - if (!defined $diff) { - error("Cannot generate a diff. Please install Text::Diff or use --copy."); - return; - } - - print F $diff; - -} - -sub run_diff -{ - my($prog, $file, $str) = @_; - my $tmp = 'dppptemp'; - my $suf = 'aaa'; - my $diff = ''; - local *F; - - while (-e "$tmp.$suf") { $suf++ } - $tmp = "$tmp.$suf"; - - if (open F, ">$tmp") { - print F $str; - close F; - - if (open F, "$prog $file $tmp |") { - while (<F>) { - s/\Q$tmp\E/$file.patched/; - $diff .= $_; - } - close F; - unlink $tmp; - return $diff; - } - - unlink $tmp; - } - else { - error("Cannot open '$tmp' for writing: $!"); - } - - return undef; -} - -sub can_use -{ - eval "use @_;"; - return $@ eq ''; -} - -sub rec_depend -{ - my $func = shift; - my %seen; - return () unless exists $depends{$func}; - grep !$seen{$_}++, map { ($_, rec_depend($_)) } @{$depends{$func}}; -} - -sub parse_version -{ - my $ver = shift; - - if ($ver =~ /^(\d+)\.(\d+)\.(\d+)$/) { - return ($1, $2, $3); - } - elsif ($ver !~ /^\d+\.[\d_]+$/) { - die "cannot parse version '$ver'\n"; - } - - $ver =~ s/_//g; - $ver =~ s/$/000000/; - - my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; - - $v = int $v; - $s = int $s; - - if ($r < 5 || ($r == 5 && $v < 6)) { - if ($s % 10) { - die "cannot parse version '$ver'\n"; - } - } - - return ($r, $v, $s); -} - -sub format_version -{ - my $ver = shift; - - $ver =~ s/$/000000/; - my($r,$v,$s) = $ver =~ /(\d+)\.(\d{3})(\d{3})/; - - $v = int $v; - $s = int $s; - - if ($r < 5 || ($r == 5 && $v < 6)) { - if ($s % 10) { - die "invalid version '$ver'\n"; - } - $s /= 10; - - $ver = sprintf "%d.%03d", $r, $v; - $s > 0 and $ver .= sprintf "_%02d", $s; - - return $ver; - } - - return sprintf "%d.%d.%d", $r, $v, $s; -} - -sub info -{ - $opt{quiet} and return; - print @_, "\n"; -} - -sub diag -{ - $opt{quiet} and return; - $opt{diag} and print @_, "\n"; -} - -sub warning -{ - $opt{quiet} and return; - print "*** ", @_, "\n"; -} - -sub error -{ - print "*** ERROR: ", @_, "\n"; -} - -my %given_hints; -sub hint -{ - $opt{quiet} and return; - $opt{hints} or return; - my $func = shift; - exists $hints{$func} or return; - $given_hints{$func}++ and return; - my $hint = $hints{$func}; - $hint =~ s/^/ /mg; - print " --- hint for $func ---\n", $hint; -} - -sub usage -{ - my($usage) = do { local(@ARGV,$/)=($0); <> } =~ /^=head\d$HS+SYNOPSIS\s*^(.*?)\s*^=/ms; - my %M = ( 'I' => '*' ); - $usage =~ s/^\s*perl\s+\S+/$^X $0/; - $usage =~ s/([A-Z])<([^>]+)>/$M{$1}$2$M{$1}/g; - - print <<ENDUSAGE; - -Usage: $usage - -See perldoc $0 for details. - -ENDUSAGE - - exit 2; -} - -sub strip -{ - my $self = do { local(@ARGV,$/)=($0); <> }; - $self =~ s/^$HS+Do NOT edit.*?(?=^-)//ms; - $self =~ s/^SKIP.*(?=^__DATA__)/SKIP -if (\@ARGV && \$ARGV[0] eq '--unstrip') { - eval { require Devel::PPPort }; - \$@ and die "Cannot require Devel::PPPort, please install.\\n"; - Devel::PPPort::WriteFile(\$0); - exit 0; -} -print <<END; - -Sorry, but this is a stripped version of \$0. - -To be able to use its original script and doc functionality, -please try to regenerate this file using: - - \$^X \$0 --unstrip - -END -/ms; - - open OUT, ">$0" or die "cannot strip $0: $!\n"; - print OUT $self; - - exit 0; -} - -__DATA__ -*/ - -#ifndef _P_P_PORTABILITY_H_ -#define _P_P_PORTABILITY_H_ - -#ifndef DPPP_NAMESPACE -# define DPPP_NAMESPACE DPPP_ -#endif - -#define DPPP_CAT2(x,y) CAT2(x,y) -#define DPPP_(name) DPPP_CAT2(DPPP_NAMESPACE, name) - -#ifndef PERL_REVISION -# if !defined(__PATCHLEVEL_H_INCLUDED__) && !(defined(PATCHLEVEL) && defined(SUBVERSION)) -# define PERL_PATCHLEVEL_H_IMPLICIT -# include <patchlevel.h> -# endif -# if !(defined(PERL_VERSION) || (defined(SUBVERSION) && defined(PATCHLEVEL))) -# include <could_not_find_Perl_patchlevel.h> -# endif -# ifndef PERL_REVISION -# define PERL_REVISION (5) - /* Replace: 1 */ -# define PERL_VERSION PATCHLEVEL -# define PERL_SUBVERSION SUBVERSION - /* Replace PERL_PATCHLEVEL with PERL_VERSION */ - /* Replace: 0 */ -# endif -#endif - -#define PERL_BCDVERSION ((PERL_REVISION * 0x1000000L) + (PERL_VERSION * 0x1000L) + PERL_SUBVERSION) - -/* It is very unlikely that anyone will try to use this with Perl 6 - (or greater), but who knows. - */ -#if PERL_REVISION != 5 -# error ppport.h only works with Perl version 5 -#endif /* PERL_REVISION != 5 */ - -#ifdef I_LIMITS -# include <limits.h> -#endif - -#ifndef PERL_UCHAR_MIN -# define PERL_UCHAR_MIN ((unsigned char)0) -#endif - -#ifndef PERL_UCHAR_MAX -# ifdef UCHAR_MAX -# define PERL_UCHAR_MAX ((unsigned char)UCHAR_MAX) -# else -# ifdef MAXUCHAR -# define PERL_UCHAR_MAX ((unsigned char)MAXUCHAR) -# else -# define PERL_UCHAR_MAX ((unsigned char)~(unsigned)0) -# endif -# endif -#endif - -#ifndef PERL_USHORT_MIN -# define PERL_USHORT_MIN ((unsigned short)0) -#endif - -#ifndef PERL_USHORT_MAX -# ifdef USHORT_MAX -# define PERL_USHORT_MAX ((unsigned short)USHORT_MAX) -# else -# ifdef MAXUSHORT -# define PERL_USHORT_MAX ((unsigned short)MAXUSHORT) -# else -# ifdef USHRT_MAX -# define PERL_USHORT_MAX ((unsigned short)USHRT_MAX) -# else -# define PERL_USHORT_MAX ((unsigned short)~(unsigned)0) -# endif -# endif -# endif -#endif - -#ifndef PERL_SHORT_MAX -# ifdef SHORT_MAX -# define PERL_SHORT_MAX ((short)SHORT_MAX) -# else -# ifdef MAXSHORT /* Often used in <values.h> */ -# define PERL_SHORT_MAX ((short)MAXSHORT) -# else -# ifdef SHRT_MAX -# define PERL_SHORT_MAX ((short)SHRT_MAX) -# else -# define PERL_SHORT_MAX ((short) (PERL_USHORT_MAX >> 1)) -# endif -# endif -# endif -#endif - -#ifndef PERL_SHORT_MIN -# ifdef SHORT_MIN -# define PERL_SHORT_MIN ((short)SHORT_MIN) -# else -# ifdef MINSHORT -# define PERL_SHORT_MIN ((short)MINSHORT) -# else -# ifdef SHRT_MIN -# define PERL_SHORT_MIN ((short)SHRT_MIN) -# else -# define PERL_SHORT_MIN (-PERL_SHORT_MAX - ((3 & -1) == 3)) -# endif -# endif -# endif -#endif - -#ifndef PERL_UINT_MAX -# ifdef UINT_MAX -# define PERL_UINT_MAX ((unsigned int)UINT_MAX) -# else -# ifdef MAXUINT -# define PERL_UINT_MAX ((unsigned int)MAXUINT) -# else -# define PERL_UINT_MAX (~(unsigned int)0) -# endif -# endif -#endif - -#ifndef PERL_UINT_MIN -# define PERL_UINT_MIN ((unsigned int)0) -#endif - -#ifndef PERL_INT_MAX -# ifdef INT_MAX -# define PERL_INT_MAX ((int)INT_MAX) -# else -# ifdef MAXINT /* Often used in <values.h> */ -# define PERL_INT_MAX ((int)MAXINT) -# else -# define PERL_INT_MAX ((int)(PERL_UINT_MAX >> 1)) -# endif -# endif -#endif - -#ifndef PERL_INT_MIN -# ifdef INT_MIN -# define PERL_INT_MIN ((int)INT_MIN) -# else -# ifdef MININT -# define PERL_INT_MIN ((int)MININT) -# else -# define PERL_INT_MIN (-PERL_INT_MAX - ((3 & -1) == 3)) -# endif -# endif -#endif - -#ifndef PERL_ULONG_MAX -# ifdef ULONG_MAX -# define PERL_ULONG_MAX ((unsigned long)ULONG_MAX) -# else -# ifdef MAXULONG -# define PERL_ULONG_MAX ((unsigned long)MAXULONG) -# else -# define PERL_ULONG_MAX (~(unsigned long)0) -# endif -# endif -#endif - -#ifndef PERL_ULONG_MIN -# define PERL_ULONG_MIN ((unsigned long)0L) -#endif - -#ifndef PERL_LONG_MAX -# ifdef LONG_MAX -# define PERL_LONG_MAX ((long)LONG_MAX) -# else -# ifdef MAXLONG -# define PERL_LONG_MAX ((long)MAXLONG) -# else -# define PERL_LONG_MAX ((long) (PERL_ULONG_MAX >> 1)) -# endif -# endif -#endif - -#ifndef PERL_LONG_MIN -# ifdef LONG_MIN -# define PERL_LONG_MIN ((long)LONG_MIN) -# else -# ifdef MINLONG -# define PERL_LONG_MIN ((long)MINLONG) -# else -# define PERL_LONG_MIN (-PERL_LONG_MAX - ((3 & -1) == 3)) -# endif -# endif -#endif - -#if defined(HAS_QUAD) && (defined(convex) || defined(uts)) -# ifndef PERL_UQUAD_MAX -# ifdef ULONGLONG_MAX -# define PERL_UQUAD_MAX ((unsigned long long)ULONGLONG_MAX) -# else -# ifdef MAXULONGLONG -# define PERL_UQUAD_MAX ((unsigned long long)MAXULONGLONG) -# else -# define PERL_UQUAD_MAX (~(unsigned long long)0) -# endif -# endif -# endif - -# ifndef PERL_UQUAD_MIN -# define PERL_UQUAD_MIN ((unsigned long long)0L) -# endif - -# ifndef PERL_QUAD_MAX -# ifdef LONGLONG_MAX -# define PERL_QUAD_MAX ((long long)LONGLONG_MAX) -# else -# ifdef MAXLONGLONG -# define PERL_QUAD_MAX ((long long)MAXLONGLONG) -# else -# define PERL_QUAD_MAX ((long long) (PERL_UQUAD_MAX >> 1)) -# endif -# endif -# endif - -# ifndef PERL_QUAD_MIN -# ifdef LONGLONG_MIN -# define PERL_QUAD_MIN ((long long)LONGLONG_MIN) -# else -# ifdef MINLONGLONG -# define PERL_QUAD_MIN ((long long)MINLONGLONG) -# else -# define PERL_QUAD_MIN (-PERL_QUAD_MAX - ((3 & -1) == 3)) -# endif -# endif -# endif -#endif - -/* This is based on code from 5.003 perl.h */ -#ifdef HAS_QUAD -# ifdef cray -#ifndef IVTYPE -# define IVTYPE int -#endif - -#ifndef IV_MIN -# define IV_MIN PERL_INT_MIN -#endif - -#ifndef IV_MAX -# define IV_MAX PERL_INT_MAX -#endif - -#ifndef UV_MIN -# define UV_MIN PERL_UINT_MIN -#endif - -#ifndef UV_MAX -# define UV_MAX PERL_UINT_MAX -#endif - -# ifdef INTSIZE -#ifndef IVSIZE -# define IVSIZE INTSIZE -#endif - -# endif -# else -# if defined(convex) || defined(uts) -#ifndef IVTYPE -# define IVTYPE long long -#endif - -#ifndef IV_MIN -# define IV_MIN PERL_QUAD_MIN -#endif - -#ifndef IV_MAX -# define IV_MAX PERL_QUAD_MAX -#endif - -#ifndef UV_MIN -# define UV_MIN PERL_UQUAD_MIN -#endif - -#ifndef UV_MAX -# define UV_MAX PERL_UQUAD_MAX -#endif - -# ifdef LONGLONGSIZE -#ifndef IVSIZE -# define IVSIZE LONGLONGSIZE -#endif - -# endif -# else -#ifndef IVTYPE -# define IVTYPE long -#endif - -#ifndef IV_MIN -# define IV_MIN PERL_LONG_MIN -#endif - -#ifndef IV_MAX -# define IV_MAX PERL_LONG_MAX -#endif - -#ifndef UV_MIN -# define UV_MIN PERL_ULONG_MIN -#endif - -#ifndef UV_MAX -# define UV_MAX PERL_ULONG_MAX -#endif - -# ifdef LONGSIZE -#ifndef IVSIZE -# define IVSIZE LONGSIZE -#endif - -# endif -# endif -# endif -#ifndef IVSIZE -# define IVSIZE 8 -#endif - -#ifndef PERL_QUAD_MIN -# define PERL_QUAD_MIN IV_MIN -#endif - -#ifndef PERL_QUAD_MAX -# define PERL_QUAD_MAX IV_MAX -#endif - -#ifndef PERL_UQUAD_MIN -# define PERL_UQUAD_MIN UV_MIN -#endif - -#ifndef PERL_UQUAD_MAX -# define PERL_UQUAD_MAX UV_MAX -#endif - -#else -#ifndef IVTYPE -# define IVTYPE long -#endif - -#ifndef IV_MIN -# define IV_MIN PERL_LONG_MIN -#endif - -#ifndef IV_MAX -# define IV_MAX PERL_LONG_MAX -#endif - -#ifndef UV_MIN -# define UV_MIN PERL_ULONG_MIN -#endif - -#ifndef UV_MAX -# define UV_MAX PERL_ULONG_MAX -#endif - -#endif - -#ifndef IVSIZE -# ifdef LONGSIZE -# define IVSIZE LONGSIZE -# else -# define IVSIZE 4 /* A bold guess, but the best we can make. */ -# endif -#endif -#ifndef UVTYPE -# define UVTYPE unsigned IVTYPE -#endif - -#ifndef UVSIZE -# define UVSIZE IVSIZE -#endif -#ifndef sv_setuv -# define sv_setuv(sv, uv) \ - STMT_START { \ - UV TeMpUv = uv; \ - if (TeMpUv <= IV_MAX) \ - sv_setiv(sv, TeMpUv); \ - else \ - sv_setnv(sv, (double)TeMpUv); \ - } STMT_END -#endif -#ifndef newSVuv -# define newSVuv(uv) ((uv) <= IV_MAX ? newSViv((IV)uv) : newSVnv((NV)uv)) -#endif -#ifndef sv_2uv -# define sv_2uv(sv) ((PL_Sv = (sv)), (UV) (SvNOK(PL_Sv) ? SvNV(PL_Sv) : sv_2nv(PL_Sv))) -#endif - -#ifndef SvUVX -# define SvUVX(sv) ((UV)SvIVX(sv)) -#endif - -#ifndef SvUVXx -# define SvUVXx(sv) SvUVX(sv) -#endif - -#ifndef SvUV -# define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv)) -#endif - -#ifndef SvUVx -# define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv)) -#endif - -/* Hint: sv_uv - * Always use the SvUVx() macro instead of sv_uv(). - */ -#ifndef sv_uv -# define sv_uv(sv) SvUVx(sv) -#endif -#ifndef XST_mUV -# define XST_mUV(i,v) (ST(i) = sv_2mortal(newSVuv(v)) ) -#endif - -#ifndef XSRETURN_UV -# define XSRETURN_UV(v) STMT_START { XST_mUV(0,v); XSRETURN(1); } STMT_END -#endif -#ifndef PUSHu -# define PUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); PUSHTARG; } STMT_END -#endif - -#ifndef XPUSHu -# define XPUSHu(u) STMT_START { sv_setuv(TARG, (UV)(u)); XPUSHTARG; } STMT_END -#endif - -#ifdef HAS_MEMCMP -#ifndef memNE -# define memNE(s1,s2,l) (memcmp(s1,s2,l)) -#endif - -#ifndef memEQ -# define memEQ(s1,s2,l) (!memcmp(s1,s2,l)) -#endif - -#else -#ifndef memNE -# define memNE(s1,s2,l) (bcmp(s1,s2,l)) -#endif - -#ifndef memEQ -# define memEQ(s1,s2,l) (!bcmp(s1,s2,l)) -#endif - -#endif -#ifndef MoveD -# define MoveD(s,d,n,t) memmove((char*)(d),(char*)(s), (n) * sizeof(t)) -#endif - -#ifndef CopyD -# define CopyD(s,d,n,t) memcpy((char*)(d),(char*)(s), (n) * sizeof(t)) -#endif - -#ifdef HAS_MEMSET -#ifndef ZeroD -# define ZeroD(d,n,t) memzero((char*)(d), (n) * sizeof(t)) -#endif - -#else -#ifndef ZeroD -# define ZeroD(d,n,t) ((void)memzero((char*)(d), (n) * sizeof(t)), d) -#endif - -#endif -#ifndef PoisonWith -# define PoisonWith(d,n,t,b) (void)memset((char*)(d), (U8)(b), (n) * sizeof(t)) -#endif - -#ifndef PoisonNew -# define PoisonNew(d,n,t) PoisonWith(d,n,t,0xAB) -#endif - -#ifndef PoisonFree -# define PoisonFree(d,n,t) PoisonWith(d,n,t,0xEF) -#endif - -#ifndef Poison -# define Poison(d,n,t) PoisonFree(d,n,t) -#endif -#ifndef Newx -# define Newx(v,n,t) New(0,v,n,t) -#endif - -#ifndef Newxc -# define Newxc(v,n,t,c) Newc(0,v,n,t,c) -#endif - -#ifndef Newxz -# define Newxz(v,n,t) Newz(0,v,n,t) -#endif - -#if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION <= 5))) -/* Replace: 1 */ -# define PL_DBsingle DBsingle -# define PL_DBsub DBsub -# define PL_Sv Sv -# define PL_compiling compiling -# define PL_copline copline -# define PL_curcop curcop -# define PL_curstash curstash -# define PL_debstash debstash -# define PL_defgv defgv -# define PL_diehook diehook -# define PL_dirty dirty -# define PL_dowarn dowarn -# define PL_errgv errgv -# define PL_hexdigit hexdigit -# define PL_hints hints -# define PL_na na -# define PL_no_modify no_modify -# define PL_perl_destruct_level perl_destruct_level -# define PL_perldb perldb -# define PL_ppaddr ppaddr -# define PL_rsfp_filters rsfp_filters -# define PL_rsfp rsfp -# define PL_stack_base stack_base -# define PL_stack_sp stack_sp -# define PL_stdingv stdingv -# define PL_sv_arenaroot sv_arenaroot -# define PL_sv_no sv_no -# define PL_sv_undef sv_undef -# define PL_sv_yes sv_yes -# define PL_tainted tainted -# define PL_tainting tainting -/* Replace: 0 */ -#endif - -#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 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 - -#ifndef PERL_UNUSED_VAR -# define PERL_UNUSED_VAR(x) ((void)x) -#endif - -#ifndef PERL_UNUSED_CONTEXT -# ifdef USE_ITHREADS -# define PERL_UNUSED_CONTEXT PERL_UNUSED_ARG(my_perl) -# else -# define PERL_UNUSED_CONTEXT -# endif -#endif -#ifndef NOOP -# define NOOP /*EMPTY*/(void)0 -#endif - -#ifndef dNOOP -# define dNOOP extern int /*@unused@*/ Perl___notused PERL_UNUSED_DECL -#endif - -#ifndef NVTYPE -# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) -# define NVTYPE long double -# else -# define NVTYPE double -# endif -typedef NVTYPE NV; -#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 - -# define NUM2PTR(any,d) (any)(PTRV)(d) -# define PTR2IV(p) INT2PTR(IV,p) -# define PTR2UV(p) INT2PTR(UV,p) -# define PTR2NV(p) NUM2PTR(NV,p) - -# if PTRSIZE == LONGSIZE -# define PTR2ul(p) (unsigned long)(p) -# else -# define PTR2ul(p) INT2PTR(unsigned long,p) -# endif - -#endif /* !INT2PTR */ - -#undef START_EXTERN_C -#undef END_EXTERN_C -#undef EXTERN_C -#ifdef __cplusplus -# define START_EXTERN_C extern "C" { -# define END_EXTERN_C } -# define EXTERN_C extern "C" -#else -# define START_EXTERN_C -# define END_EXTERN_C -# define EXTERN_C extern -#endif - -#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 - -#undef STMT_START -#undef STMT_END -#ifdef PERL_USE_GCC_BRACE_GROUPS -# define STMT_START (void)( /* gcc supports ``({ STATEMENTS; })'' */ -# define STMT_END ) -#else -# if defined(VOIDFLAGS) && (VOIDFLAGS) && (defined(sun) || defined(__sun__)) && !defined(__GNUC__) -# define STMT_START if (1) -# define STMT_END else (void)0 -# else -# define STMT_START do -# define STMT_END while (0) -# endif -#endif -#ifndef boolSV -# define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no) -#endif - -/* DEFSV appears first in 5.004_56 */ -#ifndef DEFSV -# define DEFSV GvSV(PL_defgv) -#endif - -#ifndef SAVE_DEFSV -# define SAVE_DEFSV SAVESPTR(GvSV(PL_defgv)) -#endif - -/* Older perls (<=5.003) lack AvFILLp */ -#ifndef AvFILLp -# define AvFILLp AvFILL -#endif -#ifndef ERRSV -# define ERRSV get_sv("@",FALSE) -#endif -#ifndef newSVpvn -# define newSVpvn(data,len) ((data) \ - ? ((len) ? newSVpv((data), (len)) : newSVpv("", 0)) \ - : newSV(0)) -#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) -#endif - -/* Replace: 1 */ -#ifndef get_cv -# define get_cv perl_get_cv -#endif - -#ifndef get_sv -# define get_sv perl_get_sv -#endif - -#ifndef get_av -# define get_av perl_get_av -#endif - -#ifndef get_hv -# define get_hv perl_get_hv -#endif - -/* Replace: 0 */ -#ifndef dUNDERBAR -# define dUNDERBAR dNOOP -#endif - -#ifndef UNDERBAR -# define UNDERBAR DEFSV -#endif -#ifndef dAX -# define dAX I32 ax = MARK - PL_stack_base + 1 -#endif - -#ifndef dITEMS -# define dITEMS I32 items = SP - MARK -#endif -#ifndef dXSTARG -# define dXSTARG SV * targ = sv_newmortal() -#endif -#ifndef dAXMARK -# define dAXMARK I32 ax = POPMARK; \ - register SV ** const mark = PL_stack_base + ax++ -#endif -#ifndef XSprePUSH -# define XSprePUSH (sp = PL_stack_base + ax - 1) -#endif - -#if ((PERL_VERSION < 5) || ((PERL_VERSION == 5) && (PERL_SUBVERSION < 0))) -# undef XSRETURN -# define XSRETURN(off) \ - STMT_START { \ - PL_stack_sp = PL_stack_base + ax + ((off) - 1); \ - return; \ - } STMT_END -#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 PERL_SIGNALS_UNSAFE_FLAG - -#define PERL_SIGNALS_UNSAFE_FLAG 0x0001 - -#if defined(NEED_PL_signals) -static U32 DPPP_(my_PL_signals) = PERL_SIGNALS_UNSAFE_FLAG; -#elif defined(NEED_PL_signals_GLOBAL) -U32 DPPP_(my_PL_signals) = PERL_SIGNALS_UNSAFE_FLAG; -#else -extern U32 DPPP_(my_PL_signals); -#endif -#define PL_signals DPPP_(my_PL_signals) - -#endif -#ifndef dTHR -# define dTHR dNOOP -#endif -#ifndef dTHX -# define dTHX dNOOP -#endif - -#ifndef dTHXa -# define dTHXa(x) dNOOP -#endif -#ifndef pTHX -# define pTHX void -#endif - -#ifndef pTHX_ -# define pTHX_ -#endif - -#ifndef aTHX -# define aTHX -#endif - -#ifndef aTHX_ -# define aTHX_ -#endif -#ifndef dTHXoa -# define dTHXoa(x) dTHXa(x) -#endif -#ifndef PUSHmortal -# define PUSHmortal PUSHs(sv_newmortal()) -#endif - -#ifndef mPUSHp -# define mPUSHp(p,l) sv_setpvn_mg(PUSHmortal, (p), (l)) -#endif - -#ifndef mPUSHn -# define mPUSHn(n) sv_setnv_mg(PUSHmortal, (NV)(n)) -#endif - -#ifndef mPUSHi -# define mPUSHi(i) sv_setiv_mg(PUSHmortal, (IV)(i)) -#endif - -#ifndef mPUSHu -# define mPUSHu(u) sv_setuv_mg(PUSHmortal, (UV)(u)) -#endif -#ifndef XPUSHmortal -# define XPUSHmortal XPUSHs(sv_newmortal()) -#endif - -#ifndef mXPUSHp -# define mXPUSHp(p,l) STMT_START { EXTEND(sp,1); sv_setpvn_mg(PUSHmortal, (p), (l)); } STMT_END -#endif - -#ifndef mXPUSHn -# define mXPUSHn(n) STMT_START { EXTEND(sp,1); sv_setnv_mg(PUSHmortal, (NV)(n)); } STMT_END -#endif - -#ifndef mXPUSHi -# define mXPUSHi(i) STMT_START { EXTEND(sp,1); sv_setiv_mg(PUSHmortal, (IV)(i)); } STMT_END -#endif - -#ifndef mXPUSHu -# define mXPUSHu(u) STMT_START { EXTEND(sp,1); sv_setuv_mg(PUSHmortal, (UV)(u)); } STMT_END -#endif - -/* Replace: 1 */ -#ifndef call_sv -# define call_sv perl_call_sv -#endif - -#ifndef call_pv -# define call_pv perl_call_pv -#endif - -#ifndef call_argv -# define call_argv perl_call_argv -#endif - -#ifndef call_method -# define call_method perl_call_method -#endif -#ifndef eval_sv -# define eval_sv perl_eval_sv -#endif - -/* Replace: 0 */ - -/* Replace perl_eval_pv with eval_pv */ -/* eval_pv depends on eval_sv */ - -#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 - -#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) - -#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; -} - -#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_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 63))) && ((PERL_VERSION != 4) || (PERL_SUBVERSION != 5)) -#if defined(NEED_newCONSTSUB) -static void DPPP_(my_newCONSTSUB)(HV *stash, char *name, SV *sv); -static -#else -extern void DPPP_(my_newCONSTSUB)(HV *stash, 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) - -void -DPPP_(my_newCONSTSUB)(HV *stash, 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 = PL_copline; - - PL_hints &= ~HINT_BLOCK_SCOPE; - if (stash) - PL_curstash = PL_curcop->cop_stash = stash; - - newSUB( - -#if ((PERL_VERSION < 3) || ((PERL_VERSION == 3) && (PERL_SUBVERSION < 22))) - start_subparse(), -#elif ((PERL_VERSION == 3) && (PERL_SUBVERSION == 22)) - start_subparse(0), -#else /* 5.003_23 onwards */ - start_subparse(FALSE, 0), -#endif - - newSVOP(OP_CONST, 0, newSVpv(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_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 68))) -/* 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 IVdf -# if IVSIZE == LONGSIZE -# define IVdf "ld" -# define UVuf "lu" -# define UVof "lo" -# define UVxf "lx" -# define UVXf "lX" -# else -# if IVSIZE == INTSIZE -# define IVdf "d" -# define UVuf "u" -# define UVof "o" -# define UVxf "x" -# define UVXf "X" -# endif -# endif -#endif - -#ifndef NVef -# if defined(USE_LONG_DOUBLE) && defined(HAS_LONG_DOUBLE) && \ - defined(PERL_PRIfldbl) /* Not very likely, but let's try anyway. */ -# define NVef PERL_PRIeldbl -# define NVff PERL_PRIfldbl -# define NVgf PERL_PRIgldbl -# else -# define NVef "e" -# define NVff "f" -# define NVgf "g" -# 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 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)) -#endif - -#ifndef SvREFCNT_inc_void_NN -# define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) -#endif - -#ifndef SvREFCNT_inc_simple_void_NN -# define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv))) -#endif - -#ifndef SvPV_nolen - -#if defined(NEED_sv_2pv_nolen) -static char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv); -static -#else -extern char * DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv); -#endif - -#ifdef sv_2pv_nolen -# undef sv_2pv_nolen -#endif -#define sv_2pv_nolen(a) DPPP_(my_sv_2pv_nolen)(aTHX_ a) -#define Perl_sv_2pv_nolen DPPP_(my_sv_2pv_nolen) - -#if defined(NEED_sv_2pv_nolen) || defined(NEED_sv_2pv_nolen_GLOBAL) - -char * -DPPP_(my_sv_2pv_nolen)(pTHX_ register SV *sv) -{ - STRLEN n_a; - return sv_2pv(sv, &n_a); -} - -#endif - -/* Hint: sv_2pv_nolen - * Use the SvPV_nolen() macro instead of sv_2pv_nolen(). - */ - -/* SvPV_nolen depends on sv_2pv_nolen */ -#define SvPV_nolen(sv) \ - ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \ - ? SvPVX(sv) : sv_2pv_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_VERSION < 7) || ((PERL_VERSION == 7) && (PERL_SUBVERSION < 0))) - -#if defined(NEED_sv_2pvbyte) -static char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp); -static -#else -extern char * DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp); -#endif - -#ifdef sv_2pvbyte -# undef sv_2pvbyte -#endif -#define sv_2pvbyte(a,b) DPPP_(my_sv_2pvbyte)(aTHX_ a,b) -#define Perl_sv_2pvbyte DPPP_(my_sv_2pvbyte) - -#if defined(NEED_sv_2pvbyte) || defined(NEED_sv_2pvbyte_GLOBAL) - -char * -DPPP_(my_sv_2pvbyte)(pTHX_ register SV *sv, STRLEN *lp) -{ - sv_utf8_downgrade(sv,0); - return SvPV(sv,*lp); -} - -#endif - -/* Hint: sv_2pvbyte - * Use the SvPVbyte() macro instead of sv_2pvbyte(). - */ - -#undef SvPVbyte - -/* SvPVbyte depends on sv_2pvbyte */ -#define SvPVbyte(sv, lp) \ - ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \ - ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp)) - -#endif - -#else - -# define SvPVbyte SvPV -# define sv_2pvbyte sv_2pv - -#endif - -/* sv_2pvbyte_nolen depends on sv_2pv_nolen */ -#ifndef sv_2pvbyte_nolen -# define sv_2pvbyte_nolen sv_2pv_nolen -#endif - -/* Hint: sv_pvn - * Always use the SvPV() macro instead of sv_pvn(). - */ -#ifndef sv_pvn -# define sv_pvn(sv, len) SvPV(sv, len) -#endif - -/* Hint: sv_pvn_force - * Always use the SvPV_force() macro instead of sv_pvn_force(). - */ -#ifndef sv_pvn_force -# define sv_pvn_force(sv, len) SvPV_force(sv, len) -#endif -#ifndef SvMAGIC_set -# define SvMAGIC_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ - (((XPVMG*) SvANY(sv))->xmg_magic = (val)); } STMT_END -#endif - -#if ((PERL_VERSION < 9) || ((PERL_VERSION == 9) && (PERL_SUBVERSION < 3))) -#ifndef SvPVX_const -# define SvPVX_const(sv) ((const char*) (0 + SvPVX(sv))) -#endif - -#ifndef SvPVX_mutable -# define SvPVX_mutable(sv) (0 + SvPVX(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 -#endif - -#else -#ifndef SvPVX_const -# define SvPVX_const(sv) ((const char*)((sv)->sv_u.svu_pv)) -#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 -#endif - -#endif -#ifndef SvSTASH_set -# define SvSTASH_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ - (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END -#endif - -#if ((PERL_VERSION < 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION < 0))) -#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 - -#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 - -#endif - -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(vnewSVpvf) -#if defined(NEED_vnewSVpvf) -static SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args); -static -#else -extern SV * DPPP_(my_vnewSVpvf)(pTHX_ const char * pat, va_list * args); -#endif - -#ifdef vnewSVpvf -# undef vnewSVpvf -#endif -#define vnewSVpvf(a,b) DPPP_(my_vnewSVpvf)(aTHX_ a,b) -#define Perl_vnewSVpvf DPPP_(my_vnewSVpvf) - -#if defined(NEED_vnewSVpvf) || defined(NEED_vnewSVpvf_GLOBAL) - -SV * -DPPP_(my_vnewSVpvf)(pTHX_ const char *pat, va_list *args) -{ - register SV *sv = newSV(0); - sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); - return sv; -} - -#endif -#endif - -/* sv_vcatpvf depends on sv_vcatpvfn */ -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf) -# define sv_vcatpvf(sv, pat, args) sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) -#endif - -/* sv_vsetpvf depends on sv_vsetpvfn */ -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf) -# define sv_vsetpvf(sv, pat, args) sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)) -#endif - -/* sv_catpvf_mg depends on sv_vcatpvfn, sv_catpvf_mg_nocontext */ -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg) -#if defined(NEED_sv_catpvf_mg) -static void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...); -static -#else -extern void DPPP_(my_sv_catpvf_mg)(pTHX_ SV * sv, const char * pat, ...); -#endif - -#define Perl_sv_catpvf_mg DPPP_(my_sv_catpvf_mg) - -#if defined(NEED_sv_catpvf_mg) || defined(NEED_sv_catpvf_mg_GLOBAL) - -void -DPPP_(my_sv_catpvf_mg)(pTHX_ SV *sv, const char *pat, ...) -{ - va_list args; - va_start(args, pat); - sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); - SvSETMAGIC(sv); - va_end(args); -} - -#endif -#endif - -/* sv_catpvf_mg_nocontext depends on sv_vcatpvfn */ -#ifdef PERL_IMPLICIT_CONTEXT -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_catpvf_mg_nocontext) -#if defined(NEED_sv_catpvf_mg_nocontext) -static void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...); -static -#else -extern void DPPP_(my_sv_catpvf_mg_nocontext)(SV * sv, const char * pat, ...); -#endif - -#define sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) -#define Perl_sv_catpvf_mg_nocontext DPPP_(my_sv_catpvf_mg_nocontext) - -#if defined(NEED_sv_catpvf_mg_nocontext) || defined(NEED_sv_catpvf_mg_nocontext_GLOBAL) - -void -DPPP_(my_sv_catpvf_mg_nocontext)(SV *sv, const char *pat, ...) -{ - dTHX; - va_list args; - va_start(args, pat); - sv_vcatpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); - SvSETMAGIC(sv); - va_end(args); -} - -#endif -#endif -#endif - -#ifndef sv_catpvf_mg -# ifdef PERL_IMPLICIT_CONTEXT -# define sv_catpvf_mg Perl_sv_catpvf_mg_nocontext -# else -# define sv_catpvf_mg Perl_sv_catpvf_mg -# endif -#endif - -/* sv_vcatpvf_mg depends on sv_vcatpvfn */ -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vcatpvf_mg) -# define sv_vcatpvf_mg(sv, pat, args) \ - STMT_START { \ - sv_vcatpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ - SvSETMAGIC(sv); \ - } STMT_END -#endif - -/* sv_setpvf_mg depends on sv_vsetpvfn, sv_setpvf_mg_nocontext */ -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg) -#if defined(NEED_sv_setpvf_mg) -static void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...); -static -#else -extern void DPPP_(my_sv_setpvf_mg)(pTHX_ SV * sv, const char * pat, ...); -#endif - -#define Perl_sv_setpvf_mg DPPP_(my_sv_setpvf_mg) - -#if defined(NEED_sv_setpvf_mg) || defined(NEED_sv_setpvf_mg_GLOBAL) - -void -DPPP_(my_sv_setpvf_mg)(pTHX_ SV *sv, const char *pat, ...) -{ - va_list args; - va_start(args, pat); - sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); - SvSETMAGIC(sv); - va_end(args); -} - -#endif -#endif - -/* sv_setpvf_mg_nocontext depends on sv_vsetpvfn */ -#ifdef PERL_IMPLICIT_CONTEXT -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_setpvf_mg_nocontext) -#if defined(NEED_sv_setpvf_mg_nocontext) -static void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...); -static -#else -extern void DPPP_(my_sv_setpvf_mg_nocontext)(SV * sv, const char * pat, ...); -#endif - -#define sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) -#define Perl_sv_setpvf_mg_nocontext DPPP_(my_sv_setpvf_mg_nocontext) - -#if defined(NEED_sv_setpvf_mg_nocontext) || defined(NEED_sv_setpvf_mg_nocontext_GLOBAL) - -void -DPPP_(my_sv_setpvf_mg_nocontext)(SV *sv, const char *pat, ...) -{ - dTHX; - va_list args; - va_start(args, pat); - sv_vsetpvfn(sv, pat, strlen(pat), &args, Null(SV**), 0, Null(bool*)); - SvSETMAGIC(sv); - va_end(args); -} - -#endif -#endif -#endif - -#ifndef sv_setpvf_mg -# ifdef PERL_IMPLICIT_CONTEXT -# define sv_setpvf_mg Perl_sv_setpvf_mg_nocontext -# else -# define sv_setpvf_mg Perl_sv_setpvf_mg -# endif -#endif - -/* sv_vsetpvf_mg depends on sv_vsetpvfn */ -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(sv_vsetpvf_mg) -# define sv_vsetpvf_mg(sv, pat, args) \ - STMT_START { \ - sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); \ - SvSETMAGIC(sv); \ - } STMT_END -#endif -#ifndef WARN_ALL -# define WARN_ALL 0 -#endif - -#ifndef WARN_CLOSURE -# define WARN_CLOSURE 1 -#endif - -#ifndef WARN_DEPRECATED -# define WARN_DEPRECATED 2 -#endif - -#ifndef WARN_EXITING -# define WARN_EXITING 3 -#endif - -#ifndef WARN_GLOB -# define WARN_GLOB 4 -#endif - -#ifndef WARN_IO -# define WARN_IO 5 -#endif - -#ifndef WARN_CLOSED -# define WARN_CLOSED 6 -#endif - -#ifndef WARN_EXEC -# define WARN_EXEC 7 -#endif - -#ifndef WARN_LAYER -# define WARN_LAYER 8 -#endif - -#ifndef WARN_NEWLINE -# define WARN_NEWLINE 9 -#endif - -#ifndef WARN_PIPE -# define WARN_PIPE 10 -#endif - -#ifndef WARN_UNOPENED -# define WARN_UNOPENED 11 -#endif - -#ifndef WARN_MISC -# define WARN_MISC 12 -#endif - -#ifndef WARN_NUMERIC -# define WARN_NUMERIC 13 -#endif - -#ifndef WARN_ONCE -# define WARN_ONCE 14 -#endif - -#ifndef WARN_OVERFLOW -# define WARN_OVERFLOW 15 -#endif - -#ifndef WARN_PACK -# define WARN_PACK 16 -#endif - -#ifndef WARN_PORTABLE -# define WARN_PORTABLE 17 -#endif - -#ifndef WARN_RECURSION -# define WARN_RECURSION 18 -#endif - -#ifndef WARN_REDEFINE -# define WARN_REDEFINE 19 -#endif - -#ifndef WARN_REGEXP -# define WARN_REGEXP 20 -#endif - -#ifndef WARN_SEVERE -# define WARN_SEVERE 21 -#endif - -#ifndef WARN_DEBUGGING -# define WARN_DEBUGGING 22 -#endif - -#ifndef WARN_INPLACE -# define WARN_INPLACE 23 -#endif - -#ifndef WARN_INTERNAL -# define WARN_INTERNAL 24 -#endif - -#ifndef WARN_MALLOC -# define WARN_MALLOC 25 -#endif - -#ifndef WARN_SIGNAL -# define WARN_SIGNAL 26 -#endif - -#ifndef WARN_SUBSTR -# define WARN_SUBSTR 27 -#endif - -#ifndef WARN_SYNTAX -# define WARN_SYNTAX 28 -#endif - -#ifndef WARN_AMBIGUOUS -# define WARN_AMBIGUOUS 29 -#endif - -#ifndef WARN_BAREWORD -# define WARN_BAREWORD 30 -#endif - -#ifndef WARN_DIGIT -# define WARN_DIGIT 31 -#endif - -#ifndef WARN_PARENTHESIS -# define WARN_PARENTHESIS 32 -#endif - -#ifndef WARN_PRECEDENCE -# define WARN_PRECEDENCE 33 -#endif - -#ifndef WARN_PRINTF -# define WARN_PRINTF 34 -#endif - -#ifndef WARN_PROTOTYPE -# define WARN_PROTOTYPE 35 -#endif - -#ifndef WARN_QW -# define WARN_QW 36 -#endif - -#ifndef WARN_RESERVED -# define WARN_RESERVED 37 -#endif - -#ifndef WARN_SEMICOLON -# define WARN_SEMICOLON 38 -#endif - -#ifndef WARN_TAINT -# define WARN_TAINT 39 -#endif - -#ifndef WARN_THREADS -# define WARN_THREADS 40 -#endif - -#ifndef WARN_UNINITIALIZED -# define WARN_UNINITIALIZED 41 -#endif - -#ifndef WARN_UNPACK -# define WARN_UNPACK 42 -#endif - -#ifndef WARN_UNTIE -# define WARN_UNTIE 43 -#endif - -#ifndef WARN_UTF8 -# define WARN_UTF8 44 -#endif - -#ifndef WARN_VOID -# define WARN_VOID 45 -#endif - -#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 - -/* warner depends on vnewSVpvf */ -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) && !defined(warner) -#if defined(NEED_warner) -static void DPPP_(my_warner)(U32 err, const char *pat, ...); -static -#else -extern void DPPP_(my_warner)(U32 err, const char *pat, ...); -#endif - -#define Perl_warner DPPP_(my_warner) - -#if defined(NEED_warner) || defined(NEED_warner_GLOBAL) - -void -DPPP_(my_warner)(U32 err, const char *pat, ...) -{ - SV *sv; - va_list args; - - PERL_UNUSED_ARG(err); - - va_start(args, pat); - sv = vnewSVpvf(pat, &args); - va_end(args); - sv_2mortal(sv); - warn("%s", SvPV_nolen(sv)); -} - -#define warner Perl_warner - -/* Perl_warner_nocontext depends on 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 sv_catpvs -# define sv_catpvs(sv, str) sv_catpvn(sv, str "", sizeof(str) - 1) -#endif - -#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 SvGETMAGIC -# define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END -#endif -#ifndef PERL_MAGIC_sv -# define PERL_MAGIC_sv '\0' -#endif - -#ifndef PERL_MAGIC_overload -# define PERL_MAGIC_overload 'A' -#endif - -#ifndef PERL_MAGIC_overload_elem -# define PERL_MAGIC_overload_elem 'a' -#endif - -#ifndef PERL_MAGIC_overload_table -# define PERL_MAGIC_overload_table 'c' -#endif - -#ifndef PERL_MAGIC_bm -# define PERL_MAGIC_bm 'B' -#endif - -#ifndef PERL_MAGIC_regdata -# define PERL_MAGIC_regdata 'D' -#endif - -#ifndef PERL_MAGIC_regdatum -# define PERL_MAGIC_regdatum 'd' -#endif - -#ifndef PERL_MAGIC_env -# define PERL_MAGIC_env 'E' -#endif - -#ifndef PERL_MAGIC_envelem -# define PERL_MAGIC_envelem 'e' -#endif - -#ifndef PERL_MAGIC_fm -# define PERL_MAGIC_fm 'f' -#endif - -#ifndef PERL_MAGIC_regex_global -# define PERL_MAGIC_regex_global 'g' -#endif - -#ifndef PERL_MAGIC_isa -# define PERL_MAGIC_isa 'I' -#endif - -#ifndef PERL_MAGIC_isaelem -# define PERL_MAGIC_isaelem 'i' -#endif - -#ifndef PERL_MAGIC_nkeys -# define PERL_MAGIC_nkeys 'k' -#endif - -#ifndef PERL_MAGIC_dbfile -# define PERL_MAGIC_dbfile 'L' -#endif - -#ifndef PERL_MAGIC_dbline -# define PERL_MAGIC_dbline 'l' -#endif - -#ifndef PERL_MAGIC_mutex -# define PERL_MAGIC_mutex 'm' -#endif - -#ifndef PERL_MAGIC_shared -# define PERL_MAGIC_shared 'N' -#endif - -#ifndef PERL_MAGIC_shared_scalar -# define PERL_MAGIC_shared_scalar 'n' -#endif - -#ifndef PERL_MAGIC_collxfrm -# define PERL_MAGIC_collxfrm 'o' -#endif - -#ifndef PERL_MAGIC_tied -# define PERL_MAGIC_tied 'P' -#endif - -#ifndef PERL_MAGIC_tiedelem -# define PERL_MAGIC_tiedelem 'p' -#endif - -#ifndef PERL_MAGIC_tiedscalar -# define PERL_MAGIC_tiedscalar 'q' -#endif - -#ifndef PERL_MAGIC_qr -# define PERL_MAGIC_qr 'r' -#endif - -#ifndef PERL_MAGIC_sig -# define PERL_MAGIC_sig 'S' -#endif - -#ifndef PERL_MAGIC_sigelem -# define PERL_MAGIC_sigelem 's' -#endif - -#ifndef PERL_MAGIC_taint -# define PERL_MAGIC_taint 't' -#endif - -#ifndef PERL_MAGIC_uvar -# define PERL_MAGIC_uvar 'U' -#endif - -#ifndef PERL_MAGIC_uvar_elem -# define PERL_MAGIC_uvar_elem 'u' -#endif - -#ifndef PERL_MAGIC_vstring -# define PERL_MAGIC_vstring 'V' -#endif - -#ifndef PERL_MAGIC_vec -# define PERL_MAGIC_vec 'v' -#endif - -#ifndef PERL_MAGIC_utf8 -# define PERL_MAGIC_utf8 'w' -#endif - -#ifndef PERL_MAGIC_substr -# define PERL_MAGIC_substr 'x' -#endif - -#ifndef PERL_MAGIC_defelem -# define PERL_MAGIC_defelem 'y' -#endif - -#ifndef PERL_MAGIC_glob -# define PERL_MAGIC_glob '*' -#endif - -#ifndef PERL_MAGIC_arylen -# define PERL_MAGIC_arylen '#' -#endif - -#ifndef PERL_MAGIC_pos -# define PERL_MAGIC_pos '.' -#endif - -#ifndef PERL_MAGIC_backref -# define PERL_MAGIC_backref '<' -#endif - -#ifndef PERL_MAGIC_ext -# define PERL_MAGIC_ext '~' -#endif - -/* That's the best we can do... */ -#ifndef SvPV_force_nomg -# define SvPV_force_nomg SvPV_force -#endif - -#ifndef SvPV_nomg -# define SvPV_nomg SvPV -#endif - -#ifndef sv_catpvn_nomg -# define sv_catpvn_nomg sv_catpvn -#endif - -#ifndef sv_catsv_nomg -# define sv_catsv_nomg sv_catsv -#endif - -#ifndef sv_setsv_nomg -# define sv_setsv_nomg sv_setsv -#endif - -#ifndef sv_pvn_nomg -# define sv_pvn_nomg sv_pvn -#endif - -#ifndef SvIV_nomg -# define SvIV_nomg SvIV -#endif - -#ifndef SvUV_nomg -# define SvUV_nomg SvUV -#endif - -#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 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 sv_catsv_mg -# define sv_catsv_mg(dsv, ssv) \ - STMT_START { \ - SV *TeMpSv = dsv; \ - sv_catsv(TeMpSv,ssv); \ - SvSETMAGIC(TeMpSv); \ - } STMT_END -#endif - -#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 sv_setnv_mg -# define sv_setnv_mg(sv, num) \ - STMT_START { \ - SV *TeMpSv = sv; \ - sv_setnv(TeMpSv,num); \ - SvSETMAGIC(TeMpSv); \ - } STMT_END -#endif - -#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 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 sv_setsv_mg -# define sv_setsv_mg(dsv, ssv) \ - STMT_START { \ - SV *TeMpSv = dsv; \ - sv_setsv(TeMpSv,ssv); \ - SvSETMAGIC(TeMpSv); \ - } STMT_END -#endif - -#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 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 - -#ifdef USE_ITHREADS -#ifndef CopFILE -# define CopFILE(c) ((c)->cop_file) -#endif - -#ifndef CopFILEGV -# define CopFILEGV(c) (CopFILE(c) ? gv_fetchfile(CopFILE(c)) : Nullgv) -#endif - -#ifndef CopFILE_set -# define CopFILE_set(c,pv) ((c)->cop_file = savepv(pv)) -#endif - -#ifndef CopFILESV -# define CopFILESV(c) (CopFILE(c) ? GvSV(gv_fetchfile(CopFILE(c))) : Nullsv) -#endif - -#ifndef CopFILEAV -# define CopFILEAV(c) (CopFILE(c) ? GvAV(gv_fetchfile(CopFILE(c))) : Nullav) -#endif - -#ifndef CopSTASHPV -# define CopSTASHPV(c) ((c)->cop_stashpv) -#endif - -#ifndef CopSTASHPV_set -# define CopSTASHPV_set(c,pv) ((c)->cop_stashpv = ((pv) ? savepv(pv) : Nullch)) -#endif - -#ifndef CopSTASH -# define CopSTASH(c) (CopSTASHPV(c) ? gv_stashpv(CopSTASHPV(c),GV_ADD) : Nullhv) -#endif - -#ifndef CopSTASH_set -# define CopSTASH_set(c,hv) CopSTASHPV_set(c, (hv) ? HvNAME(hv) : Nullch) -#endif - -#ifndef CopSTASH_eq -# define CopSTASH_eq(c,hv) ((hv) && (CopSTASHPV(c) == HvNAME(hv) \ - || (CopSTASHPV(c) && HvNAME(hv) \ - && strEQ(CopSTASHPV(c), HvNAME(hv))))) -#endif - -#else -#ifndef CopFILEGV -# define CopFILEGV(c) ((c)->cop_filegv) -#endif - -#ifndef CopFILEGV_set -# define CopFILEGV_set(c,gv) ((c)->cop_filegv = (GV*)SvREFCNT_inc(gv)) -#endif - -#ifndef CopFILE_set -# define CopFILE_set(c,pv) CopFILEGV_set((c), gv_fetchfile(pv)) -#endif - -#ifndef CopFILESV -# define CopFILESV(c) (CopFILEGV(c) ? GvSV(CopFILEGV(c)) : Nullsv) -#endif - -#ifndef CopFILEAV -# define CopFILEAV(c) (CopFILEGV(c) ? GvAV(CopFILEGV(c)) : Nullav) -#endif - -#ifndef CopFILE -# define CopFILE(c) (CopFILESV(c) ? SvPVX(CopFILESV(c)) : Nullch) -#endif - -#ifndef CopSTASH -# define CopSTASH(c) ((c)->cop_stash) -#endif - -#ifndef CopSTASH_set -# define CopSTASH_set(c,hv) ((c)->cop_stash = (hv)) -#endif - -#ifndef CopSTASHPV -# define CopSTASHPV(c) (CopSTASH(c) ? HvNAME(CopSTASH(c)) : Nullch) -#endif - -#ifndef CopSTASHPV_set -# define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) -#endif - -#ifndef CopSTASH_eq -# define CopSTASH_eq(c,hv) (CopSTASH(c) == (hv)) -#endif - -#endif /* USE_ITHREADS */ -#ifndef IN_PERL_COMPILETIME -# define IN_PERL_COMPILETIME (PL_curcop == &PL_compiling) -#endif - -#ifndef IN_LOCALE_RUNTIME -# define IN_LOCALE_RUNTIME (PL_curcop->op_private & HINT_LOCALE) -#endif - -#ifndef IN_LOCALE_COMPILETIME -# define IN_LOCALE_COMPILETIME (PL_hints & HINT_LOCALE) -#endif - -#ifndef IN_LOCALE -# define IN_LOCALE (IN_PERL_COMPILETIME ? IN_LOCALE_COMPILETIME : IN_LOCALE_RUNTIME) -#endif -#ifndef IS_NUMBER_IN_UV -# define IS_NUMBER_IN_UV 0x01 -#endif - -#ifndef IS_NUMBER_GREATER_THAN_UV_MAX -# define IS_NUMBER_GREATER_THAN_UV_MAX 0x02 -#endif - -#ifndef IS_NUMBER_NOT_INT -# define IS_NUMBER_NOT_INT 0x04 -#endif - -#ifndef IS_NUMBER_NEG -# define IS_NUMBER_NEG 0x08 -#endif - -#ifndef IS_NUMBER_INFINITY -# define IS_NUMBER_INFINITY 0x10 -#endif - -#ifndef IS_NUMBER_NAN -# define IS_NUMBER_NAN 0x20 -#endif - -/* GROK_NUMERIC_RADIX depends on grok_numeric_radix */ -#ifndef GROK_NUMERIC_RADIX -# define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send) -#endif -#ifndef PERL_SCAN_GREATER_THAN_UV_MAX -# define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 -#endif - -#ifndef PERL_SCAN_SILENT_ILLDIGIT -# define PERL_SCAN_SILENT_ILLDIGIT 0x04 -#endif - -#ifndef PERL_SCAN_ALLOW_UNDERSCORES -# define PERL_SCAN_ALLOW_UNDERSCORES 0x01 -#endif - -#ifndef PERL_SCAN_DISALLOW_PREFIX -# define PERL_SCAN_DISALLOW_PREFIX 0x02 -#endif - -#ifndef grok_numeric_radix -#if defined(NEED_grok_numeric_radix) -static bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send); -static -#else -extern bool DPPP_(my_grok_numeric_radix)(pTHX_ const char ** sp, const char * send); -#endif - -#ifdef grok_numeric_radix -# undef grok_numeric_radix -#endif -#define grok_numeric_radix(a,b) DPPP_(my_grok_numeric_radix)(aTHX_ a,b) -#define Perl_grok_numeric_radix DPPP_(my_grok_numeric_radix) - -#if defined(NEED_grok_numeric_radix) || defined(NEED_grok_numeric_radix_GLOBAL) -bool -DPPP_(my_grok_numeric_radix)(pTHX_ const char **sp, const char *send) -{ -#ifdef USE_LOCALE_NUMERIC -#ifdef PL_numeric_radix_sv - if (PL_numeric_radix_sv && IN_LOCALE) { - STRLEN len; - char* radix = SvPV(PL_numeric_radix_sv, len); - if (*sp + len <= send && memEQ(*sp, radix, len)) { - *sp += len; - return TRUE; - } - } -#else - /* older perls don't have PL_numeric_radix_sv so the radix - * must manually be requested from locale.h - */ -#include <locale.h> - dTHR; /* needed for older threaded perls */ - struct lconv *lc = localeconv(); - char *radix = lc->decimal_point; - if (radix && IN_LOCALE) { - STRLEN len = strlen(radix); - if (*sp + len <= send && memEQ(*sp, radix, len)) { - *sp += len; - return TRUE; - } - } -#endif -#endif /* USE_LOCALE_NUMERIC */ - /* always try "." if numeric radix didn't match because - * we may have data from different locales mixed */ - if (*sp < send && **sp == '.') { - ++*sp; - return TRUE; - } - return FALSE; -} -#endif -#endif - -/* grok_number depends on grok_numeric_radix */ - -#ifndef grok_number -#if defined(NEED_grok_number) -static int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep); -static -#else -extern int DPPP_(my_grok_number)(pTHX_ const char * pv, STRLEN len, UV * valuep); -#endif - -#ifdef grok_number -# undef grok_number -#endif -#define grok_number(a,b,c) DPPP_(my_grok_number)(aTHX_ a,b,c) -#define Perl_grok_number DPPP_(my_grok_number) - -#if defined(NEED_grok_number) || defined(NEED_grok_number_GLOBAL) -int -DPPP_(my_grok_number)(pTHX_ const char *pv, STRLEN len, UV *valuep) -{ - const char *s = pv; - const char *send = pv + len; - const UV max_div_10 = UV_MAX / 10; - const char max_mod_10 = UV_MAX % 10; - int numtype = 0; - int sawinf = 0; - int sawnan = 0; - - while (s < send && isSPACE(*s)) - s++; - if (s == send) { - return 0; - } else if (*s == '-') { - s++; - numtype = IS_NUMBER_NEG; - } - else if (*s == '+') - s++; - - if (s == send) - return 0; - - /* next must be digit or the radix separator or beginning of infinity */ - if (isDIGIT(*s)) { - /* UVs are at least 32 bits, so the first 9 decimal digits cannot - overflow. */ - UV value = *s - '0'; - /* This construction seems to be more optimiser friendly. - (without it gcc does the isDIGIT test and the *s - '0' separately) - With it gcc on arm is managing 6 instructions (6 cycles) per digit. - In theory the optimiser could deduce how far to unroll the loop - before checking for overflow. */ - if (++s < send) { - int digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - digit = *s - '0'; - if (digit >= 0 && digit <= 9) { - value = value * 10 + digit; - if (++s < send) { - /* Now got 9 digits, so need to check - each time for overflow. */ - digit = *s - '0'; - while (digit >= 0 && digit <= 9 - && (value < max_div_10 - || (value == max_div_10 - && digit <= max_mod_10))) { - value = value * 10 + digit; - if (++s < send) - digit = *s - '0'; - else - break; - } - if (digit >= 0 && digit <= 9 - && (s < send)) { - /* value overflowed. - skip the remaining digits, don't - worry about setting *valuep. */ - do { - s++; - } while (s < send && isDIGIT(*s)); - numtype |= - IS_NUMBER_GREATER_THAN_UV_MAX; - goto skip_value; - } - } - } - } - } - } - } - } - } - } - } - } - } - } - } - } - } - } - numtype |= IS_NUMBER_IN_UV; - if (valuep) - *valuep = value; - - skip_value: - if (GROK_NUMERIC_RADIX(&s, send)) { - numtype |= IS_NUMBER_NOT_INT; - while (s < send && isDIGIT(*s)) /* optional digits after the radix */ - s++; - } - } - else if (GROK_NUMERIC_RADIX(&s, send)) { - numtype |= IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV; /* valuep assigned below */ - /* no digits before the radix means we need digits after it */ - if (s < send && isDIGIT(*s)) { - do { - s++; - } while (s < send && isDIGIT(*s)); - if (valuep) { - /* integer approximation is valid - it's 0. */ - *valuep = 0; - } - } - else - return 0; - } else if (*s == 'I' || *s == 'i') { - s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; - s++; if (s == send || (*s != 'F' && *s != 'f')) return 0; - s++; if (s < send && (*s == 'I' || *s == 'i')) { - s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; - s++; if (s == send || (*s != 'I' && *s != 'i')) return 0; - s++; if (s == send || (*s != 'T' && *s != 't')) return 0; - s++; if (s == send || (*s != 'Y' && *s != 'y')) return 0; - s++; - } - sawinf = 1; - } else if (*s == 'N' || *s == 'n') { - /* XXX TODO: There are signaling NaNs and quiet NaNs. */ - s++; if (s == send || (*s != 'A' && *s != 'a')) return 0; - s++; if (s == send || (*s != 'N' && *s != 'n')) return 0; - s++; - sawnan = 1; - } else - return 0; - - if (sawinf) { - numtype &= IS_NUMBER_NEG; /* Keep track of sign */ - numtype |= IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT; - } else if (sawnan) { - numtype &= IS_NUMBER_NEG; /* Keep track of sign */ - numtype |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT; - } else if (s < send) { - /* we can have an optional exponent part */ - if (*s == 'e' || *s == 'E') { - /* The only flag we keep is sign. Blow away any "it's UV" */ - numtype &= IS_NUMBER_NEG; - numtype |= IS_NUMBER_NOT_INT; - s++; - if (s < send && (*s == '-' || *s == '+')) - s++; - if (s < send && isDIGIT(*s)) { - do { - s++; - } while (s < send && isDIGIT(*s)); - } - else - return 0; - } - } - while (s < send && isSPACE(*s)) - s++; - if (s >= send) - return numtype; - if (len == 10 && memEQ(pv, "0 but true", 10)) { - if (valuep) - *valuep = 0; - return IS_NUMBER_IN_UV; - } - return 0; -} -#endif -#endif - -/* - * The grok_* routines have been modified to use warn() instead of - * Perl_warner(). Also, 'hexdigit' was the former name of PL_hexdigit, - * which is why the stack variable has been renamed to 'xdigit'. - */ - -#ifndef grok_bin -#if defined(NEED_grok_bin) -static UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); -static -#else -extern UV DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); -#endif - -#ifdef grok_bin -# undef grok_bin -#endif -#define grok_bin(a,b,c,d) DPPP_(my_grok_bin)(aTHX_ a,b,c,d) -#define Perl_grok_bin DPPP_(my_grok_bin) - -#if defined(NEED_grok_bin) || defined(NEED_grok_bin_GLOBAL) -UV -DPPP_(my_grok_bin)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) -{ - const char *s = start; - STRLEN len = *len_p; - UV value = 0; - NV value_nv = 0; - - const UV max_div_2 = UV_MAX / 2; - bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; - bool overflowed = FALSE; - - if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { - /* strip off leading b or 0b. - for compatibility silently suffer "b" and "0b" as valid binary - numbers. */ - if (len >= 1) { - if (s[0] == 'b') { - s++; - len--; - } - else if (len >= 2 && s[0] == '0' && s[1] == 'b') { - s+=2; - len-=2; - } - } - } - - for (; len-- && *s; s++) { - char bit = *s; - if (bit == '0' || bit == '1') { - /* Write it in this wonky order with a goto to attempt to get the - compiler to make the common case integer-only loop pretty tight. - With gcc seems to be much straighter code than old scan_bin. */ - redo: - if (!overflowed) { - if (value <= max_div_2) { - value = (value << 1) | (bit - '0'); - continue; - } - /* Bah. We're just overflowed. */ - warn("Integer overflow in binary number"); - overflowed = TRUE; - value_nv = (NV) value; - } - value_nv *= 2.0; - /* If an NV has not enough bits in its mantissa to - * represent a UV this summing of small low-order numbers - * is a waste of time (because the NV cannot preserve - * the low-order bits anyway): we could just remember when - * did we overflow and in the end just multiply value_nv by the - * right amount. */ - value_nv += (NV)(bit - '0'); - continue; - } - if (bit == '_' && len && allow_underscores && (bit = s[1]) - && (bit == '0' || bit == '1')) - { - --len; - ++s; - goto redo; - } - if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) - warn("Illegal binary digit '%c' ignored", *s); - break; - } - - if ( ( overflowed && value_nv > 4294967295.0) -#if UVSIZE > 4 - || (!overflowed && value > 0xffffffff ) -#endif - ) { - warn("Binary number > 0b11111111111111111111111111111111 non-portable"); - } - *len_p = s - start; - if (!overflowed) { - *flags = 0; - return value; - } - *flags = PERL_SCAN_GREATER_THAN_UV_MAX; - if (result) - *result = value_nv; - return UV_MAX; -} -#endif -#endif - -#ifndef grok_hex -#if defined(NEED_grok_hex) -static UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); -static -#else -extern UV DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); -#endif - -#ifdef grok_hex -# undef grok_hex -#endif -#define grok_hex(a,b,c,d) DPPP_(my_grok_hex)(aTHX_ a,b,c,d) -#define Perl_grok_hex DPPP_(my_grok_hex) - -#if defined(NEED_grok_hex) || defined(NEED_grok_hex_GLOBAL) -UV -DPPP_(my_grok_hex)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) -{ - const char *s = start; - STRLEN len = *len_p; - UV value = 0; - NV value_nv = 0; - - const UV max_div_16 = UV_MAX / 16; - bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; - bool overflowed = FALSE; - const char *xdigit; - - if (!(*flags & PERL_SCAN_DISALLOW_PREFIX)) { - /* strip off leading x or 0x. - for compatibility silently suffer "x" and "0x" as valid hex numbers. - */ - if (len >= 1) { - if (s[0] == 'x') { - s++; - len--; - } - else if (len >= 2 && s[0] == '0' && s[1] == 'x') { - s+=2; - len-=2; - } - } - } - - for (; len-- && *s; s++) { - xdigit = strchr((char *) PL_hexdigit, *s); - if (xdigit) { - /* Write it in this wonky order with a goto to attempt to get the - compiler to make the common case integer-only loop pretty tight. - With gcc seems to be much straighter code than old scan_hex. */ - redo: - if (!overflowed) { - if (value <= max_div_16) { - value = (value << 4) | ((xdigit - PL_hexdigit) & 15); - continue; - } - warn("Integer overflow in hexadecimal number"); - overflowed = TRUE; - value_nv = (NV) value; - } - value_nv *= 16.0; - /* If an NV has not enough bits in its mantissa to - * represent a UV this summing of small low-order numbers - * is a waste of time (because the NV cannot preserve - * the low-order bits anyway): we could just remember when - * did we overflow and in the end just multiply value_nv by the - * right amount of 16-tuples. */ - value_nv += (NV)((xdigit - PL_hexdigit) & 15); - continue; - } - if (*s == '_' && len && allow_underscores && s[1] - && (xdigit = strchr((char *) PL_hexdigit, s[1]))) - { - --len; - ++s; - goto redo; - } - if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) - warn("Illegal hexadecimal digit '%c' ignored", *s); - break; - } - - if ( ( overflowed && value_nv > 4294967295.0) -#if UVSIZE > 4 - || (!overflowed && value > 0xffffffff ) -#endif - ) { - warn("Hexadecimal number > 0xffffffff non-portable"); - } - *len_p = s - start; - if (!overflowed) { - *flags = 0; - return value; - } - *flags = PERL_SCAN_GREATER_THAN_UV_MAX; - if (result) - *result = value_nv; - return UV_MAX; -} -#endif -#endif - -#ifndef grok_oct -#if defined(NEED_grok_oct) -static UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); -static -#else -extern UV DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result); -#endif - -#ifdef grok_oct -# undef grok_oct -#endif -#define grok_oct(a,b,c,d) DPPP_(my_grok_oct)(aTHX_ a,b,c,d) -#define Perl_grok_oct DPPP_(my_grok_oct) - -#if defined(NEED_grok_oct) || defined(NEED_grok_oct_GLOBAL) -UV -DPPP_(my_grok_oct)(pTHX_ char *start, STRLEN *len_p, I32 *flags, NV *result) -{ - const char *s = start; - STRLEN len = *len_p; - UV value = 0; - NV value_nv = 0; - - const UV max_div_8 = UV_MAX / 8; - bool allow_underscores = *flags & PERL_SCAN_ALLOW_UNDERSCORES; - bool overflowed = FALSE; - - for (; len-- && *s; s++) { - /* gcc 2.95 optimiser not smart enough to figure that this subtraction - out front allows slicker code. */ - int digit = *s - '0'; - if (digit >= 0 && digit <= 7) { - /* Write it in this wonky order with a goto to attempt to get the - compiler to make the common case integer-only loop pretty tight. - */ - redo: - if (!overflowed) { - if (value <= max_div_8) { - value = (value << 3) | digit; - continue; - } - /* Bah. We're just overflowed. */ - warn("Integer overflow in octal number"); - overflowed = TRUE; - value_nv = (NV) value; - } - value_nv *= 8.0; - /* If an NV has not enough bits in its mantissa to - * represent a UV this summing of small low-order numbers - * is a waste of time (because the NV cannot preserve - * the low-order bits anyway): we could just remember when - * did we overflow and in the end just multiply value_nv by the - * right amount of 8-tuples. */ - value_nv += (NV)digit; - continue; - } - if (digit == ('_' - '0') && len && allow_underscores - && (digit = s[1] - '0') && (digit >= 0 && digit <= 7)) - { - --len; - ++s; - goto redo; - } - /* Allow \octal to work the DWIM way (that is, stop scanning - * as soon as non-octal characters are seen, complain only iff - * someone seems to want to use the digits eight and nine). */ - if (digit == 8 || digit == 9) { - if (!(*flags & PERL_SCAN_SILENT_ILLDIGIT)) - warn("Illegal octal digit '%c' ignored", *s); - } - break; - } - - if ( ( overflowed && value_nv > 4294967295.0) -#if UVSIZE > 4 - || (!overflowed && value > 0xffffffff ) -#endif - ) { - warn("Octal number > 037777777777 non-portable"); - } - *len_p = s - start; - if (!overflowed) { - *flags = 0; - return value; - } - *flags = PERL_SCAN_GREATER_THAN_UV_MAX; - if (result) - *result = value_nv; - return UV_MAX; -} -#endif -#endif - -#if !defined(my_snprintf) -#if defined(NEED_my_snprintf) -static int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...); -static -#else -extern int DPPP_(my_my_snprintf)(char * buffer, const Size_t len, const char * format, ...); -#endif - -#define my_snprintf DPPP_(my_my_snprintf) -#define Perl_my_snprintf DPPP_(my_my_snprintf) - -#if defined(NEED_my_snprintf) || defined(NEED_my_snprintf_GLOBAL) - -int -DPPP_(my_my_snprintf)(char *buffer, const Size_t len, const char *format, ...) -{ - dTHX; - int retval; - va_list ap; - va_start(ap, format); -#ifdef HAS_VSNPRINTF - retval = vsnprintf(buffer, len, format, ap); -#else - retval = vsprintf(buffer, format, ap); -#endif - va_end(ap); - if (retval >= (int)len) - Perl_croak(aTHX_ "panic: my_snprintf buffer overflow"); - return retval; -} - -#endif -#endif - -#ifdef NO_XSLOCKS -# ifdef dJMPENV -# define dXCPT dJMPENV; int rEtV = 0 -# define XCPT_TRY_START JMPENV_PUSH(rEtV); if (rEtV == 0) -# define XCPT_TRY_END JMPENV_POP; -# define XCPT_CATCH if (rEtV != 0) -# define XCPT_RETHROW JMPENV_JUMP(rEtV) -# else -# define dXCPT Sigjmp_buf oldTOP; int rEtV = 0 -# define XCPT_TRY_START Copy(top_env, oldTOP, 1, Sigjmp_buf); rEtV = Sigsetjmp(top_env, 1); if (rEtV == 0) -# define XCPT_TRY_END Copy(oldTOP, top_env, 1, Sigjmp_buf); -# define XCPT_CATCH if (rEtV != 0) -# define XCPT_RETHROW Siglongjmp(top_env, rEtV) -# endif -#endif - -#endif /* _P_P_PORTABILITY_H_ */ - -/* End of File ppport.h */ diff --git a/ext/Devel/PPPort/PPPort.xs b/ext/Devel/PPPort/PPPort.xs deleted file mode 100644 index 4757b561fc..0000000000 --- a/ext/Devel/PPPort/PPPort.xs +++ /dev/null @@ -1,1281 +0,0 @@ -/******************************************************************************* -* -* !!!!! Do NOT edit this file directly! -- Edit PPPort_xs.PL instead. !!!!! -* -******************************************************************************** -* -* Perl/Pollution/Portability -* -******************************************************************************** -* -* $Revision: 9 $ -* $Author: mhx $ -* $Date: 2006/01/14 18:07:55 +0100 $ -* -******************************************************************************** -* -* Version 3.x, Copyright (C) 2004-2006, Marcus Holland-Moritz. -* Version 2.x, Copyright (C) 2001, Paul Marquess. -* Version 1.x, Copyright (C) 1999, Kenneth Albanowski. -* -* This program is free software; you can redistribute it and/or -* modify it under the same terms as Perl itself. -* -*******************************************************************************/ - -/* ========== BEGIN XSHEAD ================================================== */ - - - -/* =========== END XSHEAD =================================================== */ - -#include "EXTERN.h" -#include "perl.h" -#include "XSUB.h" - -/* ========== BEGIN XSINIT ================================================== */ - -/* ---- from parts/inc/call ---- */ -#define NEED_eval_pv - -/* ---- from parts/inc/grok ---- */ -#define NEED_grok_number -#define NEED_grok_numeric_radix -#define NEED_grok_bin -#define NEED_grok_hex -#define NEED_grok_oct - -/* ---- from parts/inc/newCONSTSUB ---- */ -#define NEED_newCONSTSUB - -/* ---- from parts/inc/newRV ---- */ -#define NEED_newRV_noinc - -/* ---- from parts/inc/snprintf ---- */ -#define NEED_my_snprintf - -/* ---- from parts/inc/sv_xpvf ---- */ -#define NEED_vnewSVpvf -#define NEED_sv_catpvf_mg -#define NEED_sv_catpvf_mg_nocontext -#define NEED_sv_setpvf_mg -#define NEED_sv_setpvf_mg_nocontext - -/* ---- from parts/inc/SvPV ---- */ -#define NEED_sv_2pv_nolen -#define NEED_sv_2pvbyte - -/* ---- from parts/inc/variables ---- */ -#define NEED_PL_signals - -/* ---- from parts/inc/warn ---- */ -#define NEED_warner - -/* =========== END XSINIT =================================================== */ - -#include "ppport.h" - -/* ========== BEGIN XSMISC ================================================== */ - -/* ---- from parts/inc/exception ---- */ -/* defined in module3.c */ -int exception(int throw_e); - -/* ---- from parts/inc/misc ---- */ -XS(XS_Devel__PPPort_dXSTARG); /* prototype */ -XS(XS_Devel__PPPort_dXSTARG) -{ - dXSARGS; - dXSTARG; - IV iv; - SP -= items; - iv = SvIV(ST(0)) + 1; - PUSHi(iv); - XSRETURN(1); -} - -XS(XS_Devel__PPPort_dAXMARK); /* prototype */ -XS(XS_Devel__PPPort_dAXMARK) -{ - dSP; - dAXMARK; - dITEMS; - IV iv; - SP -= items; - iv = SvIV(ST(0)) - 1; - PUSHs(sv_2mortal(newSViv(iv))); - XSRETURN(1); -} - -/* ---- from parts/inc/MY_CXT ---- */ -#define MY_CXT_KEY "Devel::PPPort::_guts" XS_VERSION - -typedef struct { - /* Put Global Data in here */ - int dummy; -} my_cxt_t; - -START_MY_CXT - -/* ---- from parts/inc/newCONSTSUB ---- */ -void call_newCONSTSUB_1(void) -{ -#ifdef PERL_NO_GET_CONTEXT - dTHX; -#endif - newCONSTSUB(gv_stashpv("Devel::PPPort", FALSE), "test_value_1", newSViv(1)); -} - -extern void call_newCONSTSUB_2(void); -extern void call_newCONSTSUB_3(void); - -/* ---- from parts/inc/sv_xpvf ---- */ -static SV * test_vnewSVpvf(pTHX_ const char *pat, ...) -{ - SV *sv; - va_list args; - va_start(args, pat); -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) - sv = vnewSVpvf(pat, &args); -#else - sv = newSVpv(pat, 0); -#endif - va_end(args); - return sv; -} - -static void test_sv_vcatpvf(pTHX_ SV *sv, const char *pat, ...) -{ - va_list args; - va_start(args, pat); -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) - sv_vcatpvf(sv, pat, &args); -#else - sv_catpv(sv, pat); -#endif - va_end(args); -} - -static void test_sv_vsetpvf(pTHX_ SV *sv, const char *pat, ...) -{ - va_list args; - va_start(args, pat); -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) - sv_vsetpvf(sv, pat, &args); -#else - sv_setpv(sv, pat); -#endif - va_end(args); -} - -/* ---- from parts/inc/variables ---- */ -U32 get_PL_signals_1(void) -{ - return PL_signals; -} - -extern U32 get_PL_signals_2(void); -extern U32 get_PL_signals_3(void); - -/* =========== END XSMISC =================================================== */ - -MODULE = Devel::PPPort PACKAGE = Devel::PPPort - -BOOT: - /* ---- from parts/inc/misc ---- */ - newXS("Devel::PPPort::dXSTARG", XS_Devel__PPPort_dXSTARG, file); - newXS("Devel::PPPort::dAXMARK", XS_Devel__PPPort_dAXMARK, file); - - /* ---- from parts/inc/MY_CXT ---- */ - { - MY_CXT_INIT; - /* If any of the fields in the my_cxt_t struct need - * to be initialised, do it here. - */ - MY_CXT.dummy = 42; - } - - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/call -##---------------------------------------------------------------------- - -I32 -G_SCALAR() - CODE: - RETVAL = G_SCALAR; - OUTPUT: - RETVAL - -I32 -G_ARRAY() - CODE: - RETVAL = G_ARRAY; - OUTPUT: - RETVAL - -I32 -G_DISCARD() - CODE: - RETVAL = G_DISCARD; - OUTPUT: - RETVAL - -void -eval_sv(sv, flags) - SV* sv - I32 flags - PREINIT: - I32 i; - PPCODE: - PUTBACK; - i = eval_sv(sv, flags); - SPAGAIN; - EXTEND(SP, 1); - PUSHs(sv_2mortal(newSViv(i))); - -void -eval_pv(p, croak_on_error) - char* p - I32 croak_on_error - PPCODE: - PUTBACK; - EXTEND(SP, 1); - PUSHs(eval_pv(p, croak_on_error)); - -void -call_sv(sv, flags, ...) - SV* sv - I32 flags - PREINIT: - I32 i; - PPCODE: - for (i=0; i<items-2; i++) - ST(i) = ST(i+2); /* pop first two args */ - PUSHMARK(SP); - SP += items - 2; - PUTBACK; - i = call_sv(sv, flags); - SPAGAIN; - EXTEND(SP, 1); - PUSHs(sv_2mortal(newSViv(i))); - -void -call_pv(subname, flags, ...) - char* subname - I32 flags - PREINIT: - I32 i; - PPCODE: - for (i=0; i<items-2; i++) - ST(i) = ST(i+2); /* pop first two args */ - PUSHMARK(SP); - SP += items - 2; - PUTBACK; - i = call_pv(subname, flags); - SPAGAIN; - EXTEND(SP, 1); - PUSHs(sv_2mortal(newSViv(i))); - -void -call_argv(subname, flags, ...) - char* subname - I32 flags - PREINIT: - I32 i; - char *args[8]; - PPCODE: - if (items > 8) /* play safe */ - XSRETURN_UNDEF; - for (i=2; i<items; i++) - args[i-2] = SvPV_nolen(ST(i)); - args[items-2] = NULL; - PUTBACK; - i = call_argv(subname, flags, args); - SPAGAIN; - EXTEND(SP, 1); - PUSHs(sv_2mortal(newSViv(i))); - -void -call_method(methname, flags, ...) - char* methname - I32 flags - PREINIT: - I32 i; - PPCODE: - for (i=0; i<items-2; i++) - ST(i) = ST(i+2); /* pop first two args */ - PUSHMARK(SP); - SP += items - 2; - PUTBACK; - i = call_method(methname, flags); - SPAGAIN; - EXTEND(SP, 1); - PUSHs(sv_2mortal(newSViv(i))); - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/cop -##---------------------------------------------------------------------- - -char * -CopSTASHPV() - CODE: - RETVAL = CopSTASHPV(PL_curcop); - OUTPUT: - RETVAL - -char * -CopFILE() - CODE: - RETVAL = CopFILE(PL_curcop); - OUTPUT: - RETVAL - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/exception -##---------------------------------------------------------------------- - -int -exception(throw_e) - int throw_e - OUTPUT: - RETVAL - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/grok -##---------------------------------------------------------------------- - -UV -grok_number(string) - SV *string - PREINIT: - const char *pv; - STRLEN len; - CODE: - pv = SvPV(string, len); - if (!grok_number(pv, len, &RETVAL)) - XSRETURN_UNDEF; - OUTPUT: - RETVAL - -UV -grok_bin(string) - SV *string - PREINIT: - char *pv; - I32 flags; - STRLEN len; - CODE: - pv = SvPV(string, len); - RETVAL = grok_bin(pv, &len, &flags, NULL); - OUTPUT: - RETVAL - -UV -grok_hex(string) - SV *string - PREINIT: - char *pv; - I32 flags; - STRLEN len; - CODE: - pv = SvPV(string, len); - RETVAL = grok_hex(pv, &len, &flags, NULL); - OUTPUT: - RETVAL - -UV -grok_oct(string) - SV *string - PREINIT: - char *pv; - I32 flags; - STRLEN len; - CODE: - pv = SvPV(string, len); - RETVAL = grok_oct(pv, &len, &flags, NULL); - OUTPUT: - RETVAL - -UV -Perl_grok_number(string) - SV *string - PREINIT: - const char *pv; - STRLEN len; - CODE: - pv = SvPV(string, len); - if (!Perl_grok_number(aTHX_ pv, len, &RETVAL)) - XSRETURN_UNDEF; - OUTPUT: - RETVAL - -UV -Perl_grok_bin(string) - SV *string - PREINIT: - char *pv; - I32 flags; - STRLEN len; - CODE: - pv = SvPV(string, len); - RETVAL = Perl_grok_bin(aTHX_ pv, &len, &flags, NULL); - OUTPUT: - RETVAL - -UV -Perl_grok_hex(string) - SV *string - PREINIT: - char *pv; - I32 flags; - STRLEN len; - CODE: - pv = SvPV(string, len); - RETVAL = Perl_grok_hex(aTHX_ pv, &len, &flags, NULL); - OUTPUT: - RETVAL - -UV -Perl_grok_oct(string) - SV *string - PREINIT: - char *pv; - I32 flags; - STRLEN len; - CODE: - pv = SvPV(string, len); - RETVAL = Perl_grok_oct(aTHX_ pv, &len, &flags, NULL); - OUTPUT: - RETVAL - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/limits -##---------------------------------------------------------------------- - -IV -iv_size() - CODE: - RETVAL = IVSIZE == sizeof(IV); - OUTPUT: - RETVAL - -IV -uv_size() - CODE: - RETVAL = UVSIZE == sizeof(UV); - OUTPUT: - RETVAL - -IV -iv_type() - CODE: - RETVAL = sizeof(IVTYPE) == sizeof(IV); - OUTPUT: - RETVAL - -IV -uv_type() - CODE: - RETVAL = sizeof(UVTYPE) == sizeof(UV); - OUTPUT: - RETVAL - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/magic -##---------------------------------------------------------------------- - -void -sv_catpv_mg(sv, string) - SV *sv; - char *string; - CODE: - sv_catpv_mg(sv, string); - -void -sv_catpvn_mg(sv, sv2) - SV *sv; - SV *sv2; - PREINIT: - char *str; - STRLEN len; - CODE: - str = SvPV(sv2, len); - sv_catpvn_mg(sv, str, len); - -void -sv_catsv_mg(sv, sv2) - SV *sv; - SV *sv2; - CODE: - sv_catsv_mg(sv, sv2); - -void -sv_setiv_mg(sv, iv) - SV *sv; - IV iv; - CODE: - sv_setiv_mg(sv, iv); - -void -sv_setnv_mg(sv, nv) - SV *sv; - NV nv; - CODE: - sv_setnv_mg(sv, nv); - -void -sv_setpv_mg(sv, pv) - SV *sv; - char *pv; - CODE: - sv_setpv_mg(sv, pv); - -void -sv_setpvn_mg(sv, sv2) - SV *sv; - SV *sv2; - PREINIT: - char *str; - STRLEN len; - CODE: - str = SvPV(sv2, len); - sv_setpvn_mg(sv, str, len); - -void -sv_setsv_mg(sv, sv2) - SV *sv; - SV *sv2; - CODE: - sv_setsv_mg(sv, sv2); - -void -sv_setuv_mg(sv, uv) - SV *sv; - UV uv; - CODE: - sv_setuv_mg(sv, uv); - -void -sv_usepvn_mg(sv, sv2) - SV *sv; - SV *sv2; - PREINIT: - char *str, *copy; - STRLEN len; - CODE: - str = SvPV(sv2, len); - New(42, copy, len+1, char); - Copy(str, copy, len+1, char); - sv_usepvn_mg(sv, copy, len); - -int -SvVSTRING_mg(sv) - SV *sv; - CODE: - RETVAL = SvVSTRING_mg(sv) != NULL; - OUTPUT: - RETVAL - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/memory -##---------------------------------------------------------------------- - -int -checkmem() - PREINIT: - char *p; - - CODE: - RETVAL = 0; - Newx(p, 6, char); - CopyD("Hello", p, 6, char); - if (memEQ(p, "Hello", 6)) - RETVAL++; - ZeroD(p, 6, char); - if (memEQ(p, "\0\0\0\0\0\0", 6)) - RETVAL++; - Poison(p, 6, char); - if (memNE(p, "\0\0\0\0\0\0", 6)) - RETVAL++; - Safefree(p); - - Newxz(p, 6, char); - if (memEQ(p, "\0\0\0\0\0\0", 6)) - RETVAL++; - Safefree(p); - - Newxc(p, 3, short, char); - Safefree(p); - - OUTPUT: - RETVAL - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/misc -##---------------------------------------------------------------------- - -int -gv_stashpvn(name, create) - char *name - I32 create - CODE: - RETVAL = gv_stashpvn(name, strlen(name), create) != NULL; - OUTPUT: - RETVAL - -int -get_sv(name, create) - char *name - I32 create - CODE: - RETVAL = get_sv(name, create) != NULL; - OUTPUT: - RETVAL - -int -get_av(name, create) - char *name - I32 create - CODE: - RETVAL = get_av(name, create) != NULL; - OUTPUT: - RETVAL - -int -get_hv(name, create) - char *name - I32 create - CODE: - RETVAL = get_hv(name, create) != NULL; - OUTPUT: - RETVAL - -int -get_cv(name, create) - char *name - I32 create - CODE: - RETVAL = get_cv(name, create) != NULL; - OUTPUT: - RETVAL - -void -newSVpvn() - PPCODE: - XPUSHs(newSVpvn("test", 4)); - XPUSHs(newSVpvn("test", 2)); - XPUSHs(newSVpvn("test", 0)); - XPUSHs(newSVpvn(NULL, 2)); - XPUSHs(newSVpvn(NULL, 0)); - XSRETURN(5); - -void -xsreturn(two) - int two - PPCODE: - XPUSHs(newSVpvn("test1", 5)); - if (two) - XPUSHs(newSVpvn("test2", 5)); - if (two) - XSRETURN(2); - else - XSRETURN(1); - -SV * -PL_sv_undef() - CODE: - RETVAL = newSVsv(&PL_sv_undef); - OUTPUT: - RETVAL - -SV * -PL_sv_yes() - CODE: - RETVAL = newSVsv(&PL_sv_yes); - OUTPUT: - RETVAL - -SV * -PL_sv_no() - CODE: - RETVAL = newSVsv(&PL_sv_no); - OUTPUT: - RETVAL - -int -PL_na(string) - char *string - CODE: - PL_na = strlen(string); - RETVAL = PL_na; - OUTPUT: - RETVAL - -SV* -boolSV(value) - int value - CODE: - RETVAL = newSVsv(boolSV(value)); - OUTPUT: - RETVAL - -SV* -DEFSV() - CODE: - RETVAL = newSVsv(DEFSV); - OUTPUT: - RETVAL - -int -ERRSV() - CODE: - RETVAL = SvTRUE(ERRSV); - OUTPUT: - RETVAL - -SV* -UNDERBAR() - CODE: - { - dUNDERBAR; - RETVAL = newSVsv(UNDERBAR); - } - OUTPUT: - RETVAL - -void -prepush() - CODE: - { - dXSTARG; - XSprePUSH; - PUSHi(42); - XSRETURN(1); - } - -int -PERL_ABS(a) - int a - -void -SVf(x) - SV *x - PPCODE: -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) - x = newSVpvf("[%"SVf"]", x); -#endif - XPUSHs(x); - XSRETURN(1); - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/mPUSH -##---------------------------------------------------------------------- - -void -mPUSHp() - PPCODE: - EXTEND(SP, 3); - mPUSHp("one", 3); - mPUSHp("two", 3); - mPUSHp("three", 5); - XSRETURN(3); - -void -mPUSHn() - PPCODE: - EXTEND(SP, 3); - mPUSHn(0.5); - mPUSHn(-0.25); - mPUSHn(0.125); - XSRETURN(3); - -void -mPUSHi() - PPCODE: - EXTEND(SP, 3); - mPUSHi(-1); - mPUSHi(2); - mPUSHi(-3); - XSRETURN(3); - -void -mPUSHu() - PPCODE: - EXTEND(SP, 3); - mPUSHu(1); - mPUSHu(2); - mPUSHu(3); - XSRETURN(3); - -void -mXPUSHp() - PPCODE: - mXPUSHp("one", 3); - mXPUSHp("two", 3); - mXPUSHp("three", 5); - XSRETURN(3); - -void -mXPUSHn() - PPCODE: - mXPUSHn(0.5); - mXPUSHn(-0.25); - mXPUSHn(0.125); - XSRETURN(3); - -void -mXPUSHi() - PPCODE: - mXPUSHi(-1); - mXPUSHi(2); - mXPUSHi(-3); - XSRETURN(3); - -void -mXPUSHu() - PPCODE: - mXPUSHu(1); - mXPUSHu(2); - mXPUSHu(3); - XSRETURN(3); - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/MY_CXT -##---------------------------------------------------------------------- - -int -MY_CXT_1() - CODE: - dMY_CXT; - RETVAL = MY_CXT.dummy == 42; - ++MY_CXT.dummy; - OUTPUT: - RETVAL - -int -MY_CXT_2() - CODE: - dMY_CXT; - RETVAL = MY_CXT.dummy == 43; - OUTPUT: - RETVAL - -int -MY_CXT_CLONE() - CODE: - MY_CXT_CLONE; - RETVAL = 42; - OUTPUT: - RETVAL - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/newCONSTSUB -##---------------------------------------------------------------------- - -void -call_newCONSTSUB_1() - -void -call_newCONSTSUB_2() - -void -call_newCONSTSUB_3() - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/newRV -##---------------------------------------------------------------------- - -U32 -newRV_inc_REFCNT() - PREINIT: - SV *sv, *rv; - CODE: - sv = newSViv(42); - rv = newRV_inc(sv); - SvREFCNT_dec(sv); - RETVAL = SvREFCNT(sv); - sv_2mortal(rv); - OUTPUT: - RETVAL - -U32 -newRV_noinc_REFCNT() - PREINIT: - SV *sv, *rv; - CODE: - sv = newSViv(42); - rv = newRV_noinc(sv); - RETVAL = SvREFCNT(sv); - sv_2mortal(rv); - OUTPUT: - RETVAL - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/pvs -##---------------------------------------------------------------------- - -void -newSVpvs() - PPCODE: - XPUSHs(newSVpvs("newSVpvs")); - XSRETURN(1); - -void -sv_catpvs(sv) - SV *sv - PPCODE: - sv_catpvs(sv, "sv_catpvs"); - -void -sv_setpvs(sv) - SV *sv - PPCODE: - sv_setpvs(sv, "sv_setpvs"); - -void -hv_fetchs(hv) - SV *hv - PREINIT: - SV **s; - PPCODE: - s = hv_fetchs((HV *) SvRV(hv), "hv_fetchs", 0); - XPUSHs(sv_mortalcopy(*s)); - XSRETURN(1); - -void -hv_stores(hv, sv) - SV *hv - SV *sv - PPCODE: - hv_stores((HV *) SvRV(hv), "hv_stores", SvREFCNT_inc(sv)); - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/snprintf -##---------------------------------------------------------------------- - -void -my_snprintf() - PREINIT: - char buf[128]; - int len; - PPCODE: - len = my_snprintf(buf, sizeof buf, "foo%s%d", "bar", 42); - XPUSHs(newSViv(len)); - XPUSHs(newSVpv(buf, 0)); - XSRETURN(2); - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/Sv_set -##---------------------------------------------------------------------- - -IV -TestSvUV_set(sv, val) - SV *sv - UV val - CODE: - SvUV_set(sv, val); - RETVAL = SvUVX(sv) == val ? 42 : -1; - OUTPUT: - RETVAL - -IV -TestSvPVX_const(sv) - SV *sv - CODE: - RETVAL = strEQ(SvPVX_const(sv), "mhx") ? 43 : -1; - OUTPUT: - RETVAL - -IV -TestSvPVX_mutable(sv) - SV *sv - CODE: - RETVAL = strEQ(SvPVX_mutable(sv), "mhx") ? 44 : -1; - OUTPUT: - RETVAL - -void -TestSvSTASH_set(sv, name) - SV *sv - char *name - CODE: - sv = SvRV(sv); - SvREFCNT_dec(SvSTASH(sv)); - SvSTASH_set(sv, (HV*) SvREFCNT_inc(gv_stashpv(name, 0))); - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/sv_xpvf -##---------------------------------------------------------------------- - -SV * -vnewSVpvf() - CODE: - RETVAL = test_vnewSVpvf(aTHX_ "%s-%d", "Perl", 42); - OUTPUT: - RETVAL - -SV * -sv_vcatpvf(sv) - SV *sv - CODE: - RETVAL = newSVsv(sv); - test_sv_vcatpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42); - OUTPUT: - RETVAL - -SV * -sv_vsetpvf(sv) - SV *sv - CODE: - RETVAL = newSVsv(sv); - test_sv_vsetpvf(aTHX_ RETVAL, "%s-%d", "Perl", 42); - OUTPUT: - RETVAL - -void -sv_catpvf_mg(sv) - SV *sv - CODE: -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) - sv_catpvf_mg(sv, "%s-%d", "Perl", 42); -#endif - -void -Perl_sv_catpvf_mg(sv) - SV *sv - CODE: -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) - Perl_sv_catpvf_mg(aTHX_ sv, "%s-%d", "-Perl", 43); -#endif - -void -sv_catpvf_mg_nocontext(sv) - SV *sv - CODE: -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) -#ifdef PERL_IMPLICIT_CONTEXT - sv_catpvf_mg_nocontext(sv, "%s-%d", "-Perl", 44); -#else - sv_catpvf_mg(sv, "%s-%d", "-Perl", 44); -#endif -#endif - -void -sv_setpvf_mg(sv) - SV *sv - CODE: -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) - sv_setpvf_mg(sv, "%s-%d", "mhx", 42); -#endif - -void -Perl_sv_setpvf_mg(sv) - SV *sv - CODE: -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) - Perl_sv_setpvf_mg(aTHX_ sv, "%s-%d", "foo", 43); -#endif - -void -sv_setpvf_mg_nocontext(sv) - SV *sv - CODE: -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) -#ifdef PERL_IMPLICIT_CONTEXT - sv_setpvf_mg_nocontext(sv, "%s-%d", "bar", 44); -#else - sv_setpvf_mg(sv, "%s-%d", "bar", 44); -#endif -#endif - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/SvPV -##---------------------------------------------------------------------- - -IV -SvPVbyte(sv) - SV *sv - PREINIT: - STRLEN len; - const char *str; - CODE: - str = SvPVbyte(sv, len); - RETVAL = strEQ(str, "mhx") ? (IV) len : (IV) -1; - OUTPUT: - RETVAL - -IV -SvPV_nolen(sv) - SV *sv - PREINIT: - const char *str; - CODE: - str = SvPV_nolen(sv); - RETVAL = strEQ(str, "mhx") ? 42 : 0; - OUTPUT: - RETVAL - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/SvREFCNT -##---------------------------------------------------------------------- - -void -SvREFCNT() - PREINIT: - SV *sv, *svr; - PPCODE: - sv = newSV(0); - XPUSHs(newSViv(SvREFCNT(sv) == 1)); - svr = SvREFCNT_inc(sv); - XPUSHs(newSViv(sv == svr)); - XPUSHs(newSViv(SvREFCNT(sv) == 2)); - svr = SvREFCNT_inc_simple(sv); - XPUSHs(newSViv(sv == svr)); - XPUSHs(newSViv(SvREFCNT(sv) == 3)); - svr = SvREFCNT_inc_NN(sv); - XPUSHs(newSViv(sv == svr)); - XPUSHs(newSViv(SvREFCNT(sv) == 4)); - svr = SvREFCNT_inc_simple_NN(sv); - XPUSHs(newSViv(sv == svr)); - XPUSHs(newSViv(SvREFCNT(sv) == 5)); - SvREFCNT_inc_void(sv); - XPUSHs(newSViv(SvREFCNT(sv) == 6)); - SvREFCNT_inc_simple_void(sv); - XPUSHs(newSViv(SvREFCNT(sv) == 7)); - SvREFCNT_inc_void_NN(sv); - XPUSHs(newSViv(SvREFCNT(sv) == 8)); - SvREFCNT_inc_simple_void_NN(sv); - XPUSHs(newSViv(SvREFCNT(sv) == 9)); - while (SvREFCNT(sv) > 1) - SvREFCNT_dec(sv); - XPUSHs(newSViv(SvREFCNT(sv) == 1)); - SvREFCNT_dec(sv); - XSRETURN(14); - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/threads -##---------------------------------------------------------------------- - -IV -no_THX_arg(sv) - SV *sv - CODE: - RETVAL = 1 + sv_2iv(sv); - OUTPUT: - RETVAL - -void -with_THX_arg(error) - char *error - PPCODE: - Perl_croak(aTHX_ "%s", error); - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/uv -##---------------------------------------------------------------------- - -SV * -sv_setuv(uv) - UV uv - CODE: - RETVAL = newSViv(1); - sv_setuv(RETVAL, uv); - OUTPUT: - RETVAL - -SV * -newSVuv(uv) - UV uv - CODE: - RETVAL = newSVuv(uv); - OUTPUT: - RETVAL - -UV -sv_2uv(sv) - SV *sv - CODE: - RETVAL = sv_2uv(sv); - OUTPUT: - RETVAL - -UV -SvUVx(sv) - SV *sv - CODE: - sv--; - RETVAL = SvUVx(++sv); - OUTPUT: - RETVAL - -void -XSRETURN_UV() - PPCODE: - XSRETURN_UV(42); - -void -PUSHu() - PREINIT: - dTARG; - PPCODE: - TARG = sv_newmortal(); - EXTEND(SP, 1); - PUSHu(42); - XSRETURN(1); - -void -XPUSHu() - PREINIT: - dTARG; - PPCODE: - TARG = sv_newmortal(); - XPUSHu(43); - XSRETURN(1); - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/variables -##---------------------------------------------------------------------- - -int -compare_PL_signals() - CODE: - { - U32 ref = get_PL_signals_1(); - RETVAL = ref == get_PL_signals_2() && ref == get_PL_signals_3(); - } - OUTPUT: - RETVAL - -##---------------------------------------------------------------------- -## XSUBs from parts/inc/warn -##---------------------------------------------------------------------- - -void -warner() - CODE: -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) - warner(packWARN(WARN_MISC), "warner %s:%d", "bar", 42); -#endif - -void -Perl_warner() - CODE: -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) - Perl_warner(aTHX_ packWARN(WARN_MISC), "Perl_warner %s:%d", "bar", 42); -#endif - -void -Perl_warner_nocontext() - CODE: -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) - Perl_warner_nocontext(packWARN(WARN_MISC), "Perl_warner_nocontext %s:%d", "bar", 42); -#endif - -void -ckWARN() - CODE: -#if ((PERL_VERSION > 4) || ((PERL_VERSION == 4) && (PERL_SUBVERSION >= 0))) - if (ckWARN(WARN_MISC)) - Perl_warner_nocontext(packWARN(WARN_MISC), "ckWARN %s:%d", "bar", 42); -#endif diff --git a/ext/Devel/PPPort/PPPort_pm.PL b/ext/Devel/PPPort/PPPort_pm.PL index 2f81cb647f..91a81f3d20 100644 --- a/ext/Devel/PPPort/PPPort_pm.PL +++ b/ext/Devel/PPPort/PPPort_pm.PL @@ -4,9 +4,9 @@ # ################################################################################ # -# $Revision: 44 $ +# $Revision: 45 $ # $Author: mhx $ -# $Date: 2006/05/22 20:28:47 +0200 $ +# $Date: 2006/06/23 15:43:09 +0200 $ # ################################################################################ # @@ -335,9 +335,9 @@ __DATA__ # ################################################################################ # -# $Revision: 44 $ +# $Revision: 45 $ # $Author: mhx $ -# $Date: 2006/05/22 20:28:47 +0200 $ +# $Date: 2006/06/23 15:43:09 +0200 $ # ################################################################################ # @@ -495,15 +495,18 @@ See L<h2xs>, L<ppport.h>. package Devel::PPPort; -require DynaLoader; use strict; use vars qw($VERSION @ISA $data); -$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_04 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; +$VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_05 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; -@ISA = qw(DynaLoader); +# we don't care if the XS cannot be loaded, it's only needed for tests -bootstrap Devel::PPPort; +eval { + require DynaLoader; + @ISA = qw(DynaLoader); + bootstrap Devel::PPPort; +}; sub _init_data { diff --git a/ext/Devel/PPPort/soak b/ext/Devel/PPPort/soak index fe2933a585..8066b5f349 100644 --- a/ext/Devel/PPPort/soak +++ b/ext/Devel/PPPort/soak @@ -33,7 +33,7 @@ use File::Find; use List::Util qw(max); use Config; -my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_04 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; +my $VERSION = do { my @r = '$Snapshot: /Devel-PPPort/3.08_05 $' =~ /(\d+\.\d+(?:_\d+)?)/; @r ? $r[0] : '9.99' }; $| = 1; my $verbose = 0; |