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