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.  For binary or source compatibility reasons, though,
  25  * we cannot completely remove them from the core code.
  26  *
  27  * REMEMBER to update makedef.pl when adding a function to mathoms.c whose
  28  * name doesn't begin with "Perl_".
  29  *
  30  * SMP - Oct. 24, 2005
  31  *
  32  * The compilation of this file can be suppressed; see INSTALL
  33  *
  34 =head1 Obsolete backwards compatibility functions
  35 Some of these are also deprecated.  You can exclude these from
  36 your compiled Perl by adding this option to Configure:
  37 C<-Accflags='-DNO_MATHOMS'>
  38
  39 =cut
  40
  41  */
  42
  43
  44 #include "EXTERN.h"
  45 #define PERL_IN_MATHOMS_C
  46 #include "perl.h"
  47
  48 #ifdef NO_MATHOMS
  49 /* ..." warning: ISO C forbids an empty source file"
  50    So make sure we have something in here by processing the headers anyway.
  51  */
  52 #else
  53
  54 /* All functions in this file should have an entry with the 'b' flag in embed.fnc */
  55
  56 /* ref() is now a macro using Perl_doref;
  57  * this version provided for binary compatibility only.
  58  */
  59 OP *
  60 Perl_ref(pTHX_ OP *o, I32 type)
  61 {
  62     return doref(o, type, TRUE);
  63 }
  64
  65 /*
  66 =for apidoc sv_unref
  67
  68 Unsets the RV status of the SV, and decrements the reference count of
  69 whatever was being referenced by the RV.  This can almost be thought of
  70 as a reversal of C<newSVrv>.  This is C<sv_unref_flags> with the C<flag>
  71 being zero.  See C<L</SvROK_off>>.
  72
  73 =cut
  74 */
  75
  76 void
  77 Perl_sv_unref(pTHX_ SV *sv)
  78 {
  79     PERL_ARGS_ASSERT_SV_UNREF;
  80
  81     sv_unref_flags(sv, 0);
  82 }
  83
  84 /*
  85 =for apidoc sv_taint
  86
  87 Taint an SV.  Use C<SvTAINTED_on> instead.
  88
  89 =cut
  90 */
  91
  92 void
  93 Perl_sv_taint(pTHX_ SV *sv)
  94 {
  95     PERL_ARGS_ASSERT_SV_TAINT;
  96
  97     sv_magic((sv), NULL, PERL_MAGIC_taint, NULL, 0);
  98 }
  99
 100 /* sv_2iv() is now a macro using Perl_sv_2iv_flags();
 101  * this function provided for binary compatibility only
 102  */
 103
 104 IV
 105 Perl_sv_2iv(pTHX_ SV *sv)
 106 {
 107     PERL_ARGS_ASSERT_SV_2IV;
 108
 109     return sv_2iv_flags(sv, SV_GMAGIC);
 110 }
 111
 112 /* sv_2uv() is now a macro using Perl_sv_2uv_flags();
 113  * this function provided for binary compatibility only
 114  */
 115
 116 UV
 117 Perl_sv_2uv(pTHX_ SV *sv)
 118 {
 119     PERL_ARGS_ASSERT_SV_2UV;
 120
 121     return sv_2uv_flags(sv, SV_GMAGIC);
 122 }
 123
 124 /* sv_2nv() is now a macro using Perl_sv_2nv_flags();
 125  * this function provided for binary compatibility only
 126  */
 127
 128 NV
 129 Perl_sv_2nv(pTHX_ SV *sv)
 130 {
 131     return sv_2nv_flags(sv, SV_GMAGIC);
 132 }
 133
 134
 135 /* sv_2pv() is now a macro using Perl_sv_2pv_flags();
 136  * this function provided for binary compatibility only
 137  */
 138
 139 char *
 140 Perl_sv_2pv(pTHX_ SV *sv, STRLEN *lp)
 141 {
 142     PERL_ARGS_ASSERT_SV_2PV;
 143
 144     return sv_2pv_flags(sv, lp, SV_GMAGIC);
 145 }
 146
 147 /*
 148 =for apidoc sv_2pv_nolen
 149
 150 Like C<sv_2pv()>, but doesn't return the length too.  You should usually
 151 use the macro wrapper C<SvPV_nolen(sv)> instead.
 152
 153 =cut
 154 */
 155
 156 char *
 157 Perl_sv_2pv_nolen(pTHX_ SV *sv)
 158 {
 159     PERL_ARGS_ASSERT_SV_2PV_NOLEN;
 160     return sv_2pv(sv, NULL);
 161 }
 162
 163 /*
 164 =for apidoc sv_2pvbyte_nolen
 165
 166 Return a pointer to the byte-encoded representation of the SV.
 167 May cause the SV to be downgraded from UTF-8 as a side-effect.
 168
 169 Usually accessed via the C<SvPVbyte_nolen> macro.
 170
 171 =cut
 172 */
 173
 174 char *
 175 Perl_sv_2pvbyte_nolen(pTHX_ SV *sv)
 176 {
 177     PERL_ARGS_ASSERT_SV_2PVBYTE_NOLEN;
 178
 179     return sv_2pvbyte(sv, NULL);
 180 }
 181
 182 /*
 183 =for apidoc sv_2pvutf8_nolen
 184
 185 Return a pointer to the UTF-8-encoded representation of the SV.
 186 May cause the SV to be upgraded to UTF-8 as a side-effect.
 187
 188 Usually accessed via the C<SvPVutf8_nolen> macro.
 189
 190 =cut
 191 */
 192
 193 char *
 194 Perl_sv_2pvutf8_nolen(pTHX_ SV *sv)
 195 {
 196     PERL_ARGS_ASSERT_SV_2PVUTF8_NOLEN;
 197
 198     return sv_2pvutf8(sv, NULL);
 199 }
 200
 201 /*
 202 =for apidoc sv_force_normal
 203
 204 Undo various types of fakery on an SV: if the PV is a shared string, make
 205 a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
 206 an C<xpvmg>.  See also C<L</sv_force_normal_flags>>.
 207
 208 =cut
 209 */
 210
 211 void
 212 Perl_sv_force_normal(pTHX_ SV *sv)
 213 {
 214     PERL_ARGS_ASSERT_SV_FORCE_NORMAL;
 215
 216     sv_force_normal_flags(sv, 0);
 217 }
 218
 219 /* sv_setsv() is now a macro using Perl_sv_setsv_flags();
 220  * this function provided for binary compatibility only
 221  */
 222
 223 void
 224 Perl_sv_setsv(pTHX_ SV *dstr, SV *sstr)
 225 {
 226     PERL_ARGS_ASSERT_SV_SETSV;
 227
 228     sv_setsv_flags(dstr, sstr, SV_GMAGIC);
 229 }
 230
 231 /* sv_catpvn() is now a macro using Perl_sv_catpvn_flags();
 232  * this function provided for binary compatibility only
 233  */
 234
 235 void
 236 Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen)
 237 {
 238     PERL_ARGS_ASSERT_SV_CATPVN;
 239
 240     sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC);
 241 }
 242
 243 /*
 244 =for apidoc sv_catpvn_mg
 245
 246 Like C<sv_catpvn>, but also handles 'set' magic.
 247
 248 =cut
 249 */
 250
 251 void
 252 Perl_sv_catpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len)
 253 {
 254     PERL_ARGS_ASSERT_SV_CATPVN_MG;
 255
 256     sv_catpvn_flags(sv,ptr,len,SV_GMAGIC|SV_SMAGIC);
 257 }
 258
 259 /* sv_catsv() is now a macro using Perl_sv_catsv_flags();
 260  * this function provided for binary compatibility only
 261  */
 262
 263 void
 264 Perl_sv_catsv(pTHX_ SV *dstr, SV *sstr)
 265 {
 266     PERL_ARGS_ASSERT_SV_CATSV;
 267
 268     sv_catsv_flags(dstr, sstr, SV_GMAGIC);
 269 }
 270
 271 /*
 272 =for apidoc sv_catsv_mg
 273
 274 Like C<sv_catsv>, but also handles 'set' magic.
 275
 276 =cut
 277 */
 278
 279 void
 280 Perl_sv_catsv_mg(pTHX_ SV *dsv, SV *ssv)
 281 {
 282     PERL_ARGS_ASSERT_SV_CATSV_MG;
 283
 284     sv_catsv_flags(dsv,ssv,SV_GMAGIC|SV_SMAGIC);
 285 }
 286
 287 /*
 288 =for apidoc sv_iv
 289
 290 A private implementation of the C<SvIVx> macro for compilers which can't
 291 cope with complex macro expressions.  Always use the macro instead.
 292
 293 =cut
 294 */
 295
 296 IV
 297 Perl_sv_iv(pTHX_ SV *sv)
 298 {
 299     PERL_ARGS_ASSERT_SV_IV;
 300
 301     if (SvIOK(sv)) {
 302         if (SvIsUV(sv))
 303             return (IV)SvUVX(sv);
 304         return SvIVX(sv);
 305     }
 306     return sv_2iv(sv);
 307 }
 308
 309 /*
 310 =for apidoc sv_uv
 311
 312 A private implementation of the C<SvUVx> macro for compilers which can't
 313 cope with complex macro expressions.  Always use the macro instead.
 314
 315 =cut
 316 */
 317
 318 UV
 319 Perl_sv_uv(pTHX_ SV *sv)
 320 {
 321     PERL_ARGS_ASSERT_SV_UV;
 322
 323     if (SvIOK(sv)) {
 324         if (SvIsUV(sv))
 325             return SvUVX(sv);
 326         return (UV)SvIVX(sv);
 327     }
 328     return sv_2uv(sv);
 329 }
 330
 331 /*
 332 =for apidoc sv_nv
 333
 334 A private implementation of the C<SvNVx> macro for compilers which can't
 335 cope with complex macro expressions.  Always use the macro instead.
 336
 337 =cut
 338 */
 339
 340 NV
 341 Perl_sv_nv(pTHX_ SV *sv)
 342 {
 343     PERL_ARGS_ASSERT_SV_NV;
 344
 345     if (SvNOK(sv))
 346         return SvNVX(sv);
 347     return sv_2nv(sv);
 348 }
 349
 350 /*
 351 =for apidoc sv_pv
 352
 353 Use the C<SvPV_nolen> macro instead
 354
 355 =for apidoc sv_pvn
 356
 357 A private implementation of the C<SvPV> macro for compilers which can't
 358 cope with complex macro expressions.  Always use the macro instead.
 359
 360 =cut
 361 */
 362
 363 char *
 364 Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp)
 365 {
 366     PERL_ARGS_ASSERT_SV_PVN;
 367
 368     if (SvPOK(sv)) {
 369         *lp = SvCUR(sv);
 370         return SvPVX(sv);
 371     }
 372     return sv_2pv(sv, lp);
 373 }
 374
 375
 376 char *
 377 Perl_sv_pvn_nomg(pTHX_ SV *sv, STRLEN *lp)
 378 {
 379     PERL_ARGS_ASSERT_SV_PVN_NOMG;
 380
 381     if (SvPOK(sv)) {
 382         *lp = SvCUR(sv);
 383         return SvPVX(sv);
 384     }
 385     return sv_2pv_flags(sv, lp, 0);
 386 }
 387
 388 /* sv_pv() is now a macro using SvPV_nolen();
 389  * this function provided for binary compatibility only
 390  */
 391
 392 char *
 393 Perl_sv_pv(pTHX_ SV *sv)
 394 {
 395     PERL_ARGS_ASSERT_SV_PV;
 396
 397     if (SvPOK(sv))
 398         return SvPVX(sv);
 399
 400     return sv_2pv(sv, NULL);
 401 }
 402
 403 /* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags();
 404  * this function provided for binary compatibility only
 405  */
 406
 407 char *
 408 Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
 409 {
 410     PERL_ARGS_ASSERT_SV_PVN_FORCE;
 411
 412     return sv_pvn_force_flags(sv, lp, SV_GMAGIC);
 413 }
 414
 415 /* sv_pvbyte () is now a macro using Perl_sv_2pv_flags();
 416  * this function provided for binary compatibility only
 417  */
 418
 419 char *
 420 Perl_sv_pvbyte(pTHX_ SV *sv)
 421 {
 422     PERL_ARGS_ASSERT_SV_PVBYTE;
 423
 424     sv_utf8_downgrade(sv, FALSE);
 425     return sv_pv(sv);
 426 }
 427
 428 /*
 429 =for apidoc sv_pvbyte
 430
 431 Use C<SvPVbyte_nolen> instead.
 432
 433 =for apidoc sv_pvbyten
 434
 435 A private implementation of the C<SvPVbyte> macro for compilers
 436 which can't cope with complex macro expressions.  Always use the macro
 437 instead.
 438
 439 =cut
 440 */
 441
 442 char *
 443 Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp)
 444 {
 445     PERL_ARGS_ASSERT_SV_PVBYTEN;
 446
 447     sv_utf8_downgrade(sv, FALSE);
 448     return sv_pvn(sv,lp);
 449 }
 450
 451 /* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags();
 452  * this function provided for binary compatibility only
 453  */
 454
 455 char *
 456 Perl_sv_pvutf8(pTHX_ SV *sv)
 457 {
 458     PERL_ARGS_ASSERT_SV_PVUTF8;
 459
 460     sv_utf8_upgrade(sv);
 461     return sv_pv(sv);
 462 }
 463
 464 /*
 465 =for apidoc sv_pvutf8
 466
 467 Use the C<SvPVutf8_nolen> macro instead
 468
 469 =for apidoc sv_pvutf8n
 470
 471 A private implementation of the C<SvPVutf8> macro for compilers
 472 which can't cope with complex macro expressions.  Always use the macro
 473 instead.
 474
 475 =cut
 476 */
 477
 478 char *
 479 Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp)
 480 {
 481     PERL_ARGS_ASSERT_SV_PVUTF8N;
 482
 483     sv_utf8_upgrade(sv);
 484     return sv_pvn(sv,lp);
 485 }
 486
 487 /* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags();
 488  * this function provided for binary compatibility only
 489  */
 490
 491 STRLEN
 492 Perl_sv_utf8_upgrade(pTHX_ SV *sv)
 493 {
 494     PERL_ARGS_ASSERT_SV_UTF8_UPGRADE;
 495
 496     return sv_utf8_upgrade_flags(sv, SV_GMAGIC);
 497 }
 498
 499 int
 500 Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
 501 {
 502     int ret = 0;
 503     va_list(arglist);
 504
 505     /* Easier to special case this here than in embed.pl. (Look at what it
 506        generates for proto.h) */
 507 #ifdef PERL_IMPLICIT_CONTEXT
 508     PERL_ARGS_ASSERT_FPRINTF_NOCONTEXT;
 509 #endif
 510
 511     va_start(arglist, format);
 512     ret = PerlIO_vprintf(stream, format, arglist);
 513     va_end(arglist);
 514     return ret;
 515 }
 516
 517 int
 518 Perl_printf_nocontext(const char *format, ...)
 519 {
 520     dTHX;
 521     va_list(arglist);
 522     int ret = 0;
 523
 524 #ifdef PERL_IMPLICIT_CONTEXT
 525     PERL_ARGS_ASSERT_PRINTF_NOCONTEXT;
 526 #endif
 527
 528     va_start(arglist, format);
 529     ret = PerlIO_vprintf(PerlIO_stdout(), format, arglist);
 530     va_end(arglist);
 531     return ret;
 532 }
 533
 534 #if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL))
 535 /*
 536  * This hack is to force load of "huge" support from libm.a
 537  * So it is in perl for (say) POSIX to use.
 538  * Needed for SunOS with Sun's 'acc' for example.
 539  */
 540 NV
 541 Perl_huge(void)
 542 {
 543 #  if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
 544     return HUGE_VALL;
 545 #  else
 546     return HUGE_VAL;
 547 #  endif
 548 }
 549 #endif
 550
 551 /* compatibility with versions <= 5.003. */
 552 void
 553 Perl_gv_fullname(pTHX_ SV *sv, const GV *gv)
 554 {
 555     PERL_ARGS_ASSERT_GV_FULLNAME;
 556
 557     gv_fullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
 558 }
 559
 560 /* compatibility with versions <= 5.003. */
 561 void
 562 Perl_gv_efullname(pTHX_ SV *sv, const GV *gv)
 563 {
 564     PERL_ARGS_ASSERT_GV_EFULLNAME;
 565
 566     gv_efullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
 567 }
 568
 569 void
 570 Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
 571 {
 572     PERL_ARGS_ASSERT_GV_FULLNAME3;
 573
 574     gv_fullname4(sv, gv, prefix, TRUE);
 575 }
 576
 577 void
 578 Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
 579 {
 580     PERL_ARGS_ASSERT_GV_EFULLNAME3;
 581
 582     gv_efullname4(sv, gv, prefix, TRUE);
 583 }
 584
 585 /*
 586 =for apidoc gv_fetchmethod
 587
 588 See L</gv_fetchmethod_autoload>.
 589
 590 =cut
 591 */
 592
 593 GV *
 594 Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name)
 595 {
 596     PERL_ARGS_ASSERT_GV_FETCHMETHOD;
 597
 598     return gv_fetchmethod_autoload(stash, name, TRUE);
 599 }
 600
 601 HE *
 602 Perl_hv_iternext(pTHX_ HV *hv)
 603 {
 604     PERL_ARGS_ASSERT_HV_ITERNEXT;
 605
 606     return hv_iternext_flags(hv, 0);
 607 }
 608
 609 void
 610 Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
 611 {
 612     PERL_ARGS_ASSERT_HV_MAGIC;
 613
 614     sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0);
 615 }
 616
 617 bool
 618 Perl_do_open(pTHX_ GV *gv, const char *name, I32 len, int as_raw,
 619              int rawmode, int rawperm, PerlIO *supplied_fp)
 620 {
 621     PERL_ARGS_ASSERT_DO_OPEN;
 622
 623     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
 624                     supplied_fp, (SV **) NULL, 0);
 625 }
 626
 627 bool
 628 Perl_do_open9(pTHX_ GV *gv, const char *name, I32 len, int
 629 as_raw,
 630               int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
 631               I32 num_svs)
 632 {
 633     PERL_ARGS_ASSERT_DO_OPEN9;
 634
 635     PERL_UNUSED_ARG(num_svs);
 636     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
 637                     supplied_fp, &svs, 1);
 638 }
 639
 640 int
 641 Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
 642 {
 643  /* The old body of this is now in non-LAYER part of perlio.c
 644   * This is a stub for any XS code which might have been calling it.
 645   */
 646  const char *name = ":raw";
 647
 648  PERL_ARGS_ASSERT_DO_BINMODE;
 649
 650 #ifdef PERLIO_USING_CRLF
 651  if (!(mode & O_BINARY))
 652      name = ":crlf";
 653 #endif
 654  return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
 655 }
 656
 657 #ifndef OS2
 658 bool
 659 Perl_do_aexec(pTHX_ SV *really, SV **mark, SV **sp)
 660 {
 661     PERL_ARGS_ASSERT_DO_AEXEC;
 662
 663     return do_aexec5(really, mark, sp, 0, 0);
 664 }
 665 #endif
 666
 667 /* Backwards compatibility. */
 668 int
 669 Perl_init_i18nl14n(pTHX_ int printwarn)
 670 {
 671     return init_i18nl10n(printwarn);
 672 }
 673
 674 bool
 675 Perl_is_utf8_string_loc(const U8 *s, STRLEN len, const U8 **ep)
 676 {
 677     PERL_ARGS_ASSERT_IS_UTF8_STRING_LOC;
 678
 679     return is_utf8_string_loclen(s, len, ep, 0);
 680 }
 681
 682 /*
 683 =for apidoc sv_nolocking
 684
 685 Dummy routine which "locks" an SV when there is no locking module present.
 686 Exists to avoid test for a C<NULL> function pointer and because it could
 687 potentially warn under some level of strict-ness.
 688
 689 "Superseded" by C<sv_nosharing()>.
 690
 691 =cut
 692 */
 693
 694 void
 695 Perl_sv_nolocking(pTHX_ SV *sv)
 696 {
 697     PERL_UNUSED_CONTEXT;
 698     PERL_UNUSED_ARG(sv);
 699 }
 700
 701
 702 /*
 703 =for apidoc sv_nounlocking
 704
 705 Dummy routine which "unlocks" an SV when there is no locking module present.
 706 Exists to avoid test for a C<NULL> function pointer and because it could
 707 potentially warn under some level of strict-ness.
 708
 709 "Superseded" by C<sv_nosharing()>.
 710
 711 =cut
 712 */
 713
 714 void
 715 Perl_sv_nounlocking(pTHX_ SV *sv)
 716 {
 717     PERL_UNUSED_CONTEXT;
 718     PERL_UNUSED_ARG(sv);
 719 }
 720
 721 void
 722 Perl_save_long(pTHX_ long int *longp)
 723 {
 724     PERL_ARGS_ASSERT_SAVE_LONG;
 725
 726     SSCHECK(3);
 727     SSPUSHLONG(*longp);
 728     SSPUSHPTR(longp);
 729     SSPUSHUV(SAVEt_LONG);
 730 }
 731
 732 void
 733 Perl_save_iv(pTHX_ IV *ivp)
 734 {
 735     PERL_ARGS_ASSERT_SAVE_IV;
 736
 737     SSCHECK(3);
 738     SSPUSHIV(*ivp);
 739     SSPUSHPTR(ivp);
 740     SSPUSHUV(SAVEt_IV);
 741 }
 742
 743 void
 744 Perl_save_nogv(pTHX_ GV *gv)
 745 {
 746     PERL_ARGS_ASSERT_SAVE_NOGV;
 747
 748     SSCHECK(2);
 749     SSPUSHPTR(gv);
 750     SSPUSHUV(SAVEt_NSTAB);
 751 }
 752
 753 void
 754 Perl_save_list(pTHX_ SV **sarg, I32 maxsarg)
 755 {
 756     I32 i;
 757
 758     PERL_ARGS_ASSERT_SAVE_LIST;
 759
 760     for (i = 1; i <= maxsarg; i++) {
 761         SV *sv;
 762         SvGETMAGIC(sarg[i]);
 763         sv = newSV(0);
 764         sv_setsv_nomg(sv,sarg[i]);
 765         SSCHECK(3);
 766         SSPUSHPTR(sarg[i]);             /* remember the pointer */
 767         SSPUSHPTR(sv);                  /* remember the value */
 768         SSPUSHUV(SAVEt_ITEM);
 769     }
 770 }
 771
 772 /*
 773 =for apidoc sv_usepvn_mg
 774
 775 Like C<sv_usepvn>, but also handles 'set' magic.
 776
 777 =cut
 778 */
 779
 780 void
 781 Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
 782 {
 783     PERL_ARGS_ASSERT_SV_USEPVN_MG;
 784
 785     sv_usepvn_flags(sv,ptr,len, SV_SMAGIC);
 786 }
 787
 788 /*
 789 =for apidoc sv_usepvn
 790
 791 Tells an SV to use C<ptr> to find its string value.  Implemented by
 792 calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
 793 magic.  See C<L</sv_usepvn_flags>>.
 794
 795 =cut
 796 */
 797
 798 void
 799 Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
 800 {
 801     PERL_ARGS_ASSERT_SV_USEPVN;
 802
 803     sv_usepvn_flags(sv,ptr,len, 0);
 804 }
 805
 806 /*
 807 =for apidoc unpack_str
 808
 809 The engine implementing C<unpack()> Perl function.  Note: parameters C<strbeg>,
 810 C<new_s> and C<ocnt> are not used.  This call should not be used, use
 811 C<unpackstring> instead.
 812
 813 =cut */
 814
 815 I32
 816 Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s,
 817                 const char *strbeg, const char *strend, char **new_s, I32 ocnt,
 818                 U32 flags)
 819 {
 820     PERL_ARGS_ASSERT_UNPACK_STR;
 821
 822     PERL_UNUSED_ARG(strbeg);
 823     PERL_UNUSED_ARG(new_s);
 824     PERL_UNUSED_ARG(ocnt);
 825
 826     return unpackstring(pat, patend, s, strend, flags);
 827 }
 828
 829 /*
 830 =for apidoc pack_cat
 831
 832 The engine implementing C<pack()> Perl function.  Note: parameters
 833 C<next_in_list> and C<flags> are not used.  This call should not be used; use
 834 C<packlist> instead.
 835
 836 =cut
 837 */
 838
 839 void
 840 Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
 841 {
 842     PERL_ARGS_ASSERT_PACK_CAT;
 843
 844     PERL_UNUSED_ARG(next_in_list);
 845     PERL_UNUSED_ARG(flags);
 846
 847     packlist(cat, pat, patend, beglist, endlist);
 848 }
 849
 850 HE *
 851 Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
 852 {
 853   return (HE *)hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash);
 854 }
 855
 856 bool
 857 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
 858 {
 859     PERL_ARGS_ASSERT_HV_EXISTS_ENT;
 860
 861     return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)
 862         ? TRUE : FALSE;
 863 }
 864
 865 HE *
 866 Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash)
 867 {
 868     PERL_ARGS_ASSERT_HV_FETCH_ENT;
 869
 870     return (HE *)hv_common(hv, keysv, NULL, 0, 0,
 871                      (lval ? HV_FETCH_LVALUE : 0), NULL, hash);
 872 }
 873
 874 SV *
 875 Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
 876 {
 877     PERL_ARGS_ASSERT_HV_DELETE_ENT;
 878
 879     return MUTABLE_SV(hv_common(hv, keysv, NULL, 0, 0, flags | HV_DELETE, NULL,
 880                                 hash));
 881 }
 882
 883 SV**
 884 Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash,
 885                     int flags)
 886 {
 887     return (SV**) hv_common(hv, NULL, key, klen, flags,
 888                             (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
 889 }
 890
 891 SV**
 892 Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
 893 {
 894     STRLEN klen;
 895     int flags;
 896
 897     if (klen_i32 < 0) {
 898         klen = -klen_i32;
 899         flags = HVhek_UTF8;
 900     } else {
 901         klen = klen_i32;
 902         flags = 0;
 903     }
 904     return (SV **) hv_common(hv, NULL, key, klen, flags,
 905                              (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
 906 }
 907
 908 bool
 909 Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32)
 910 {
 911     STRLEN klen;
 912     int flags;
 913
 914     PERL_ARGS_ASSERT_HV_EXISTS;
 915
 916     if (klen_i32 < 0) {
 917         klen = -klen_i32;
 918         flags = HVhek_UTF8;
 919     } else {
 920         klen = klen_i32;
 921         flags = 0;
 922     }
 923     return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)
 924         ? TRUE : FALSE;
 925 }
 926
 927 SV**
 928 Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
 929 {
 930     STRLEN klen;
 931     int flags;
 932
 933     PERL_ARGS_ASSERT_HV_FETCH;
 934
 935     if (klen_i32 < 0) {
 936         klen = -klen_i32;
 937         flags = HVhek_UTF8;
 938     } else {
 939         klen = klen_i32;
 940         flags = 0;
 941     }
 942     return (SV **) hv_common(hv, NULL, key, klen, flags,
 943                              lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE)
 944                              : HV_FETCH_JUST_SV, NULL, 0);
 945 }
 946
 947 SV *
 948 Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
 949 {
 950     STRLEN klen;
 951     int k_flags;
 952
 953     PERL_ARGS_ASSERT_HV_DELETE;
 954
 955     if (klen_i32 < 0) {
 956         klen = -klen_i32;
 957         k_flags = HVhek_UTF8;
 958     } else {
 959         klen = klen_i32;
 960         k_flags = 0;
 961     }
 962     return MUTABLE_SV(hv_common(hv, NULL, key, klen, k_flags, flags | HV_DELETE,
 963                                 NULL, 0));
 964 }
 965
 966 AV *
 967 Perl_newAV(pTHX)
 968 {
 969     return MUTABLE_AV(newSV_type(SVt_PVAV));
 970     /* sv_upgrade does AvREAL_only():
 971     AvALLOC(av) = 0;
 972     AvARRAY(av) = NULL;
 973     AvMAX(av) = AvFILLp(av) = -1; */
 974 }
 975
 976 HV *
 977 Perl_newHV(pTHX)
 978 {
 979     HV * const hv = MUTABLE_HV(newSV_type(SVt_PVHV));
 980     assert(!SvOK(hv));
 981
 982     return hv;
 983 }
 984
 985 void
 986 Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len,
 987               const char *const little, const STRLEN littlelen)
 988 {
 989     PERL_ARGS_ASSERT_SV_INSERT;
 990     sv_insert_flags(bigstr, offset, len, little, littlelen, SV_GMAGIC);
 991 }
 992
 993 void
 994 Perl_save_freesv(pTHX_ SV *sv)
 995 {
 996     save_freesv(sv);
 997 }
 998
 999 void
