1/* mathoms.c 2 * 3 * Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010, 4 * 2011, 2012 by Larry Wall and others 5 * 6 * You may distribute under the terms of either the GNU General Public 7 * License or the Artistic License, as specified in the README file. 8 * 9 */ 10 11/* 12 * Anything that Hobbits had no immediate use for, but were unwilling to 13 * throw away, they called a mathom. Their dwellings were apt to become 14 * rather crowded with mathoms, and many of the presents that passed from 15 * hand to hand were of that sort. 16 * 17 * [p.5 of _The Lord of the Rings_: "Prologue"] 18 */ 19 20 21 22/* 23 * This file contains mathoms, various binary artifacts from previous 24 * versions of Perl which we cannot completely remove from the core 25 * code. There are two reasons functions should be here: 26 * 27 * 1) A function has been replaced by a macro within a minor release, 28 * so XS modules compiled against an older release will expect to 29 * still be able to link against the function 30 * 2) A function Perl_foo(...) with #define foo Perl_foo(aTHX_ ...) 31 * has been replaced by a macro, e.g. #define foo(...) foo_flags(...,0) 32 * but XS code may still explicitly use the long form, i.e. 33 * Perl_foo(aTHX_ ...) 34 * 35 * This file can't just be cleaned out periodically, because that would break 36 * builds with -DPERL_NO_SHORT_NAMES 37 * 38 * NOTE: ALL FUNCTIONS IN THIS FILE should have an entry with the 'b' flag in 39 * embed.fnc. 40 * 41 * To move a function to this file, simply cut and paste it here, and change 42 * its embed.fnc entry to additionally have the 'b' flag. If, for some reason 43 * a function you'd like to be treated as mathoms can't be moved from its 44 * current place, simply enclose it between 45 * 46 * #ifndef NO_MATHOMS 47 * ... 48 * #endif 49 * 50 * and add the 'b' flag in embed.fnc. 51 * 52 * The compilation of this file can be suppressed; see INSTALL 53 * 54 * Some blurb for perlapi.pod: 55 56 head1 Obsolete backwards compatibility functions 57 58Some of these are also deprecated. You can exclude these from 59your compiled Perl by adding this option to Configure: 60C<-Accflags='-DNO_MATHOMS'> 61 62=cut 63 64 */ 65 66 67#include "EXTERN.h" 68#define PERL_IN_MATHOMS_C 69#include "perl.h" 70 71#ifdef NO_MATHOMS 72/* ..." warning: ISO C forbids an empty source file" 73 So make sure we have something in here by processing the headers anyway. 74 */ 75#else 76 77/* The functions in this file should be able to call other deprecated functions 78 * without a compiler warning */ 79GCC_DIAG_IGNORE(-Wdeprecated-declarations) 80 81/* ref() is now a macro using Perl_doref; 82 * this version provided for binary compatibility only. 83 */ 84OP * 85Perl_ref(pTHX_ OP *o, I32 type) 86{ 87 return doref(o, type, TRUE); 88} 89 90/* 91=for apidoc_section $SV 92=for apidoc sv_unref 93 94Unsets the RV status of the SV, and decrements the reference count of 95whatever was being referenced by the RV. This can almost be thought of 96as a reversal of C<newSVrv>. This is C<sv_unref_flags> with the C<flag> 97being zero. See C<L</SvROK_off>>. 98 99=cut 100*/ 101 102void 103Perl_sv_unref(pTHX_ SV *sv) 104{ 105 PERL_ARGS_ASSERT_SV_UNREF; 106 107 sv_unref_flags(sv, 0); 108} 109 110/* 111=for apidoc_section $tainting 112=for apidoc sv_taint 113 114Taint an SV. Use C<SvTAINTED_on> instead. 115 116=cut 117*/ 118 119void 120Perl_sv_taint(pTHX_ SV *sv) 121{ 122 PERL_ARGS_ASSERT_SV_TAINT; 123 124 sv_magic((sv), NULL, PERL_MAGIC_taint, NULL, 0); 125} 126 127/* sv_2iv() is now a macro using Perl_sv_2iv_flags(); 128 * this function provided for binary compatibility only 129 */ 130 131IV 132Perl_sv_2iv(pTHX_ SV *sv) 133{ 134 PERL_ARGS_ASSERT_SV_2IV; 135 136 return sv_2iv_flags(sv, SV_GMAGIC); 137} 138 139/* sv_2uv() is now a macro using Perl_sv_2uv_flags(); 140 * this function provided for binary compatibility only 141 */ 142 143UV 144Perl_sv_2uv(pTHX_ SV *sv) 145{ 146 PERL_ARGS_ASSERT_SV_2UV; 147 148 return sv_2uv_flags(sv, SV_GMAGIC); 149} 150 151/* sv_2nv() is now a macro using Perl_sv_2nv_flags(); 152 * this function provided for binary compatibility only 153 */ 154 155NV 156Perl_sv_2nv(pTHX_ SV *sv) 157{ 158 return sv_2nv_flags(sv, SV_GMAGIC); 159} 160 161 162/* sv_2pv() is now a macro using Perl_sv_2pv_flags(); 163 * this function provided for binary compatibility only 164 */ 165 166char * 167Perl_sv_2pv(pTHX_ SV *sv, STRLEN *lp) 168{ 169 PERL_ARGS_ASSERT_SV_2PV; 170 171 return sv_2pv_flags(sv, lp, SV_GMAGIC); 172} 173 174/* 175=for apidoc_section $SV 176=for apidoc sv_2pv_nolen 177 178Like C<sv_2pv()>, but doesn't return the length too. You should usually 179use the macro wrapper C<SvPV_nolen(sv)> instead. 180 181=cut 182*/ 183 184char * 185Perl_sv_2pv_nolen(pTHX_ SV *sv) 186{ 187 PERL_ARGS_ASSERT_SV_2PV_NOLEN; 188 return sv_2pv(sv, NULL); 189} 190 191/* 192=for apidoc_section $SV 193=for apidoc sv_2pvbyte_nolen 194 195Return a pointer to the byte-encoded representation of the SV. 196May cause the SV to be downgraded from UTF-8 as a side-effect. 197 198Usually accessed via the C<SvPVbyte_nolen> macro. 199 200=cut 201*/ 202 203char * 204Perl_sv_2pvbyte_nolen(pTHX_ SV *sv) 205{ 206 PERL_ARGS_ASSERT_SV_2PVBYTE_NOLEN; 207 208 return sv_2pvbyte(sv, NULL); 209} 210 211/* 212=for apidoc_section $SV 213=for apidoc sv_2pvutf8_nolen 214 215Return a pointer to the UTF-8-encoded representation of the SV. 216May cause the SV to be upgraded to UTF-8 as a side-effect. 217 218Usually accessed via the C<SvPVutf8_nolen> macro. 219 220=cut 221*/ 222 223char * 224Perl_sv_2pvutf8_nolen(pTHX_ SV *sv) 225{ 226 PERL_ARGS_ASSERT_SV_2PVUTF8_NOLEN; 227 228 return sv_2pvutf8(sv, NULL); 229} 230 231/* 232=for apidoc_section $SV 233=for apidoc sv_force_normal 234 235Undo various types of fakery on an SV: if the PV is a shared string, make 236a private copy; if we're a ref, stop refing; if we're a glob, downgrade to 237an C<xpvmg>. See also C<L</sv_force_normal_flags>>. 238 239=cut 240*/ 241 242void 243Perl_sv_force_normal(pTHX_ SV *sv) 244{ 245 PERL_ARGS_ASSERT_SV_FORCE_NORMAL; 246 247 sv_force_normal_flags(sv, 0); 248} 249 250/* sv_setsv() is now a macro using Perl_sv_setsv_flags(); 251 * this function provided for binary compatibility only 252 */ 253 254void 255Perl_sv_setsv(pTHX_ SV *dsv, SV *ssv) 256{ 257 PERL_ARGS_ASSERT_SV_SETSV; 258 259 sv_setsv_flags(dsv, ssv, SV_GMAGIC); 260} 261 262/* sv_catpvn() is now a macro using Perl_sv_catpvn_flags(); 263 * this function provided for binary compatibility only 264 */ 265 266void 267Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen) 268{ 269 PERL_ARGS_ASSERT_SV_CATPVN; 270 271 sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC); 272} 273 274void 275Perl_sv_catpvn_mg(pTHX_ SV *dsv, const char *sstr, STRLEN len) 276{ 277 PERL_ARGS_ASSERT_SV_CATPVN_MG; 278 279 sv_catpvn_flags(dsv,sstr,len,SV_GMAGIC|SV_SMAGIC); 280} 281 282/* sv_catsv() is now a macro using Perl_sv_catsv_flags(); 283 * this function provided for binary compatibility only 284 */ 285 286void 287Perl_sv_catsv(pTHX_ SV *dsv, SV *sstr) 288{ 289 PERL_ARGS_ASSERT_SV_CATSV; 290 291 sv_catsv_flags(dsv, sstr, SV_GMAGIC); 292} 293 294void 295Perl_sv_catsv_mg(pTHX_ SV *dsv, SV *sstr) 296{ 297 PERL_ARGS_ASSERT_SV_CATSV_MG; 298 299 sv_catsv_flags(dsv,sstr,SV_GMAGIC|SV_SMAGIC); 300} 301 302/* 303=for apidoc_section $SV 304=for apidoc sv_pv 305 306Use the C<SvPV_nolen> macro instead 307 308=cut 309*/ 310 311/* sv_pv() is now a macro using SvPV_nolen(); 312 * this function provided for binary compatibility only 313 */ 314 315char * 316Perl_sv_pv(pTHX_ SV *sv) 317{ 318 PERL_ARGS_ASSERT_SV_PV; 319 320 if (SvPOK(sv)) 321 return SvPVX(sv); 322 323 return sv_2pv(sv, NULL); 324} 325 326/* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags(); 327 * this function provided for binary compatibility only 328 */ 329 330char * 331Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp) 332{ 333 PERL_ARGS_ASSERT_SV_PVN_FORCE; 334 335 return sv_pvn_force_flags(sv, lp, SV_GMAGIC); 336} 337 338/* sv_pvbyte () is now a macro using Perl_sv_2pv_flags(); 339 * this function provided for binary compatibility only 340 */ 341 342char * 343Perl_sv_pvbyte(pTHX_ SV *sv) 344{ 345 PERL_ARGS_ASSERT_SV_PVBYTE; 346 347 (void)sv_utf8_downgrade(sv, FALSE); 348 return sv_pv(sv); 349} 350 351/* 352=for apidoc_section $SV 353=for apidoc sv_pvbyte 354 355Use C<SvPVbyte_nolen> instead. 356 357=cut 358*/ 359 360/* 361=for apidoc_section $SV 362=for apidoc sv_pvutf8 363 364Use the C<SvPVutf8_nolen> macro instead 365 366=cut 367*/ 368 369 370char * 371Perl_sv_pvutf8(pTHX_ SV *sv) 372{ 373 PERL_ARGS_ASSERT_SV_PVUTF8; 374 375 sv_utf8_upgrade(sv); 376 return sv_pv(sv); 377} 378 379/* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags(); 380 * this function provided for binary compatibility only 381 */ 382 383STRLEN 384Perl_sv_utf8_upgrade(pTHX_ SV *sv) 385{ 386 PERL_ARGS_ASSERT_SV_UTF8_UPGRADE; 387 388 return sv_utf8_upgrade_flags(sv, SV_GMAGIC); 389} 390 391#if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)) 392/* 393 * This hack is to force load of "huge" support from libm.a 394 * So it is in perl for (say) POSIX to use. 395 * Needed for SunOS with Sun's 'acc' for example. 396 */ 397NV 398Perl_huge(void) 399{ 400# if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL) 401 return HUGE_VALL; 402# else 403 return HUGE_VAL; 404# endif 405} 406#endif 407 408void 409Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix) 410{ 411 PERL_ARGS_ASSERT_GV_FULLNAME3; 412 413 gv_fullname4(sv, gv, prefix, TRUE); 414} 415 416void 417Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix) 418{ 419 PERL_ARGS_ASSERT_GV_EFULLNAME3; 420 421 gv_efullname4(sv, gv, prefix, TRUE); 422} 423 424/* 425=for apidoc_section $GV 426=for apidoc gv_fetchmethod 427 428See L</gv_fetchmethod_autoload>. 429 430=cut 431*/ 432 433GV * 434Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name) 435{ 436 PERL_ARGS_ASSERT_GV_FETCHMETHOD; 437 438 return gv_fetchmethod_autoload(stash, name, TRUE); 439} 440 441HE * 442Perl_hv_iternext(pTHX_ HV *hv) 443{ 444 PERL_ARGS_ASSERT_HV_ITERNEXT; 445 446 return hv_iternext_flags(hv, 0); 447} 448 449void 450Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how) 451{ 452 PERL_ARGS_ASSERT_HV_MAGIC; 453 454 sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0); 455} 456 457bool 458Perl_do_open(pTHX_ GV *gv, const char *name, I32 len, int as_raw, 459 int rawmode, int rawperm, PerlIO *supplied_fp) 460{ 461 PERL_ARGS_ASSERT_DO_OPEN; 462 463 return do_openn(gv, name, len, as_raw, rawmode, rawperm, 464 supplied_fp, (SV **) NULL, 0); 465} 466 467#ifndef OS2 468bool 469Perl_do_aexec(pTHX_ SV *really, SV **mark, SV **sp) 470{ 471 PERL_ARGS_ASSERT_DO_AEXEC; 472 473 return do_aexec5(really, mark, sp, 0, 0); 474} 475#endif 476 477bool 478Perl_is_utf8_string_loc(const U8 *s, const STRLEN len, const U8 **ep) 479{ 480 PERL_ARGS_ASSERT_IS_UTF8_STRING_LOC; 481 482 return is_utf8_string_loclen(s, len, ep, 0); 483} 484 485/* 486=for apidoc_section $SV 487=for apidoc sv_nolocking 488 489Dummy routine which "locks" an SV when there is no locking module present. 490Exists to avoid test for a C<NULL> function pointer and because it could 491potentially warn under some level of strict-ness. 492 493"Superseded" by C<sv_nosharing()>. 494 495=cut 496*/ 497 498void 499Perl_sv_nolocking(pTHX_ SV *sv) 500{ 501 PERL_UNUSED_CONTEXT; 502 PERL_UNUSED_ARG(sv); 503} 504 505 506/* 507=for apidoc_section $SV 508=for apidoc sv_nounlocking 509 510Dummy routine which "unlocks" an SV when there is no locking module present. 511Exists to avoid test for a C<NULL> function pointer and because it could 512potentially warn under some level of strict-ness. 513 514"Superseded" by C<sv_nosharing()>. 515 516=cut 517 518PERL_UNLOCK_HOOK in intrpvar.h is the macro that refers to this, and guarantees 519that mathoms gets loaded. 520 521*/ 522 523void 524Perl_sv_nounlocking(pTHX_ SV *sv) 525{ 526 PERL_UNUSED_CONTEXT; 527 PERL_UNUSED_ARG(sv); 528} 529 530void 531Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len) 532{ 533 PERL_ARGS_ASSERT_SV_USEPVN_MG; 534 535 sv_usepvn_flags(sv,ptr,len, SV_SMAGIC); 536} 537 538 539void 540Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len) 541{ 542 PERL_ARGS_ASSERT_SV_USEPVN; 543 544 sv_usepvn_flags(sv,ptr,len, 0); 545} 546 547HE * 548Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash) 549{ 550 return (HE *)hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash); 551} 552 553bool 554Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash) 555{ 556 PERL_ARGS_ASSERT_HV_EXISTS_ENT; 557 558 return cBOOL(hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)); 559} 560 561HE * 562Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash) 563{ 564 PERL_ARGS_ASSERT_HV_FETCH_ENT; 565 566 return (HE *)hv_common(hv, keysv, NULL, 0, 0, 567 (lval ? HV_FETCH_LVALUE : 0), NULL, hash); 568} 569 570SV * 571Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash) 572{ 573 PERL_ARGS_ASSERT_HV_DELETE_ENT; 574 575 return MUTABLE_SV(hv_common(hv, keysv, NULL, 0, 0, flags | HV_DELETE, NULL, 576 hash)); 577} 578 579SV** 580Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash, 581 int flags) 582{ 583 return (SV**) hv_common(hv, NULL, key, klen, flags, 584 (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); 585} 586 587SV** 588Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash) 589{ 590 STRLEN klen; 591 int flags; 592 593 if (klen_i32 < 0) { 594 klen = -klen_i32; 595 flags = HVhek_UTF8; 596 } else { 597 klen = klen_i32; 598 flags = 0; 599 } 600 return (SV **) hv_common(hv, NULL, key, klen, flags, 601 (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash); 602} 603 604bool 605Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32) 606{ 607 STRLEN klen; 608 int flags; 609 610 PERL_ARGS_ASSERT_HV_EXISTS; 611 612 if (klen_i32 < 0) { 613 klen = -klen_i32; 614 flags = HVhek_UTF8; 615 } else { 616 klen = klen_i32; 617 flags = 0; 618 } 619 return cBOOL(hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)); 620} 621 622SV** 623Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval) 624{ 625 STRLEN klen; 626 int flags; 627 628 PERL_ARGS_ASSERT_HV_FETCH; 629 630 if (klen_i32 < 0) { 631 klen = -klen_i32; 632 flags = HVhek_UTF8; 633 } else { 634 klen = klen_i32; 635 flags = 0; 636 } 637 return (SV **) hv_common(hv, NULL, key, klen, flags, 638 lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) 639 : HV_FETCH_JUST_SV, NULL, 0); 640} 641 642SV * 643Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags) 644{ 645 STRLEN klen; 646 int k_flags; 647 648 PERL_ARGS_ASSERT_HV_DELETE; 649 650 if (klen_i32 < 0) { 651 klen = -klen_i32; 652 k_flags = HVhek_UTF8; 653 } else { 654 klen = klen_i32; 655 k_flags = 0; 656 } 657 return MUTABLE_SV(hv_common(hv, NULL, key, klen, k_flags, flags | HV_DELETE, 658 NULL, 0)); 659} 660 661AV * 662Perl_newAV(pTHX) 663{ 664 return MUTABLE_AV(newSV_type(SVt_PVAV)); 665 /* sv_upgrade does AvREAL_only(): 666 AvALLOC(av) = 0; 667 AvARRAY(av) = NULL; 668 AvMAX(av) = AvFILLp(av) = -1; */ 669} 670 671HV * 672Perl_newHV(pTHX) 673{ 674 HV * const hv = MUTABLE_HV(newSV_type(SVt_PVHV)); 675 assert(!SvOK(hv)); 676 677 return hv; 678} 679 680void 681Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len, 682 const char *const little, const STRLEN littlelen) 683{ 684 PERL_ARGS_ASSERT_SV_INSERT; 685 sv_insert_flags(bigstr, offset, len, little, littlelen, SV_GMAGIC); 686} 687 688void 689Perl_save_freesv(pTHX_ SV *sv) 690{ 691 save_freesv(sv); 692} 693 694void 695Perl_save_mortalizesv(pTHX_ SV *sv) 696{ 697 PERL_ARGS_ASSERT_SAVE_MORTALIZESV; 698 699 save_mortalizesv(sv); 700} 701 702void 703Perl_save_freeop(pTHX_ OP *o) 704{ 705 save_freeop(o); 706} 707 708void 709Perl_save_freepv(pTHX_ char *pv) 710{ 711 save_freepv(pv); 712} 713 714void 715Perl_save_op(pTHX) 716{ 717 save_op(); 718} 719 720#ifdef PERL_DONT_CREATE_GVSV 721GV * 722Perl_gv_SVadd(pTHX_ GV *gv) 723{ 724 return gv_SVadd(gv); 725} 726#endif 727 728GV * 729Perl_gv_AVadd(pTHX_ GV *gv) 730{ 731 return gv_AVadd(gv); 732} 733 734GV * 735Perl_gv_HVadd(pTHX_ GV *gv) 736{ 737 return gv_HVadd(gv); 738} 739 740GV * 741Perl_gv_IOadd(pTHX_ GV *gv) 742{ 743 return gv_IOadd(gv); 744} 745 746IO * 747Perl_newIO(pTHX) 748{ 749 return MUTABLE_IO(newSV_type(SVt_PVIO)); 750} 751 752I32 753Perl_my_stat(pTHX) 754{ 755 return my_stat_flags(SV_GMAGIC); 756} 757 758I32 759Perl_my_lstat(pTHX) 760{ 761 return my_lstat_flags(SV_GMAGIC); 762} 763 764I32 765Perl_sv_eq(pTHX_ SV *sv1, SV *sv2) 766{ 767 return sv_eq_flags(sv1, sv2, SV_GMAGIC); 768} 769 770#ifdef USE_LOCALE_COLLATE 771char * 772Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp) 773{ 774 PERL_ARGS_ASSERT_SV_COLLXFRM; 775 return sv_collxfrm_flags(sv, nxp, SV_GMAGIC); 776} 777 778#endif 779 780bool 781Perl_sv_2bool(pTHX_ SV *const sv) 782{ 783 PERL_ARGS_ASSERT_SV_2BOOL; 784 return sv_2bool_flags(sv, SV_GMAGIC); 785} 786 787CV * 788Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block) 789{ 790 return newATTRSUB(floor, o, proto, NULL, block); 791} 792 793SV * 794Perl_sv_mortalcopy(pTHX_ SV *const oldsv) 795{ 796 return Perl_sv_mortalcopy_flags(aTHX_ oldsv, SV_GMAGIC); 797} 798 799void 800Perl_sv_copypv(pTHX_ SV *const dsv, SV *const ssv) 801{ 802 PERL_ARGS_ASSERT_SV_COPYPV; 803 804 sv_copypv_flags(dsv, ssv, SV_GMAGIC); 805} 806 807/* 808=for apidoc_section $unicode 809=for apidoc is_utf8_char_buf 810 811This is identical to the macro L<perlapi/isUTF8_CHAR>. 812 813=cut */ 814 815STRLEN 816Perl_is_utf8_char_buf(const U8 *buf, const U8* buf_end) 817{ 818 819 PERL_ARGS_ASSERT_IS_UTF8_CHAR_BUF; 820 821 return isUTF8_CHAR(buf, buf_end); 822} 823 824/* 825=for apidoc_section $unicode 826=for apidoc utf8_to_uvuni 827 828Returns the Unicode code point of the first character in the string C<s> 829which is assumed to be in UTF-8 encoding; C<retlen> will be set to the 830length, in bytes, of that character. 831 832Some, but not all, UTF-8 malformations are detected, and in fact, some 833malformed input could cause reading beyond the end of the input buffer, which 834is one reason why this function is deprecated. The other is that only in 835extremely limited circumstances should the Unicode versus native code point be 836of any interest to you. 837 838If C<s> points to one of the detected malformations, and UTF8 warnings are 839enabled, zero is returned and C<*retlen> is set (if C<retlen> doesn't point to 840NULL) to -1. If those warnings are off, the computed value if well-defined (or 841the Unicode REPLACEMENT CHARACTER, if not) is silently returned, and C<*retlen> 842is set (if C<retlen> isn't NULL) so that (S<C<s> + C<*retlen>>) is the 843next possible position in C<s> that could begin a non-malformed character. 844See L<perlapi/utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is returned. 845 846=cut 847*/ 848 849UV 850Perl_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen) 851{ 852 PERL_UNUSED_CONTEXT; 853 PERL_ARGS_ASSERT_UTF8_TO_UVUNI; 854 855 return NATIVE_TO_UNI(valid_utf8_to_uvchr(s, retlen)); 856} 857 858/* return ptr to little string in big string, NULL if not found */ 859/* The original version of this routine was donated by Corey Satten. */ 860 861char * 862Perl_instr(const char *big, const char *little) 863{ 864 PERL_ARGS_ASSERT_INSTR; 865 866 return instr(big, little); 867} 868 869SV * 870Perl_newSVsv(pTHX_ SV *const old) 871{ 872 return newSVsv(old); 873} 874 875bool 876Perl_sv_utf8_downgrade(pTHX_ SV *const sv, const bool fail_ok) 877{ 878 PERL_ARGS_ASSERT_SV_UTF8_DOWNGRADE; 879 880 return sv_utf8_downgrade(sv, fail_ok); 881} 882 883char * 884Perl_sv_2pvutf8(pTHX_ SV *sv, STRLEN *const lp) 885{ 886 PERL_ARGS_ASSERT_SV_2PVUTF8; 887 888 return sv_2pvutf8(sv, lp); 889} 890 891char * 892Perl_sv_2pvbyte(pTHX_ SV *sv, STRLEN *const lp) 893{ 894 PERL_ARGS_ASSERT_SV_2PVBYTE; 895 896 return sv_2pvbyte(sv, lp); 897} 898 899U8 * 900Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv) 901{ 902 PERL_ARGS_ASSERT_UVUNI_TO_UTF8; 903 904 return uvoffuni_to_utf8_flags(d, uv, 0); 905} 906 907/* 908=for apidoc_section $unicode 909=for apidoc utf8n_to_uvuni 910 911Instead use L<perlapi/utf8_to_uvchr_buf>, or rarely, L<perlapi/utf8n_to_uvchr>. 912 913This function was useful for code that wanted to handle both EBCDIC and 914ASCII platforms with Unicode properties, but starting in Perl v5.20, the 915distinctions between the platforms have mostly been made invisible to most 916code, so this function is quite unlikely to be what you want. If you do need 917this precise functionality, use instead 918C<L<NATIVE_TO_UNI(utf8_to_uvchr_buf(...))|perlapi/utf8_to_uvchr_buf>> 919or C<L<NATIVE_TO_UNI(utf8n_to_uvchr(...))|perlapi/utf8n_to_uvchr>>. 920 921=cut 922*/ 923 924UV 925Perl_utf8n_to_uvuni(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, U32 flags) 926{ 927 PERL_ARGS_ASSERT_UTF8N_TO_UVUNI; 928 929 return NATIVE_TO_UNI(utf8n_to_uvchr(s, curlen, retlen, flags)); 930} 931 932/* 933=for apidoc_section $unicode 934=for apidoc utf8_to_uvchr 935 936Returns the native code point of the first character in the string C<s> 937which is assumed to be in UTF-8 encoding; C<retlen> will be set to the 938length, in bytes, of that character. 939 940Some, but not all, UTF-8 malformations are detected, and in fact, some 941malformed input could cause reading beyond the end of the input buffer, which 942is why this function is deprecated. Use L</utf8_to_uvchr_buf> instead. 943 944If C<s> points to one of the detected malformations, and UTF8 warnings are 945enabled, zero is returned and C<*retlen> is set (if C<retlen> isn't 946C<NULL>) to -1. If those warnings are off, the computed value if well-defined (or 947the Unicode REPLACEMENT CHARACTER, if not) is silently returned, and C<*retlen> 948is set (if C<retlen> isn't NULL) so that (S<C<s> + C<*retlen>>) is the 949next possible position in C<s> that could begin a non-malformed character. 950See L</utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is returned. 951 952=cut 953*/ 954 955UV 956Perl_utf8_to_uvchr(pTHX_ const U8 *s, STRLEN *retlen) 957{ 958 PERL_ARGS_ASSERT_UTF8_TO_UVCHR; 959 960 /* This function is unsafe if malformed UTF-8 input is given it, which is 961 * why the function is deprecated. If the first byte of the input 962 * indicates that there are more bytes remaining in the sequence that forms 963 * the character than there are in the input buffer, it can read past the 964 * end. But we can make it safe if the input string happens to be 965 * NUL-terminated, as many strings in Perl are, by refusing to read past a 966 * NUL, which is what UTF8_CHK_SKIP() does. A NUL indicates the start of 967 * the next character anyway. If the input isn't NUL-terminated, the 968 * function remains unsafe, as it always has been. */ 969 970 return utf8_to_uvchr_buf(s, s + UTF8_CHK_SKIP(s), retlen); 971} 972 973GCC_DIAG_RESTORE 974 975#endif /* NO_MATHOMS */ 976 977/* 978 * ex: set ts=8 sts=4 sw=4 et: 979 */ 980