X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/ca8b95d7953a6d52ffd20ab9d0daa5dfa007bb3d..d5ed3fc2756cd318f64c675b743bcb0db642e60b:/mathoms.c diff --git a/mathoms.c b/mathoms.c index 18dcea4..9a7e3ff 100644 --- a/mathoms.c +++ b/mathoms.c @@ -1,6 +1,7 @@ /* mathoms.c * - * Copyright (C) 2005, 2006, 2007, 2008 by Larry Wall and others + * Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, + * 2011, 2012 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -25,6 +26,8 @@ * * SMP - Oct. 24, 2005 * + * The compilation of this file can be suppressed; see INSTALL + * */ #include "EXTERN.h" @@ -37,36 +40,40 @@ */ #else +/* Not all of these have prototypes elsewhere, so do this to get + * non-mangled names. + */ +START_EXTERN_C + PERL_CALLCONV OP * Perl_ref(pTHX_ OP *o, I32 type); PERL_CALLCONV void Perl_sv_unref(pTHX_ SV *sv); PERL_CALLCONV void Perl_sv_taint(pTHX_ SV *sv); -PERL_CALLCONV IV Perl_sv_2iv(pTHX_ register SV *sv); -PERL_CALLCONV UV Perl_sv_2uv(pTHX_ register SV *sv); -PERL_CALLCONV NV Perl_sv_2nv(pTHX_ register SV *sv); -PERL_CALLCONV char * Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp); -PERL_CALLCONV char * Perl_sv_2pv_nolen(pTHX_ register SV *sv); -PERL_CALLCONV char * Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv); -PERL_CALLCONV char * Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv); -PERL_CALLCONV void Perl_sv_force_normal(pTHX_ register SV *sv); -PERL_CALLCONV void Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr); +PERL_CALLCONV IV Perl_sv_2iv(pTHX_ SV *sv); +PERL_CALLCONV UV Perl_sv_2uv(pTHX_ SV *sv); +PERL_CALLCONV NV Perl_sv_2nv(pTHX_ SV *sv); +PERL_CALLCONV char * Perl_sv_2pv(pTHX_ SV *sv, STRLEN *lp); +PERL_CALLCONV char * Perl_sv_2pv_nolen(pTHX_ SV *sv); +PERL_CALLCONV char * Perl_sv_2pvbyte_nolen(pTHX_ SV *sv); +PERL_CALLCONV char * Perl_sv_2pvutf8_nolen(pTHX_ SV *sv); +PERL_CALLCONV void Perl_sv_force_normal(pTHX_ SV *sv); +PERL_CALLCONV void Perl_sv_setsv(pTHX_ SV *dstr, SV *sstr); PERL_CALLCONV void Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen); -PERL_CALLCONV void Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len); -PERL_CALLCONV void Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr); -PERL_CALLCONV void Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv); +PERL_CALLCONV void Perl_sv_catpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len); +PERL_CALLCONV void Perl_sv_catsv(pTHX_ SV *dstr, SV *sstr); +PERL_CALLCONV void Perl_sv_catsv_mg(pTHX_ SV *dsv, SV *ssv); PERL_CALLCONV char * Perl_sv_pv(pTHX_ SV *sv); PERL_CALLCONV char * Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp); PERL_CALLCONV char * Perl_sv_pvbyte(pTHX_ SV *sv); PERL_CALLCONV char * Perl_sv_pvutf8(pTHX_ SV *sv); -PERL_CALLCONV STRLEN Perl_sv_utf8_upgrade(pTHX_ register SV *sv); +PERL_CALLCONV STRLEN Perl_sv_utf8_upgrade(pTHX_ SV *sv); PERL_CALLCONV NV Perl_huge(void); PERL_CALLCONV void Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix); PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix); PERL_CALLCONV GV * Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name); PERL_CALLCONV HE * Perl_hv_iternext(pTHX_ HV *hv); PERL_CALLCONV void Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how); -PERL_CALLCONV bool Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp); -PERL_CALLCONV bool Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp); -PERL_CALLCONV bool Perl_do_exec(pTHX_ const char *cmd); +PERL_CALLCONV bool Perl_do_open(pTHX_ GV *gv, const char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp); +PERL_CALLCONV bool Perl_do_aexec(pTHX_ SV *really, SV **mark, SV **sp); PERL_CALLCONV U8 * Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv); PERL_CALLCONV bool Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep); PERL_CALLCONV void Perl_sv_nolocking(pTHX_ SV *sv); @@ -80,10 +87,15 @@ PERL_CALLCONV HV * Perl_newHV(pTHX); PERL_CALLCONV IO * Perl_newIO(pTHX); PERL_CALLCONV I32 Perl_my_stat(pTHX); PERL_CALLCONV I32 Perl_my_lstat(pTHX); -PERL_CALLCONV I32 Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2); +PERL_CALLCONV I32 Perl_sv_eq(pTHX_ SV *sv1, SV *sv2); PERL_CALLCONV char * Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp); -PERL_CALLCONV bool Perl_sv_2bool(pTHX_ register SV *const sv); +PERL_CALLCONV bool Perl_sv_2bool(pTHX_ SV *const sv); PERL_CALLCONV CV * Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP* block); +PERL_CALLCONV UV Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp); +PERL_CALLCONV UV Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp); +PERL_CALLCONV UV Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp); +PERL_CALLCONV UV Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp); +PERL_CALLCONV SV *Perl_sv_mortalcopy(pTHX_ SV *const oldstr); /* ref() is now a macro using Perl_doref; * this version provided for binary compatibility only. @@ -117,6 +129,7 @@ Perl_sv_unref(pTHX_ SV *sv) =for apidoc sv_taint Taint an SV. Use C instead. + =cut */ @@ -133,7 +146,7 @@ Perl_sv_taint(pTHX_ SV *sv) */ IV -Perl_sv_2iv(pTHX_ register SV *sv) +Perl_sv_2iv(pTHX_ SV *sv) { return sv_2iv_flags(sv, SV_GMAGIC); } @@ -143,7 +156,7 @@ Perl_sv_2iv(pTHX_ register SV *sv) */ UV -Perl_sv_2uv(pTHX_ register SV *sv) +Perl_sv_2uv(pTHX_ SV *sv) { return sv_2uv_flags(sv, SV_GMAGIC); } @@ -153,7 +166,7 @@ Perl_sv_2uv(pTHX_ register SV *sv) */ NV -Perl_sv_2nv(pTHX_ register SV *sv) +Perl_sv_2nv(pTHX_ SV *sv) { return sv_2nv_flags(sv, SV_GMAGIC); } @@ -164,7 +177,7 @@ Perl_sv_2nv(pTHX_ register SV *sv) */ char * -Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) +Perl_sv_2pv(pTHX_ SV *sv, STRLEN *lp) { return sv_2pv_flags(sv, lp, SV_GMAGIC); } @@ -174,11 +187,12 @@ Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) Like C, but doesn't return the length too. You should usually use the macro wrapper C instead. + =cut */ char * -Perl_sv_2pv_nolen(pTHX_ register SV *sv) +Perl_sv_2pv_nolen(pTHX_ SV *sv) { PERL_ARGS_ASSERT_SV_2PV_NOLEN; return sv_2pv(sv, NULL); @@ -196,7 +210,7 @@ Usually accessed via the C macro. */ char * -Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv) +Perl_sv_2pvbyte_nolen(pTHX_ SV *sv) { PERL_ARGS_ASSERT_SV_2PVBYTE_NOLEN; @@ -215,7 +229,7 @@ Usually accessed via the C macro. */ char * -Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv) +Perl_sv_2pvutf8_nolen(pTHX_ SV *sv) { PERL_ARGS_ASSERT_SV_2PVUTF8_NOLEN; @@ -233,7 +247,7 @@ an xpvmg. See also C. */ void -Perl_sv_force_normal(pTHX_ register SV *sv) +Perl_sv_force_normal(pTHX_ SV *sv) { PERL_ARGS_ASSERT_SV_FORCE_NORMAL; @@ -245,7 +259,7 @@ Perl_sv_force_normal(pTHX_ register SV *sv) */ void -Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) +Perl_sv_setsv(pTHX_ SV *dstr, SV *sstr) { PERL_ARGS_ASSERT_SV_SETSV; @@ -273,7 +287,7 @@ Like C, but also handles 'set' magic. */ void -Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len) +Perl_sv_catpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len) { PERL_ARGS_ASSERT_SV_CATPVN_MG; @@ -285,7 +299,7 @@ Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRL */ void -Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr) +Perl_sv_catsv(pTHX_ SV *dstr, SV *sstr) { PERL_ARGS_ASSERT_SV_CATSV; @@ -301,7 +315,7 @@ Like C, but also handles 'set' magic. */ void -Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv) +Perl_sv_catsv_mg(pTHX_ SV *dsv, SV *ssv) { PERL_ARGS_ASSERT_SV_CATSV_MG; @@ -318,7 +332,7 @@ cope with complex macro expressions. Always use the macro instead. */ IV -Perl_sv_iv(pTHX_ register SV *sv) +Perl_sv_iv(pTHX_ SV *sv) { PERL_ARGS_ASSERT_SV_IV; @@ -340,7 +354,7 @@ cope with complex macro expressions. Always use the macro instead. */ UV -Perl_sv_uv(pTHX_ register SV *sv) +Perl_sv_uv(pTHX_ SV *sv) { PERL_ARGS_ASSERT_SV_UV; @@ -362,7 +376,7 @@ cope with complex macro expressions. Always use the macro instead. */ NV -Perl_sv_nv(pTHX_ register SV *sv) +Perl_sv_nv(pTHX_ SV *sv) { PERL_ARGS_ASSERT_SV_NV; @@ -398,7 +412,7 @@ Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp) char * -Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp) +Perl_sv_pvn_nomg(pTHX_ SV *sv, STRLEN *lp) { PERL_ARGS_ASSERT_SV_PVN_NOMG; @@ -513,7 +527,7 @@ Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp) */ STRLEN -Perl_sv_utf8_upgrade(pTHX_ register SV *sv) +Perl_sv_utf8_upgrade(pTHX_ SV *sv) { PERL_ARGS_ASSERT_SV_UTF8_UPGRADE; @@ -634,7 +648,7 @@ Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how) } bool -Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw, +Perl_do_open(pTHX_ GV *gv, const char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp) { PERL_ARGS_ASSERT_DO_OPEN; @@ -644,7 +658,7 @@ Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw, } bool -Perl_do_open9(pTHX_ GV *gv, register const char *name, I32 len, int +Perl_do_open9(pTHX_ GV *gv, const char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, I32 num_svs) @@ -675,7 +689,7 @@ Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode) #ifndef OS2 bool -Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp) +Perl_do_aexec(pTHX_ SV *really, SV **mark, SV **sp) { PERL_ARGS_ASSERT_DO_AEXEC; @@ -683,16 +697,6 @@ Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp) } #endif -#ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION -bool -Perl_do_exec(pTHX_ const char *cmd) -{ - PERL_ARGS_ASSERT_DO_EXEC; - - return do_exec3(cmd,0,0); -} -#endif - /* Backwards compatibility. */ int Perl_init_i18nl14n(pTHX_ int printwarn) @@ -794,16 +798,18 @@ Perl_save_nogv(pTHX_ GV *gv) } void -Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg) +Perl_save_list(pTHX_ SV **sarg, I32 maxsarg) { dVAR; - register I32 i; + I32 i; PERL_ARGS_ASSERT_SAVE_LIST; for (i = 1; i <= maxsarg; i++) { - register SV * const sv = newSV(0); - sv_setsv(sv,sarg[i]); + SV *sv; + SvGETMAGIC(sarg[i]); + sv = newSV(0); + sv_setsv_nomg(sv,sarg[i]); SSCHECK(3); SSPUSHPTR(sarg[i]); /* remember the pointer */ SSPUSHPTR(sv); /* remember the value */ @@ -877,7 +883,7 @@ flags are not used. This call should not be used; use packlist instead. */ void -Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags) +Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, SV **beglist, SV **endlist, SV ***next_in_list, U32 flags) { PERL_ARGS_ASSERT_PACK_CAT; @@ -1085,13 +1091,13 @@ Perl_gv_AVadd(pTHX_ GV *gv) } GV * -Perl_gv_HVadd(pTHX_ register GV *gv) +Perl_gv_HVadd(pTHX_ GV *gv) { return gv_HVadd(gv); } GV * -Perl_gv_IOadd(pTHX_ register GV *gv) +Perl_gv_IOadd(pTHX_ GV *gv) { return gv_IOadd(gv); } @@ -1115,7 +1121,7 @@ Perl_my_lstat(pTHX) } I32 -Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2) +Perl_sv_eq(pTHX_ SV *sv1, SV *sv2) { return sv_eq_flags(sv1, sv2, SV_GMAGIC); } @@ -1129,7 +1135,7 @@ Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp) #endif bool -Perl_sv_2bool(pTHX_ register SV *const sv) +Perl_sv_2bool(pTHX_ SV *const sv) { return sv_2bool_flags(sv, SV_GMAGIC); } @@ -1168,14 +1174,55 @@ Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block) { return Perl_newATTRSUB(aTHX_ floor, o, proto, NULL, block); } + +UV +Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) +{ + PERL_ARGS_ASSERT_TO_UTF8_FOLD; + + return _to_utf8_fold_flags(p, ustrp, lenp, FOLD_FLAGS_FULL, NULL); +} + +UV +Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) +{ + PERL_ARGS_ASSERT_TO_UTF8_LOWER; + + return _to_utf8_lower_flags(p, ustrp, lenp, FALSE, NULL); +} + +UV +Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) +{ + PERL_ARGS_ASSERT_TO_UTF8_TITLE; + + return _to_utf8_title_flags(p, ustrp, lenp, FALSE, NULL); +} + +UV +Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp) +{ + PERL_ARGS_ASSERT_TO_UTF8_UPPER; + + return _to_utf8_upper_flags(p, ustrp, lenp, FALSE, NULL); +} + +SV * +Perl_sv_mortalcopy(pTHX_ SV *const oldstr) +{ + return Perl_sv_mortalcopy_flags(aTHX_ oldstr, SV_GMAGIC); +} + +END_EXTERN_C + #endif /* NO_MATHOMS */ /* * Local variables: * c-indentation-style: bsd * c-basic-offset: 4 - * indent-tabs-mode: t + * indent-tabs-mode: nil * End: * - * ex: set ts=8 sts=4 sw=4 noet: + * ex: set ts=8 sts=4 sw=4 et: */