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