X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/d7244c9a613101b97077ed781e11a729c347555c..9d3980bc229750e6c07726fe529f02bf4dc6a5a5:/mathoms.c diff --git a/mathoms.c b/mathoms.c index 0ebf434..8b003d3 100644 --- a/mathoms.c +++ b/mathoms.c @@ -32,14 +32,26 @@ * but XS code may still explicitly use the long form, i.e. * Perl_foo(aTHX_ ...) * - * REMEMBER to update makedef.pl when adding a function to mathoms.c whose - * name doesn't begin with "Perl_". + * NOTE: ALL FUNCTIONS IN THIS FILE should have an entry with the 'b' flag in + * embed.fnc. * - * SMP - Oct. 24, 2005 + * To move a function to this file, simply cut and paste it here, and change + * its embed.fnc entry to additionally have the 'b' flag. If, for some reason + * a function you'd like to be treated as mathoms can't be moved from its + * current place, simply enclose it between + * + * #ifndef NO_MATHOMS + * ... + * #endif + * + * and add the 'b' flag in embed.fnc. * * The compilation of this file can be suppressed; see INSTALL * + * Some blurb for perlapi.pod: + =head1 Obsolete backwards compatibility functions + Some of these are also deprecated. You can exclude these from your compiled Perl by adding this option to Configure: C<-Accflags='-DNO_MATHOMS'> @@ -59,22 +71,6 @@ C<-Accflags='-DNO_MATHOMS'> */ #else -/* NOTE ALL FUNCTIONS IN THIS FILE should have an entry with the 'b' flag in - * embed.fnc. - * - * To move a function to this file, simply cut and paste it here, and change - * its embed.fnc entry to additionally have the 'b' flag. If, for some reason - * a function you'd like to be treated as mathoms can't be moved from its - * current place, simply enclose it between - * - * #ifndef NO_MATHOMS - * ... - * #endif - * - * and add the 'b' flag in embed.fnc. - * - * */ - /* ref() is now a macro using Perl_doref; * this version provided for binary compatibility only. */ @@ -522,7 +518,7 @@ int Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...) { int ret = 0; - va_list(arglist); + va_list arglist; /* Easier to special case this here than in embed.pl. (Look at what it generates for proto.h) */ @@ -540,7 +536,7 @@ int Perl_printf_nocontext(const char *format, ...) { dTHX; - va_list(arglist); + va_list arglist; int ret = 0; #ifdef PERL_IMPLICIT_CONTEXT @@ -694,7 +690,7 @@ Perl_init_i18nl14n(pTHX_ int printwarn) } bool -Perl_is_utf8_string_loc(const U8 *s, STRLEN len, const U8 **ep) +Perl_is_utf8_string_loc(const U8 *s, const STRLEN len, const U8 **ep) { PERL_ARGS_ASSERT_IS_UTF8_STRING_LOC; @@ -752,17 +748,6 @@ Perl_save_long(pTHX_ long int *longp) } void -Perl_save_iv(pTHX_ IV *ivp) -{ - PERL_ARGS_ASSERT_SAVE_IV; - - SSCHECK(3); - SSPUSHIV(*ivp); - SSPUSHPTR(ivp); - SSPUSHUV(SAVEt_IV); -} - -void Perl_save_nogv(pTHX_ GV *gv) { PERL_ARGS_ASSERT_SAVE_NOGV; @@ -834,7 +819,7 @@ C instead. =cut */ -I32 +SSize_t Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s, const char *strbeg, const char *strend, char **new_s, I32 ocnt, U32 flags) @@ -880,8 +865,7 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash) { PERL_ARGS_ASSERT_HV_EXISTS_ENT; - return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash) - ? TRUE : FALSE; + return cBOOL(hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)); } HE * @@ -942,8 +926,7 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32) klen = klen_i32; flags = 0; } - return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0) - ? TRUE : FALSE; + return cBOOL(hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)); } SV** @@ -1098,13 +1081,27 @@ Perl_sv_eq(pTHX_ SV *sv1, SV *sv2) char * Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp) { + PERL_ARGS_ASSERT_SV_COLLXFRM; return sv_collxfrm_flags(sv, nxp, SV_GMAGIC); } + +char * +Perl_mem_collxfrm(pTHX_ const char *input_string, STRLEN len, STRLEN *xlen) +{ + /* This function is retained for compatibility in case someone outside core + * is using this (but it is undocumented) */ + + PERL_ARGS_ASSERT_MEM_COLLXFRM; + + return _mem_collxfrm(input_string, len, xlen, FALSE); +} + #endif bool Perl_sv_2bool(pTHX_ SV *const sv) { + PERL_ARGS_ASSERT_SV_2BOOL; return sv_2bool_flags(sv, SV_GMAGIC); } @@ -1148,7 +1145,7 @@ 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); + return toFOLD_utf8(p, ustrp, lenp); } UV @@ -1156,7 +1153,7 @@ 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); + return toLOWER_utf8(p, ustrp, lenp); } UV @@ -1164,7 +1161,7 @@ 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); + return toTITLE_utf8(p, ustrp, lenp); } UV @@ -1172,7 +1169,7 @@ 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); + return toUPPER_utf8(p, ustrp, lenp); } SV * @@ -1186,7 +1183,7 @@ Perl_sv_copypv(pTHX_ SV *const dsv, SV *const ssv) { PERL_ARGS_ASSERT_SV_COPYPV; - sv_copypv_flags(dsv, ssv, 0); + sv_copypv_flags(dsv, ssv, SV_GMAGIC); } UV /* Made into a function, so can be deprecated */ @@ -1663,8 +1660,9 @@ Perl_is_utf8_char(const U8 *s) { PERL_ARGS_ASSERT_IS_UTF8_CHAR; - /* Assumes we have enough space, which is why this is deprecated */ - return isUTF8_CHAR(s, s + UTF8SKIP(s)); + /* Assumes we have enough space, which is why this is deprecated. But the + * strnlen() makes it safe for the common case of NUL-terminated strings */ + return isUTF8_CHAR(s, s + my_strnlen((char *) s, UTF8SKIP(s))); } /* @@ -1691,42 +1689,13 @@ Perl_is_utf8_char_buf(const U8 *buf, const U8* buf_end) UV Perl_valid_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen) { + PERL_UNUSED_CONTEXT; PERL_ARGS_ASSERT_VALID_UTF8_TO_UVUNI; return NATIVE_TO_UNI(valid_utf8_to_uvchr(s, retlen)); } /* -=for apidoc utf8_to_uvchr - -Returns the native code point of the first character in the string C -which is assumed to be in UTF-8 encoding; C will be set to the -length, in bytes, of that character. - -Some, but not all, UTF-8 malformations are detected, and in fact, some -malformed input could cause reading beyond the end of the input buffer, which -is why this function is deprecated. Use L instead. - -If C points to one of the detected malformations, and UTF8 warnings are -enabled, zero is returned and C<*retlen> is set (if C isn't -C) to -1. If those warnings are off, the computed value if well-defined (or -the Unicode REPLACEMENT CHARACTER, if not) is silently returned, and C<*retlen> -is set (if C isn't NULL) so that (S + C<*retlen>>) is the -next possible position in C that could begin a non-malformed character. -See L for details on when the REPLACEMENT CHARACTER is returned. - -=cut -*/ - -UV -Perl_utf8_to_uvchr(pTHX_ const U8 *s, STRLEN *retlen) -{ - PERL_ARGS_ASSERT_UTF8_TO_UVCHR; - - return utf8_to_uvchr_buf(s, s + UTF8_MAXBYTES, retlen); -} - -/* =for apidoc utf8_to_uvuni Returns the Unicode code point of the first character in the string C @@ -1753,6 +1722,7 @@ See L for details on when the REPLACEMENT CHARACTER is returned UV Perl_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen) { + PERL_UNUSED_CONTEXT; PERL_ARGS_ASSERT_UTF8_TO_UVUNI; return NATIVE_TO_UNI(valid_utf8_to_uvchr(s, retlen));