mathoms.c

   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
  58 Some of these are also deprecated.  You can exclude these from
  59 your compiled Perl by adding this option to Configure:
  60 C<-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 */
  79 GCC_DIAG_IGNORE(-Wdeprecated-declarations)
  80
  81 /* ref() is now a macro using Perl_doref;
  82  * this version provided for binary compatibility only.
  83  */
  84 OP *
  85 Perl_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
  94 Unsets the RV status of the SV, and decrements the reference count of
  95 whatever was being referenced by the RV.  This can almost be thought of
  96 as a reversal of C<newSVrv>.  This is C<sv_unref_flags> with the C<flag>
  97 being zero.  See C<L</SvROK_off>>.
  98
  99 =cut
 100 */
 101
 102 void
 103 Perl_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
 114 Taint an SV.  Use C<SvTAINTED_on> instead.
 115
 116 =cut
 117 */
 118
 119 void
 120 Perl_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
 131 IV
 132 Perl_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
 143 UV
 144 Perl_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
 155 NV
 156 Perl_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
 166 char *
 167 Perl_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
 178 Like C<sv_2pv()>, but doesn't return the length too.  You should usually
 179 use the macro wrapper C<SvPV_nolen(sv)> instead.
 180
 181 =cut
 182 */
 183
 184 char *
 185 Perl_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
 195 Return a pointer to the byte-encoded representation of the SV.
 196 May cause the SV to be downgraded from UTF-8 as a side-effect.
 197
 198 Usually accessed via the C<SvPVbyte_nolen> macro.
 199
 200 =cut
 201 */
 202
 203 char *
 204 Perl_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
 215 Return a pointer to the UTF-8-encoded representation of the SV.
 216 May cause the SV to be upgraded to UTF-8 as a side-effect.
 217
 218 Usually accessed via the C<SvPVutf8_nolen> macro.
 219
 220 =cut
 221 */
 222
 223 char *
 224 Perl_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
 235 Undo various types of fakery on an SV: if the PV is a shared string, make
 236 a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
 237 an C<xpvmg>.  See also C<L</sv_force_normal_flags>>.
 238
 239 =cut
 240 */
 241
 242 void
 243 Perl_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
 254 void
 255 Perl_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
 266 void
 267 Perl_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
 274 void
 275 Perl_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
 286 void
 287 Perl_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
 294 void
 295 Perl_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
 306 Use 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
 315 char *
 316 Perl_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
 330 char *
 331 Perl_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
 342 char *
 343 Perl_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
 355 Use C<SvPVbyte_nolen> instead.
 356
 357 =cut
 358 */
 359
 360 /*
 361 =for apidoc_section $SV
 362 =for apidoc sv_pvutf8
 363
 364 Use the C<SvPVutf8_nolen> macro instead
 365
 366 =cut
 367 */
 368
 369
 370 char *
 371 Perl_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
 383 STRLEN
 384 Perl_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  */
 397 NV
 398 Perl_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
 408 void
 409 Perl_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
 416 void
 417 Perl_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
 428 See L</gv_fetchmethod_autoload>.
 429
 430 =cut
 431 */
 432
 433 GV *
 434 Perl_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
 441 HE *
 442 Perl_hv_iternext(pTHX_ HV *hv)
 443 {
 444     PERL_ARGS_ASSERT_HV_ITERNEXT;
 445
 446     return hv_iternext_flags(hv, 0);
 447 }
 448
 449 void
 450 Perl_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
 457 bool
 458 Perl_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
 468 bool
 469 Perl_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
 477 bool
 478 Perl_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
 489 Dummy routine which "locks" an SV when there is no locking module present.
 490 Exists to avoid test for a C<NULL> function pointer and because it could
 491 potentially warn under some level of strict-ness.
 492
 493 "Superseded" by C<sv_nosharing()>.
 494
 495 =cut
 496 */
 497
 498 void
 499 Perl_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
 510 Dummy routine which "unlocks" an SV when there is no locking module present.
 511 Exists to avoid test for a C<NULL> function pointer and because it could
 512 potentially warn under some level of strict-ness.
 513
 514 "Superseded" by C<sv_nosharing()>.
 515
 516 =cut
 517
 518 PERL_UNLOCK_HOOK in intrpvar.h is the macro that refers to this, and guarantees
 519 that mathoms gets loaded.
 520
 521 */
 522
 523 void
 524 Perl_sv_nounlocking(pTHX_ SV *sv)
 525 {
 526     PERL_UNUSED_CONTEXT;
 527     PERL_UNUSED_ARG(sv);
 528 }
 529
 530 void
 531 Perl_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
 539 void
 540 Perl_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
 547 HE *
 548 Perl_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
 553 bool
 554 Perl_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
 561 HE *
 562 Perl_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
 570 SV *
 571 Perl_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
 579 SV**
 580 Perl_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
 587 SV**
 588 Perl_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
 604 bool
 605 Perl_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
 622 SV**
 623 Perl_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
 642 SV *
 643 Perl_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
 661 AV *
 662 Perl_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
 671 HV *
 672 Perl_newHV(pTHX)
 673 {
 674     HV * const hv = MUTABLE_HV(newSV_type(SVt_PVHV));
 675     assert(!SvOK(hv));
 676
 677     return hv;
 678 }
 679
 680 void
 681 Perl_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
 688 void
 689 Perl_save_freesv(pTHX_ SV *sv)
 690 {
 691     save_freesv(sv);
 692 }
 693
 694 void
 695 Perl_save_mortalizesv(pTHX_ SV *sv)
 696 {
 697     PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
 698
 699     save_mortalizesv(sv);
 700 }
 701
 702 void
 703 Perl_save_freeop(pTHX_ OP *o)
 704 {
 705     save_freeop(o);
 706 }
 707
 708 void
 709 Perl_save_freepv(pTHX_ char *pv)
 710 {
 711     save_freepv(pv);
 712 }
 713
 714 void
 715 Perl_save_op(pTHX)
 716 {
 717     save_op();
 718 }
 719
 720 #ifdef PERL_DONT_CREATE_GVSV
 721 GV *
 722 Perl_gv_SVadd(pTHX_ GV *gv)
 723 {
 724     return gv_SVadd(gv);
 725 }
 726 #endif
 727
 728 GV *
 729 Perl_gv_AVadd(pTHX_ GV *gv)
 730 {
 731     return gv_AVadd(gv);
 732 }
 733
 734 GV *
 735 Perl_gv_HVadd(pTHX_ GV *gv)
 736 {
 737     return gv_HVadd(gv);
 738 }
 739
 740 GV *
 741 Perl_gv_IOadd(pTHX_ GV *gv)
 742 {
 743     return gv_IOadd(gv);
 744 }
 745
 746 IO *
 747 Perl_newIO(pTHX)
 748 {
 749     return MUTABLE_IO(newSV_type(SVt_PVIO));
 750 }
 751
 752 I32
 753 Perl_my_stat(pTHX)
 754 {
 755     return my_stat_flags(SV_GMAGIC);
 756 }
 757
 758 I32
 759 Perl_my_lstat(pTHX)
 760 {
 761     return my_lstat_flags(SV_GMAGIC);
 762 }
 763
 764 I32
 765 Perl_sv_eq(pTHX_ SV *sv1, SV *sv2)
 766 {
 767     return sv_eq_flags(sv1, sv2, SV_GMAGIC);
 768 }
 769
 770 #ifdef USE_LOCALE_COLLATE
 771 char *
 772 Perl_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
 780 bool
 781 Perl_sv_2bool(pTHX_ SV *const sv)
 782 {
 783     PERL_ARGS_ASSERT_SV_2BOOL;
 784     return sv_2bool_flags(sv, SV_GMAGIC);
 785 }
 786
 787 CV *
 788 Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block)
 789 {
 790     return newATTRSUB(floor, o, proto, NULL, block);
 791 }
 792
 793 SV *
 794 Perl_sv_mortalcopy(pTHX_ SV *const oldsv)
 795 {
 796     return Perl_sv_mortalcopy_flags(aTHX_ oldsv, SV_GMAGIC);
 797 }
 798
 799 void
 800 Perl_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
 811 This is identical to the macro L<perlapi/isUTF8_CHAR>.
 812
 813 =cut */
 814
 815 STRLEN
 816 Perl_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
 828 Returns the Unicode code point of the first character in the string C<s>
 829 which is assumed to be in UTF-8 encoding; C<retlen> will be set to the
 830 length, in bytes, of that character.
 831
 832 Some, but not all, UTF-8 malformations are detected, and in fact, some
 833 malformed input could cause reading beyond the end of the input buffer, which
 834 is one reason why this function is deprecated.  The other is that only in
 835 extremely limited circumstances should the Unicode versus native code point be
 836 of any interest to you.
 837
 838 If C<s> points to one of the detected malformations, and UTF8 warnings are
 839 enabled, zero is returned and C<*retlen> is set (if C<retlen> doesn't point to
 840 NULL) to -1.  If those warnings are off, the computed value if well-defined (or
 841 the Unicode REPLACEMENT CHARACTER, if not) is silently returned, and C<*retlen>
 842 is set (if C<retlen> isn't NULL) so that (S<C<s> + C<*retlen>>) is the
 843 next possible position in C<s> that could begin a non-malformed character.
 844 See L<perlapi/utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is returned.
 845
 846 =cut
 847 */
 848
 849 UV
 850 Perl_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
 861 char *
 862 Perl_instr(const char *big, const char *little)
 863 {
 864     PERL_ARGS_ASSERT_INSTR;
 865
 866     return instr(big, little);
 867 }
 868
 869 SV *
 870 Perl_newSVsv(pTHX_ SV *const old)
 871 {
 872     return newSVsv(old);
 873 }
 874
 875 bool
 876 Perl_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
 883 char *
 884 Perl_sv_2pvutf8(pTHX_ SV *sv, STRLEN *const lp)
 885 {
 886     PERL_ARGS_ASSERT_SV_2PVUTF8;
 887
 888     return sv_2pvutf8(sv, lp);
 889 }
 890
 891 char *
 892 Perl_sv_2pvbyte(pTHX_ SV *sv, STRLEN *const lp)
 893 {
 894     PERL_ARGS_ASSERT_SV_2PVBYTE;
 895
 896     return sv_2pvbyte(sv, lp);
 897 }
 898
 899 U8 *
 900 Perl_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
 911 Instead use L<perlapi/utf8_to_uvchr_buf>, or rarely, L<perlapi/utf8n_to_uvchr>.
 912
 913 This function was useful for code that wanted to handle both EBCDIC and
 914 ASCII platforms with Unicode properties, but starting in Perl v5.20, the
 915 distinctions between the platforms have mostly been made invisible to most
 916 code, so this function is quite unlikely to be what you want.  If you do need
 917 this precise functionality, use instead
 918 C<L<NATIVE_TO_UNI(utf8_to_uvchr_buf(...))|perlapi/utf8_to_uvchr_buf>>
 919 or C<L<NATIVE_TO_UNI(utf8n_to_uvchr(...))|perlapi/utf8n_to_uvchr>>.
 920
 921 =cut
 922 */
 923
 924 UV
 925 Perl_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
 936 Returns the native code point of the first character in the string C<s>
 937 which is assumed to be in UTF-8 encoding; C<retlen> will be set to the
 938 length, in bytes, of that character.
 939
 940 Some, but not all, UTF-8 malformations are detected, and in fact, some
 941 malformed input could cause reading beyond the end of the input buffer, which
 942 is why this function is deprecated.  Use L</utf8_to_uvchr_buf> instead.
 943
 944 If C<s> points to one of the detected malformations, and UTF8 warnings are
 945 enabled, zero is returned and C<*retlen> is set (if C<retlen> isn't
 946 C<NULL>) to -1.  If those warnings are off, the computed value if well-defined (or
 947 the Unicode REPLACEMENT CHARACTER, if not) is silently returned, and C<*retlen>
 948 is set (if C<retlen> isn't NULL) so that (S<C<s> + C<*retlen>>) is the
 949 next possible position in C<s> that could begin a non-malformed character.
 950 See L</utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is returned.
 951
 952 =cut
 953 */
 954
 955 UV
 956 Perl_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
 973 GCC_DIAG_RESTORE
 974
 975 #endif /* NO_MATHOMS */
 976
 977 /*
 978  * ex: set ts=8 sts=4 sw=4 et:
 979  */