1000 Perl_save_mortalizesv(pTHX_ SV *sv)
1001 {
1002     PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
1003
1004     save_mortalizesv(sv);
1005 }
1006
1007 void
1008 Perl_save_freeop(pTHX_ OP *o)
1009 {
1010     save_freeop(o);
1011 }
1012
1013 void
1014 Perl_save_freepv(pTHX_ char *pv)
1015 {
1016     save_freepv(pv);
1017 }
1018
1019 void
1020 Perl_save_op(pTHX)
1021 {
1022     save_op();
1023 }
1024
1025 #ifdef PERL_DONT_CREATE_GVSV
1026 GV *
1027 Perl_gv_SVadd(pTHX_ GV *gv)
1028 {
1029     return gv_SVadd(gv);
1030 }
1031 #endif
1032
1033 GV *
1034 Perl_gv_AVadd(pTHX_ GV *gv)
1035 {
1036     return gv_AVadd(gv);
1037 }
1038
1039 GV *
1040 Perl_gv_HVadd(pTHX_ GV *gv)
1041 {
1042     return gv_HVadd(gv);
1043 }
1044
1045 GV *
1046 Perl_gv_IOadd(pTHX_ GV *gv)
1047 {
1048     return gv_IOadd(gv);
1049 }
1050
1051 IO *
1052 Perl_newIO(pTHX)
1053 {
1054     return MUTABLE_IO(newSV_type(SVt_PVIO));
1055 }
1056
1057 I32
1058 Perl_my_stat(pTHX)
1059 {
1060     return my_stat_flags(SV_GMAGIC);
1061 }
1062
1063 I32
1064 Perl_my_lstat(pTHX)
1065 {
1066     return my_lstat_flags(SV_GMAGIC);
1067 }
1068
1069 I32
1070 Perl_sv_eq(pTHX_ SV *sv1, SV *sv2)
1071 {
1072     return sv_eq_flags(sv1, sv2, SV_GMAGIC);
1073 }
1074
1075 #ifdef USE_LOCALE_COLLATE
1076 char *
1077 Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp)
1078 {
1079     return sv_collxfrm_flags(sv, nxp, SV_GMAGIC);
1080 }
1081 #endif
1082
1083 bool
1084 Perl_sv_2bool(pTHX_ SV *const sv)
1085 {
1086     return sv_2bool_flags(sv, SV_GMAGIC);
1087 }
1088
1089
1090 /*
1091 =for apidoc custom_op_name
1092 Return the name for a given custom op.  This was once used by the C<OP_NAME>
1093 macro, but is no longer: it has only been kept for compatibility, and
1094 should not be used.
1095
1096 =for apidoc custom_op_desc
1097 Return the description of a given custom op.  This was once used by the
1098 C<OP_DESC> macro, but is no longer: it has only been kept for
1099 compatibility, and should not be used.
1100
1101 =cut
1102 */
1103
1104 const char*
1105 Perl_custom_op_name(pTHX_ const OP* o)
1106 {
1107     PERL_ARGS_ASSERT_CUSTOM_OP_NAME;
1108     return XopENTRYCUSTOM(o, xop_name);
1109 }
1110
1111 const char*
1112 Perl_custom_op_desc(pTHX_ const OP* o)
1113 {
1114     PERL_ARGS_ASSERT_CUSTOM_OP_DESC;
1115     return XopENTRYCUSTOM(o, xop_desc);
1116 }
1117
1118 CV *
1119 Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block)
1120 {
1121     return newATTRSUB(floor, o, proto, NULL, block);
1122 }
1123
1124 UV
1125 Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1126 {
1127     PERL_ARGS_ASSERT_TO_UTF8_FOLD;
1128
1129     return _to_utf8_fold_flags(p, ustrp, lenp, FOLD_FLAGS_FULL);
1130 }
1131
1132 UV
1133 Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1134 {
1135     PERL_ARGS_ASSERT_TO_UTF8_LOWER;
1136
1137     return _to_utf8_lower_flags(p, ustrp, lenp, FALSE);
1138 }
1139
1140 UV
1141 Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1142 {
1143     PERL_ARGS_ASSERT_TO_UTF8_TITLE;
1144
1145     return _to_utf8_title_flags(p, ustrp, lenp, FALSE);
1146 }
1147
1148 UV
1149 Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1150 {
1151     PERL_ARGS_ASSERT_TO_UTF8_UPPER;
1152
1153     return _to_utf8_upper_flags(p, ustrp, lenp, FALSE);
1154 }
1155
1156 SV *
1157 Perl_sv_mortalcopy(pTHX_ SV *const oldstr)
1158 {
1159     return Perl_sv_mortalcopy_flags(aTHX_ oldstr, SV_GMAGIC);
1160 }
1161
1162 void
1163 Perl_sv_copypv(pTHX_ SV *const dsv, SV *const ssv)
1164 {
1165     PERL_ARGS_ASSERT_SV_COPYPV;
1166
1167     sv_copypv_flags(dsv, ssv, 0);
1168 }
1169
1170 UV      /* Made into a function, so can be deprecated */
1171 NATIVE_TO_NEED(const UV enc, const UV ch)
1172 {
1173     PERL_UNUSED_ARG(enc);
1174     return ch;
1175 }
1176
1177 UV      /* Made into a function, so can be deprecated */
1178 ASCII_TO_NEED(const UV enc, const UV ch)
1179 {
1180     PERL_UNUSED_ARG(enc);
1181     return ch;
1182 }
1183
1184 bool      /* Made into a function, so can be deprecated */
1185 Perl_isIDFIRST_lazy(pTHX_ const char* p)
1186 {
1187     PERL_ARGS_ASSERT_ISIDFIRST_LAZY;
1188
1189     return isIDFIRST_lazy_if(p,1);
1190 }
1191
1192 bool      /* Made into a function, so can be deprecated */
1193 Perl_isALNUM_lazy(pTHX_ const char* p)
1194 {
1195     PERL_ARGS_ASSERT_ISALNUM_LAZY;
1196
1197     return isALNUM_lazy_if(p,1);
1198 }
1199
1200 bool
1201 Perl_is_uni_alnum(pTHX_ UV c)
1202 {
1203     return isWORDCHAR_uni(c);
1204 }
1205
1206 bool
1207 Perl_is_uni_alnumc(pTHX_ UV c)
1208 {
1209     return isALNUM_uni(c);
1210 }
1211
1212 bool
1213 Perl_is_uni_alpha(pTHX_ UV c)
1214 {
1215     return isALPHA_uni(c);
1216 }
1217
1218 bool
1219 Perl_is_uni_ascii(pTHX_ UV c)
1220 {
1221     PERL_UNUSED_CONTEXT;
1222     return isASCII_uni(c);
1223 }
1224
1225 bool
1226 Perl_is_uni_blank(pTHX_ UV c)
1227 {
1228     PERL_UNUSED_CONTEXT;
1229     return isBLANK_uni(c);
1230 }
1231
1232 bool
1233 Perl_is_uni_space(pTHX_ UV c)
1234 {
1235     PERL_UNUSED_CONTEXT;
1236     return isSPACE_uni(c);
1237 }
1238
1239 bool
1240 Perl_is_uni_digit(pTHX_ UV c)
1241 {
1242     PERL_UNUSED_CONTEXT;
1243     return isDIGIT_uni(c);
1244 }
1245
1246 bool
1247 Perl_is_uni_upper(pTHX_ UV c)
1248 {
1249     PERL_UNUSED_CONTEXT;
1250     return isUPPER_uni(c);
1251 }
1252
1253 bool
1254 Perl_is_uni_lower(pTHX_ UV c)
1255 {
1256     PERL_UNUSED_CONTEXT;
1257     return isLOWER_uni(c);
1258 }
1259
1260 bool
1261 Perl_is_uni_cntrl(pTHX_ UV c)
1262 {
1263     PERL_UNUSED_CONTEXT;
1264     return isCNTRL_L1(c);
1265 }
1266
1267 bool
1268 Perl_is_uni_graph(pTHX_ UV c)
1269 {
1270     PERL_UNUSED_CONTEXT;
1271     return isGRAPH_uni(c);
1272 }
1273
1274 bool
1275 Perl_is_uni_print(pTHX_ UV c)
1276 {
1277     PERL_UNUSED_CONTEXT;
1278     return isPRINT_uni(c);
1279 }
1280
1281 bool
1282 Perl_is_uni_punct(pTHX_ UV c)
1283 {
1284     PERL_UNUSED_CONTEXT;
1285     return isPUNCT_uni(c);
1286 }
1287
1288 bool
1289 Perl_is_uni_xdigit(pTHX_ UV c)
1290 {
1291     PERL_UNUSED_CONTEXT;
1292     return isXDIGIT_uni(c);
1293 }
1294
1295 bool
1296 Perl_is_uni_alnum_lc(pTHX_ UV c)
1297 {
1298     PERL_UNUSED_CONTEXT;
1299     return isWORDCHAR_LC_uvchr(c);
1300 }
1301
1302 bool
1303 Perl_is_uni_alnumc_lc(pTHX_ UV c)
1304 {
1305     PERL_UNUSED_CONTEXT;
1306     return isALPHANUMERIC_LC_uvchr(c);
1307 }
1308
1309 bool
1310 Perl_is_uni_idfirst_lc(pTHX_ UV c)
1311 {
1312     PERL_UNUSED_CONTEXT;
1313     /* XXX Should probably be something that resolves to the old IDFIRST, but
1314      * this function is deprecated, so not bothering */
1315     return isIDFIRST_LC_uvchr(c);
1316 }
1317
1318 bool
1319 Perl_is_uni_alpha_lc(pTHX_ UV c)
1320 {
1321     PERL_UNUSED_CONTEXT;
1322     return isALPHA_LC_uvchr(c);
1323 }
1324
1325 bool
1326 Perl_is_uni_ascii_lc(pTHX_ UV c)
1327 {
1328     PERL_UNUSED_CONTEXT;
1329     return isASCII_LC_uvchr(c);
1330 }
1331
1332 bool
1333 Perl_is_uni_blank_lc(pTHX_ UV c)
1334 {
1335     PERL_UNUSED_CONTEXT;
1336     return isBLANK_LC_uvchr(c);
1337 }
1338
1339 bool
1340 Perl_is_uni_space_lc(pTHX_ UV c)
1341 {
1342     PERL_UNUSED_CONTEXT;
1343     return isSPACE_LC_uvchr(c);
1344 }
1345
1346 bool
1347 Perl_is_uni_digit_lc(pTHX_ UV c)
1348 {
1349     return isDIGIT_LC_uvchr(c);
1350 }
1351
1352 bool
1353 Perl_is_uni_idfirst(pTHX_ UV c)
1354 {
1355     U8 tmpbuf[UTF8_MAXBYTES+1];
1356     uvchr_to_utf8(tmpbuf, c);
1357     return _is_utf8_idstart(tmpbuf);
1358 }
1359
1360 bool
1361 Perl_is_utf8_idfirst(pTHX_ const U8 *p) /* The naming is historical. */
1362 {
1363     PERL_ARGS_ASSERT_IS_UTF8_IDFIRST;
1364
1365     return _is_utf8_idstart(p);
1366 }
1367
1368 bool
1369 Perl_is_utf8_xidfirst(pTHX_ const U8 *p) /* The naming is historical. */
1370 {
1371     PERL_ARGS_ASSERT_IS_UTF8_XIDFIRST;
1372
1373     return _is_utf8_xidstart(p);
1374 }
1375
1376 bool
1377 Perl_is_utf8_idcont(pTHX_ const U8 *p)
1378 {
1379     PERL_ARGS_ASSERT_IS_UTF8_IDCONT;
1380
1381     return _is_utf8_idcont(p);
1382 }
1383
1384 bool
1385 Perl_is_utf8_xidcont(pTHX_ const U8 *p)
1386 {
1387     PERL_ARGS_ASSERT_IS_UTF8_XIDCONT;
1388
1389     return _is_utf8_xidcont(p);
1390 }
1391
1392 bool
1393 Perl_is_uni_upper_lc(pTHX_ UV c)
1394 {
1395     return isUPPER_LC_uvchr(c);
1396 }
1397
1398 bool
1399 Perl_is_uni_lower_lc(pTHX_ UV c)
1400 {
1401     return isLOWER_LC_uvchr(c);
1402 }
1403
1404 bool
1405 Perl_is_uni_cntrl_lc(pTHX_ UV c)
1406 {
1407     return isCNTRL_LC_uvchr(c);
1408 }
1409
1410 bool
1411 Perl_is_uni_graph_lc(pTHX_ UV c)
1412 {
1413     return isGRAPH_LC_uvchr(c);
1414 }
1415
1416 bool
1417 Perl_is_uni_print_lc(pTHX_ UV c)
1418 {
1419     return isPRINT_LC_uvchr(c);
1420 }
1421
1422 bool
1423 Perl_is_uni_punct_lc(pTHX_ UV c)
1424 {
1425     return isPUNCT_LC_uvchr(c);
1426 }
1427
1428 bool
1429 Perl_is_uni_xdigit_lc(pTHX_ UV c)
1430 {
1431     return isXDIGIT_LC_uvchr(c);
1432 }
1433
1434 U32
1435 Perl_to_uni_upper_lc(pTHX_ U32 c)
1436 {
1437     /* XXX returns only the first character -- do not use XXX */
1438     /* XXX no locale support yet */
1439     STRLEN len;
1440     U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
1441     return (U32)to_uni_upper(c, tmpbuf, &len);
1442 }
1443
1444 U32
1445 Perl_to_uni_title_lc(pTHX_ U32 c)
1446 {
1447     /* XXX returns only the first character XXX -- do not use XXX */
1448     /* XXX no locale support yet */
1449     STRLEN len;
1450     U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
1451     return (U32)to_uni_title(c, tmpbuf, &len);
1452 }
1453
1454 U32
1455 Perl_to_uni_lower_lc(pTHX_ U32 c)
1456 {
1457     /* XXX returns only the first character -- do not use XXX */
1458     /* XXX no locale support yet */
1459     STRLEN len;
1460     U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
1461     return (U32)to_uni_lower(c, tmpbuf, &len);
1462 }
1463
1464 bool
1465 Perl_is_utf8_alnum(pTHX_ const U8 *p)
1466 {
1467     PERL_ARGS_ASSERT_IS_UTF8_ALNUM;
1468
1469     /* NOTE: "IsWord", not "IsAlnum", since Alnum is a true
1470      * descendant of isalnum(3), in other words, it doesn't
1471      * contain the '_'. --jhi */
1472     return isWORDCHAR_utf8(p);
1473 }
1474
1475 bool
1476 Perl_is_utf8_alnumc(pTHX_ const U8 *p)
1477 {
1478     PERL_ARGS_ASSERT_IS_UTF8_ALNUMC;
1479
1480     return isALPHANUMERIC_utf8(p);
1481 }
1482
1483 bool
1484 Perl_is_utf8_alpha(pTHX_ const U8 *p)
1485 {
1486     PERL_ARGS_ASSERT_IS_UTF8_ALPHA;
1487
1488     return isALPHA_utf8(p);
1489 }
1490
1491 bool
1492 Perl_is_utf8_ascii(pTHX_ const U8 *p)
1493 {
1494     PERL_ARGS_ASSERT_IS_UTF8_ASCII;
1495     PERL_UNUSED_CONTEXT;
1496
1497     return isASCII_utf8(p);
1498 }
1499
1500 bool
1501 Perl_is_utf8_blank(pTHX_ const U8 *p)
1502 {
1503     PERL_ARGS_ASSERT_IS_UTF8_BLANK;
1504     PERL_UNUSED_CONTEXT;
1505
1506     return isBLANK_utf8(p);
1507 }
1508
1509 bool
1510 Perl_is_utf8_space(pTHX_ const U8 *p)
1511 {
1512     PERL_ARGS_ASSERT_IS_UTF8_SPACE;
1513     PERL_UNUSED_CONTEXT;
1514
1515     return isSPACE_utf8(p);
1516 }
1517
1518 bool
1519 Perl_is_utf8_perl_space(pTHX_ const U8 *p)
1520 {
1521     PERL_ARGS_ASSERT_IS_UTF8_PERL_SPACE;
1522     PERL_UNUSED_CONTEXT;
1523
1524     /* Only true if is an ASCII space-like character, and ASCII is invariant
1525      * under utf8, so can just use the macro */
1526     return isSPACE_A(*p);
1527 }
1528
1529 bool
1530 Perl_is_utf8_perl_word(pTHX_ const U8 *p)
1531 {
1532     PERL_ARGS_ASSERT_IS_UTF8_PERL_WORD;
1533     PERL_UNUSED_CONTEXT;
1534
1535     /* Only true if is an ASCII word character, and ASCII is invariant
1536      * under utf8, so can just use the macro */
1537     return isWORDCHAR_A(*p);
1538 }
1539
1540 bool
1541 Perl_is_utf8_digit(pTHX_ const U8 *p)
1542 {
1543     PERL_ARGS_ASSERT_IS_UTF8_DIGIT;
1544
1545     return isDIGIT_utf8(p);
1546 }
1547
1548 bool
1549 Perl_is_utf8_posix_digit(pTHX_ const U8 *p)
1550 {
1551     PERL_ARGS_ASSERT_IS_UTF8_POSIX_DIGIT;
1552     PERL_UNUSED_CONTEXT;
1553
1554     /* Only true if is an ASCII digit character, and ASCII is invariant
1555      * under utf8, so can just use the macro */
1556     return isDIGIT_A(*p);
1557 }
1558
1559 bool
1560 Perl_is_utf8_upper(pTHX_ const U8 *p)
1561 {
1562     PERL_ARGS_ASSERT_IS_UTF8_UPPER;
1563
1564     return isUPPER_utf8(p);
1565 }
1566
1567 bool
1568 Perl_is_utf8_lower(pTHX_ const U8 *p)
1569 {
1570     PERL_ARGS_ASSERT_IS_UTF8_LOWER;
1571
1572     return isLOWER_utf8(p);
1573 }
1574
1575 bool
1576 Perl_is_utf8_cntrl(pTHX_ const U8 *p)
1577 {
1578     PERL_ARGS_ASSERT_IS_UTF8_CNTRL;
1579     PERL_UNUSED_CONTEXT;
1580
1581     return isCNTRL_utf8(p);
1582 }
1583
1584 bool
1585 Perl_is_utf8_graph(pTHX_ const U8 *p)
1586 {
1587     PERL_ARGS_ASSERT_IS_UTF8_GRAPH;
1588
1589     return isGRAPH_utf8(p);
1590 }
1591
1592 bool
1593 Perl_is_utf8_print(pTHX_ const U8 *p)
1594 {
1595     PERL_ARGS_ASSERT_IS_UTF8_PRINT;
1596
1597     return isPRINT_utf8(p);
1598 }
1599
1600 bool
1601 Perl_is_utf8_punct(pTHX_ const U8 *p)
1602 {
1603     PERL_ARGS_ASSERT_IS_UTF8_PUNCT;
1604
1605     return isPUNCT_utf8(p);
1606 }
1607
1608 bool
1609 Perl_is_utf8_xdigit(pTHX_ const U8 *p)
1610 {
1611     PERL_ARGS_ASSERT_IS_UTF8_XDIGIT;
1612     PERL_UNUSED_CONTEXT;
1613
1614     return isXDIGIT_utf8(p);
1615 }
1616
1617 bool
1618 Perl_is_utf8_mark(pTHX_ const U8 *p)
1619 {
1620     PERL_ARGS_ASSERT_IS_UTF8_MARK;
1621
1622     return _is_utf8_mark(p);
1623 }
1624
1625 /*
1626 =for apidoc is_utf8_char
1627
1628 Tests if some arbitrary number of bytes begins in a valid UTF-8
1629 character.  Note that an INVARIANT (i.e. ASCII on non-EBCDIC machines)
1630 character is a valid UTF-8 character.  The actual number of bytes in the UTF-8
1631 character will be returned if it is valid, otherwise 0.
1632
1633 This function is deprecated due to the possibility that malformed input could
1634 cause reading beyond the end of the input buffer.  Use L</isUTF8_CHAR>
1635 instead.
1636
1637 =cut */
1638
1639 STRLEN
1640 Perl_is_utf8_char(const U8 *s)
1641 {
1642     PERL_ARGS_ASSERT_IS_UTF8_CHAR;
1643
1644     /* Assumes we have enough space, which is why this is deprecated */
1645     return isUTF8_CHAR(s, s + UTF8SKIP(s));
1646 }
1647
1648 /*
1649 =for apidoc is_utf8_char_buf
1650
1651 This is identical to the macro L</isUTF8_CHAR>.
1652
1653 =cut */
1654
1655 STRLEN
1656 Perl_is_utf8_char_buf(const U8 *buf, const U8* buf_end)
1657 {
1658
1659     PERL_ARGS_ASSERT_IS_UTF8_CHAR_BUF;
1660
1661     return isUTF8_CHAR(buf, buf_end);
1662 }
1663
1664 /* DEPRECATED!
1665  * Like L</utf8_to_uvuni_buf>(), but should only be called when it is known that
1666  * there are no malformations in the input UTF-8 string C<s>.  Surrogates,
1667  * non-character code points, and non-Unicode code points are allowed */
1668
1669 UV
1670 Perl_valid_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen)
1671 {
1672     PERL_ARGS_ASSERT_VALID_UTF8_TO_UVUNI;
1673
1674     return NATIVE_TO_UNI(valid_utf8_to_uvchr(s, retlen));
1675 }
1676
1677 /*
1678 =for apidoc utf8_to_uvchr
1679
1680 Returns the native code point of the first character in the string C<s>
1681 which is assumed to be in UTF-8 encoding; C<retlen> will be set to the
1682 length, in bytes, of that character.
1683
1684 Some, but not all, UTF-8 malformations are detected, and in fact, some
1685 malformed input could cause reading beyond the end of the input buffer, which
1686 is why this function is deprecated.  Use L</utf8_to_uvchr_buf> instead.
1687
1688 If C<s> points to one of the detected malformations, and UTF8 warnings are
1689 enabled, zero is returned and C<*retlen> is set (if C<retlen> isn't
1690 C<NULL>) to -1.  If those warnings are off, the computed value if well-defined (or
1691 the Unicode REPLACEMENT CHARACTER, if not) is silently returned, and C<*retlen>
1692 is set (if C<retlen> isn't NULL) so that (S<C<s> + C<*retlen>>) is the
1693 next possible position in C<s> that could begin a non-malformed character.
1694 See L</utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is returned.
1695
1696 =cut
1697 */
1698
1699 UV
1700 Perl_utf8_to_uvchr(pTHX_ const U8 *s, STRLEN *retlen)
1701 {
1702     PERL_ARGS_ASSERT_UTF8_TO_UVCHR;
1703
1704     return utf8_to_uvchr_buf(s, s + UTF8_MAXBYTES, retlen);
1705 }
1706
1707 /*
1708 =for apidoc utf8_to_uvuni
1709
1710 Returns the Unicode code point of the first character in the string C<s>
1711 which is assumed to be in UTF-8 encoding; C<retlen> will be set to the
1712 length, in bytes, of that character.
1713
1714 Some, but not all, UTF-8 malformations are detected, and in fact, some
1715 malformed input could cause reading beyond the end of the input buffer, which
1716 is one reason why this function is deprecated.  The other is that only in
1717 extremely limited circumstances should the Unicode versus native code point be
1718 of any interest to you.  See L</utf8_to_uvuni_buf> for alternatives.
1719
1720 If C<s> points to one of the detected malformations, and UTF8 warnings are
1721 enabled, zero is returned and C<*retlen> is set (if C<retlen> doesn't point to
1722 NULL) to -1.  If those warnings are off, the computed value if well-defined (or
1723 the Unicode REPLACEMENT CHARACTER, if not) is silently returned, and C<*retlen>
1724 is set (if C<retlen> isn't NULL) so that (S<C<s> + C<*retlen>>) is the
1725 next possible position in C<s> that could begin a non-malformed character.
1726 See L</utf8n_to_uvchr> for details on when the REPLACEMENT CHARACTER is returned.
1727
1728 =cut
1729 */
1730
1731 UV
1732 Perl_utf8_to_uvuni(pTHX_ const U8 *s, STRLEN *retlen)
1733 {
1734     PERL_ARGS_ASSERT_UTF8_TO_UVUNI;
1735
1736     return NATIVE_TO_UNI(valid_utf8_to_uvchr(s, retlen));
1737 }
1738
1739 /*
1740 =for apidoc Am|HV *|pad_compname_type|PADOFFSET po
1741
1742 Looks up the type of the lexical variable at position C<po> in the
1743 currently-compiling pad.  If the variable is typed, the stash of the
1744 class to which it is typed is returned.  If not, C<NULL> is returned.
1745
1746 =cut
1747 */
1748
1749 HV *
1750 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
1751 {
1752     return PAD_COMPNAME_TYPE(po);
1753 }
1754
1755 /* return ptr to little string in big string, NULL if not found */
1756 /* The original version of this routine was donated by Corey Satten. */
1757
1758 char *
1759 Perl_instr(const char *big, const char *little)
1760 {
1761     PERL_ARGS_ASSERT_INSTR;
1762
1763     return instr((char *) big, (char *) little);
1764 }
1765
1766 #endif /* NO_MATHOMS */
1767
1768 /*
1769  * ex: set ts=8 sts=4 sw=4 et:
1770  */