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     va_list(arglist);
 548
 549     /* Easier to special case this here than in embed.pl. (Look at what it
 550        generates for proto.h) */
 551 #ifdef PERL_IMPLICIT_CONTEXT
 552     PERL_ARGS_ASSERT_FPRINTF_NOCONTEXT;
 553 #endif
 554
 555     va_start(arglist, format);
 556     return PerlIO_vprintf(stream, format, arglist);
 557 }
 558
 559 int
 560 Perl_printf_nocontext(const char *format, ...)
 561 {
 562     dTHX;
 563     va_list(arglist);
 564
 565 #ifdef PERL_IMPLICIT_CONTEXT
 566     PERL_ARGS_ASSERT_PRINTF_NOCONTEXT;
 567 #endif
 568
 569     va_start(arglist, format);
 570     return PerlIO_vprintf(PerlIO_stdout(), format, arglist);
 571 }
 572
 573 #if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL))
 574 /*
 575  * This hack is to force load of "huge" support from libm.a
 576  * So it is in perl for (say) POSIX to use.
 577  * Needed for SunOS with Sun's 'acc' for example.
 578  */
 579 NV
 580 Perl_huge(void)
 581 {
 582 #  if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
 583     return HUGE_VALL;
 584 #  else
 585     return HUGE_VAL;
 586 #  endif
 587 }
 588 #endif
 589
 590 /* compatibility with versions <= 5.003. */
 591 void
 592 Perl_gv_fullname(pTHX_ SV *sv, const GV *gv)
 593 {
 594     PERL_ARGS_ASSERT_GV_FULLNAME;
 595
 596     gv_fullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
 597 }
 598
 599 /* compatibility with versions <= 5.003. */
 600 void
 601 Perl_gv_efullname(pTHX_ SV *sv, const GV *gv)
 602 {
 603     PERL_ARGS_ASSERT_GV_EFULLNAME;
 604
 605     gv_efullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
 606 }
 607
 608 void
 609 Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
 610 {
 611     PERL_ARGS_ASSERT_GV_FULLNAME3;
 612
 613     gv_fullname4(sv, gv, prefix, TRUE);
 614 }
 615
 616 void
 617 Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
 618 {
 619     PERL_ARGS_ASSERT_GV_EFULLNAME3;
 620
 621     gv_efullname4(sv, gv, prefix, TRUE);
 622 }
 623
 624 /*
 625 =for apidoc gv_fetchmethod
 626
 627 See L</gv_fetchmethod_autoload>.
 628
 629 =cut
 630 */
 631
 632 GV *
 633 Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name)
 634 {
 635     PERL_ARGS_ASSERT_GV_FETCHMETHOD;
 636
 637     return gv_fetchmethod_autoload(stash, name, TRUE);
 638 }
 639
 640 HE *
 641 Perl_hv_iternext(pTHX_ HV *hv)
 642 {
 643     PERL_ARGS_ASSERT_HV_ITERNEXT;
 644
 645     return hv_iternext_flags(hv, 0);
 646 }
 647
 648 void
 649 Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
 650 {
 651     PERL_ARGS_ASSERT_HV_MAGIC;
 652
 653     sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0);
 654 }
 655
 656 bool
 657 Perl_do_open(pTHX_ GV *gv, const char *name, I32 len, int as_raw,
 658              int rawmode, int rawperm, PerlIO *supplied_fp)
 659 {
 660     PERL_ARGS_ASSERT_DO_OPEN;
 661
 662     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
 663                     supplied_fp, (SV **) NULL, 0);
 664 }
 665
 666 bool
 667 Perl_do_open9(pTHX_ GV *gv, const char *name, I32 len, int
 668 as_raw,
 669               int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
 670               I32 num_svs)
 671 {
 672     PERL_ARGS_ASSERT_DO_OPEN9;
 673
 674     PERL_UNUSED_ARG(num_svs);
 675     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
 676                     supplied_fp, &svs, 1);
 677 }
 678
 679 int
 680 Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
 681 {
 682  /* The old body of this is now in non-LAYER part of perlio.c
 683   * This is a stub for any XS code which might have been calling it.
 684   */
 685  const char *name = ":raw";
 686
 687  PERL_ARGS_ASSERT_DO_BINMODE;
 688
 689 #ifdef PERLIO_USING_CRLF
 690  if (!(mode & O_BINARY))
 691      name = ":crlf";
 692 #endif
 693  return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
 694 }
 695
 696 #ifndef OS2
 697 bool
 698 Perl_do_aexec(pTHX_ SV *really, SV **mark, SV **sp)
 699 {
 700     PERL_ARGS_ASSERT_DO_AEXEC;
 701
 702     return do_aexec5(really, mark, sp, 0, 0);
 703 }
 704 #endif
 705
 706 /* Backwards compatibility. */
 707 int
 708 Perl_init_i18nl14n(pTHX_ int printwarn)
 709 {
 710     return init_i18nl10n(printwarn);
 711 }
 712
 713 bool
 714 Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep)
 715 {
 716     PERL_ARGS_ASSERT_IS_UTF8_STRING_LOC;
 717
 718     return is_utf8_string_loclen(s, len, ep, 0);
 719 }
 720
 721 /*
 722 =for apidoc sv_nolocking
 723
 724 Dummy routine which "locks" an SV when there is no locking module present.
 725 Exists to avoid test for a NULL function pointer and because it could
 726 potentially warn under some level of strict-ness.
 727
 728 "Superseded" by sv_nosharing().
 729
 730 =cut
 731 */
 732
 733 void
 734 Perl_sv_nolocking(pTHX_ SV *sv)
 735 {
 736     PERL_UNUSED_CONTEXT;
 737     PERL_UNUSED_ARG(sv);
 738 }
 739
 740
 741 /*
 742 =for apidoc sv_nounlocking
 743
 744 Dummy routine which "unlocks" an SV when there is no locking module present.
 745 Exists to avoid test for a NULL function pointer and because it could
 746 potentially warn under some level of strict-ness.
 747
 748 "Superseded" by sv_nosharing().
 749
 750 =cut
 751 */
 752
 753 void
 754 Perl_sv_nounlocking(pTHX_ SV *sv)
 755 {
 756     PERL_UNUSED_CONTEXT;
 757     PERL_UNUSED_ARG(sv);
 758 }
 759
 760 void
 761 Perl_save_long(pTHX_ long int *longp)
 762 {
 763     dVAR;
 764
 765     PERL_ARGS_ASSERT_SAVE_LONG;
 766
 767     SSCHECK(3);
 768     SSPUSHLONG(*longp);
 769     SSPUSHPTR(longp);
 770     SSPUSHUV(SAVEt_LONG);
 771 }
 772
 773 void
 774 Perl_save_iv(pTHX_ IV *ivp)
 775 {
 776     dVAR;
 777
 778     PERL_ARGS_ASSERT_SAVE_IV;
 779
 780     SSCHECK(3);
 781     SSPUSHIV(*ivp);
 782     SSPUSHPTR(ivp);
 783     SSPUSHUV(SAVEt_IV);
 784 }
 785
 786 void
 787 Perl_save_nogv(pTHX_ GV *gv)
 788 {
 789     dVAR;
 790
 791     PERL_ARGS_ASSERT_SAVE_NOGV;
 792
 793     SSCHECK(2);
 794     SSPUSHPTR(gv);
 795     SSPUSHUV(SAVEt_NSTAB);
 796 }
 797
 798 void
 799 Perl_save_list(pTHX_ SV **sarg, I32 maxsarg)
 800 {
 801     dVAR;
 802     I32 i;
 803
 804     PERL_ARGS_ASSERT_SAVE_LIST;
 805
 806     for (i = 1; i <= maxsarg; i++) {
 807         SV *sv;
 808         SvGETMAGIC(sarg[i]);
 809         sv = newSV(0);
 810         sv_setsv_nomg(sv,sarg[i]);
 811         SSCHECK(3);
 812         SSPUSHPTR(sarg[i]);             /* remember the pointer */
 813         SSPUSHPTR(sv);                  /* remember the value */
 814         SSPUSHUV(SAVEt_ITEM);
 815     }
 816 }
 817
 818 /*
 819 =for apidoc sv_usepvn_mg
 820
 821 Like C<sv_usepvn>, but also handles 'set' magic.
 822
 823 =cut
 824 */
 825
 826 void
 827 Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
 828 {
 829     PERL_ARGS_ASSERT_SV_USEPVN_MG;
 830
 831     sv_usepvn_flags(sv,ptr,len, SV_SMAGIC);
 832 }
 833
 834 /*
 835 =for apidoc sv_usepvn
 836
 837 Tells an SV to use C<ptr> to find its string value.  Implemented by
 838 calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
 839 magic.  See C<sv_usepvn_flags>.
 840
 841 =cut
 842 */
 843
 844 void
 845 Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
 846 {
 847     PERL_ARGS_ASSERT_SV_USEPVN;
 848
 849     sv_usepvn_flags(sv,ptr,len, 0);
 850 }
 851
 852 /*
 853 =for apidoc unpack_str
 854
 855 The engine implementing unpack() Perl function.  Note: parameters strbeg,
 856 new_s and ocnt are not used.  This call should not be used, use
 857 unpackstring instead.
 858
 859 =cut */
 860
 861 I32
 862 Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s,
 863                 const char *strbeg, const char *strend, char **new_s, I32 ocnt,
 864                 U32 flags)
 865 {
 866     PERL_ARGS_ASSERT_UNPACK_STR;
 867
 868     PERL_UNUSED_ARG(strbeg);
 869     PERL_UNUSED_ARG(new_s);
 870     PERL_UNUSED_ARG(ocnt);
 871
 872     return unpackstring(pat, patend, s, strend, flags);
 873 }
 874
 875 /*
 876 =for apidoc pack_cat
 877
 878 The engine implementing pack() Perl function.  Note: parameters
 879 next_in_list and flags are not used.  This call should not be used; use
 880 packlist instead.
 881
 882 =cut
 883 */
 884
 885 void
 886 Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
 887 {
 888     PERL_ARGS_ASSERT_PACK_CAT;
 889
 890     PERL_UNUSED_ARG(next_in_list);
 891     PERL_UNUSED_ARG(flags);
 892
 893     packlist(cat, pat, patend, beglist, endlist);
 894 }
 895
 896 HE *
 897 Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
 898 {
 899   return (HE *)hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash);
 900 }
 901
 902 bool
 903 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
 904 {
 905     PERL_ARGS_ASSERT_HV_EXISTS_ENT;
 906
 907     return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)
 908         ? TRUE : FALSE;
 909 }
 910
 911 HE *
 912 Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash)
 913 {
 914     PERL_ARGS_ASSERT_HV_FETCH_ENT;
 915
 916     return (HE *)hv_common(hv, keysv, NULL, 0, 0,
 917                      (lval ? HV_FETCH_LVALUE : 0), NULL, hash);
 918 }
 919
 920 SV *
 921 Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
 922 {
 923     PERL_ARGS_ASSERT_HV_DELETE_ENT;
 924
 925     return MUTABLE_SV(hv_common(hv, keysv, NULL, 0, 0, flags | HV_DELETE, NULL,
 926                                 hash));
 927 }
 928
 929 SV**
 930 Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash,
 931                     int flags)
 932 {
 933     return (SV**) hv_common(hv, NULL, key, klen, flags,
 934                             (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
 935 }
 936
 937 SV**
 938 Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
 939 {
 940     STRLEN klen;
 941     int flags;
 942
 943     if (klen_i32 < 0) {
 944         klen = -klen_i32;
 945         flags = HVhek_UTF8;
 946     } else {
 947         klen = klen_i32;
 948         flags = 0;
 949     }
 950     return (SV **) hv_common(hv, NULL, key, klen, flags,
 951                              (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
 952 }
 953
 954 bool
 955 Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32)
 956 {
 957     STRLEN klen;
 958     int flags;
 959
 960     PERL_ARGS_ASSERT_HV_EXISTS;
 961
 962     if (klen_i32 < 0) {
 963         klen = -klen_i32;
 964         flags = HVhek_UTF8;
 965     } else {
 966         klen = klen_i32;
 967         flags = 0;
 968     }
 969     return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)
 970         ? TRUE : FALSE;
 971 }
 972
 973 SV**
 974 Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
 975 {
 976     STRLEN klen;
 977     int flags;
 978
 979     PERL_ARGS_ASSERT_HV_FETCH;
 980
 981     if (klen_i32 < 0) {
 982         klen = -klen_i32;
 983         flags = HVhek_UTF8;
 984     } else {
 985         klen = klen_i32;
 986         flags = 0;
 987     }
 988     return (SV **) hv_common(hv, NULL, key, klen, flags,
 989                              lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE)
 990                              : HV_FETCH_JUST_SV, NULL, 0);
 991 }
 992
 993 SV *
 994 Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
 995 {
 996     STRLEN klen;
 997     int k_flags;
 998
 999     PERL_ARGS_ASSERT_HV_DELETE;
1000
1001     if (klen_i32 < 0) {
1002         klen = -klen_i32;
1003         k_flags = HVhek_UTF8;
1004     } else {
1005         klen = klen_i32;
1006         k_flags = 0;
1007     }
1008     return MUTABLE_SV(hv_common(hv, NULL, key, klen, k_flags, flags | HV_DELETE,
1009                                 NULL, 0));
1010 }
1011
1012 /* Functions after here were made mathoms post 5.10.0 but pre 5.8.9 */
1013
1014 AV *
1015 Perl_newAV(pTHX)
1016 {
1017     return MUTABLE_AV(newSV_type(SVt_PVAV));
1018     /* sv_upgrade does AvREAL_only():
1019     AvALLOC(av) = 0;
1020     AvARRAY(av) = NULL;
1021     AvMAX(av) = AvFILLp(av) = -1; */
1022 }
1023
1024 HV *
1025 Perl_newHV(pTHX)
1026 {
1027     HV * const hv = MUTABLE_HV(newSV_type(SVt_PVHV));
1028     assert(!SvOK(hv));
1029
1030     return hv;
1031 }
1032
1033 void
1034 Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len,
1035               const char *const little, const STRLEN littlelen)
1036 {
1037     PERL_ARGS_ASSERT_SV_INSERT;
1038     sv_insert_flags(bigstr, offset, len, little, littlelen, SV_GMAGIC);
1039 }
1040
1041 void
1042 Perl_save_freesv(pTHX_ SV *sv)
1043 {
1044     dVAR;
1045     save_freesv(sv);
1046 }
1047
1048 void
1049 Perl_save_mortalizesv(pTHX_ SV *sv)
1050 {
1051     dVAR;
1052
1053     PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
1054
1055     save_mortalizesv(sv);
1056 }
1057
1058 void
1059 Perl_save_freeop(pTHX_ OP *o)
1060 {
1061     dVAR;
1062     save_freeop(o);
1063 }
1064
1065 void
1066 Perl_save_freepv(pTHX_ char *pv)
1067 {
1068     dVAR;
1069     save_freepv(pv);
1070 }
1071
1072 void
1073 Perl_save_op(pTHX)
1074 {
1075     dVAR;
1076     save_op();
1077 }
1078
1079 #ifdef PERL_DONT_CREATE_GVSV
1080 GV *
1081 Perl_gv_SVadd(pTHX_ GV *gv)
1082 {
1083     return gv_SVadd(gv);
1084 }
1085 #endif
1086
1087 GV *
1088 Perl_gv_AVadd(pTHX_ GV *gv)
1089 {
1090     return gv_AVadd(gv);
1091 }
1092
1093 GV *
1094 Perl_gv_HVadd(pTHX_ GV *gv)
1095 {
1096     return gv_HVadd(gv);
1097 }
1098
1099 GV *
1100 Perl_gv_IOadd(pTHX_ GV *gv)
1101 {
1102     return gv_IOadd(gv);
1103 }
1104
1105 IO *
1106 Perl_newIO(pTHX)
1107 {
1108     return MUTABLE_IO(newSV_type(SVt_PVIO));
1109 }
1110
1111 I32
1112 Perl_my_stat(pTHX)
1113 {
1114     return my_stat_flags(SV_GMAGIC);
1115 }
1116
1117 I32
1118 Perl_my_lstat(pTHX)
1119 {
1120     return my_lstat_flags(SV_GMAGIC);
1121 }
1122
1123 I32
1124 Perl_sv_eq(pTHX_ SV *sv1, SV *sv2)
1125 {
1126     return sv_eq_flags(sv1, sv2, SV_GMAGIC);
1127 }
1128
1129 #ifdef USE_LOCALE_COLLATE
1130 char *
1131 Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp)
1132 {
1133     return sv_collxfrm_flags(sv, nxp, SV_GMAGIC);
1134 }
1135 #endif
1136
1137 bool
1138 Perl_sv_2bool(pTHX_ SV *const sv)
1139 {
1140     return sv_2bool_flags(sv, SV_GMAGIC);
1141 }
1142
1143
1144 /*
1145 =for apidoc custom_op_name
1146 Return the name for a given custom op.  This was once used by the OP_NAME
1147 macro, but is no longer: it has only been kept for compatibility, and
1148 should not be used.
1149
1150 =for apidoc custom_op_desc
1151 Return the description of a given custom op.  This was once used by the
1152 OP_DESC macro, but is no longer: it has only been kept for
1153 compatibility, and should not be used.
1154
1155 =cut
1156 */
1157
1158 const char*
1159 Perl_custom_op_name(pTHX_ const OP* o)
1160 {
1161     PERL_ARGS_ASSERT_CUSTOM_OP_NAME;
1162     return XopENTRYCUSTOM(o, xop_name);
1163 }
1164
1165 const char*
1166 Perl_custom_op_desc(pTHX_ const OP* o)
1167 {
1168     PERL_ARGS_ASSERT_CUSTOM_OP_DESC;
1169     return XopENTRYCUSTOM(o, xop_desc);
1170 }
1171
1172 CV *
1173 Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block)
1174 {
1175     return newATTRSUB(floor, o, proto, NULL, block);
1176 }
1177
1178 UV
1179 Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1180 {
1181     PERL_ARGS_ASSERT_TO_UTF8_FOLD;
1182
1183     return _to_utf8_fold_flags(p, ustrp, lenp, FOLD_FLAGS_FULL);
1184 }
1185
1186 UV
1187 Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1188 {
1189     PERL_ARGS_ASSERT_TO_UTF8_LOWER;
1190
1191     return _to_utf8_lower_flags(p, ustrp, lenp, FALSE);
1192 }
1193
1194 UV
1195 Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1196 {
1197     PERL_ARGS_ASSERT_TO_UTF8_TITLE;
1198
1199     return _to_utf8_title_flags(p, ustrp, lenp, FALSE);
1200 }
1201
1202 UV
1203 Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1204 {
1205     PERL_ARGS_ASSERT_TO_UTF8_UPPER;
1206
1207     return _to_utf8_upper_flags(p, ustrp, lenp, FALSE);
1208 }
1209
1210 SV *
1211 Perl_sv_mortalcopy(pTHX_ SV *const oldstr)
1212 {
1213     return Perl_sv_mortalcopy_flags(aTHX_ oldstr, SV_GMAGIC);
1214 }
1215
1216 UV      /* Made into a function, so can be deprecated */
1217 NATIVE_TO_NEED(const UV enc, const UV ch)
1218 {
1219     PERL_UNUSED_ARG(enc);
1220     return ch;
1221 }
1222
1223 UV      /* Made into a function, so can be deprecated */
1224 ASCII_TO_NEED(const UV enc, const UV ch)
1225 {
1226     PERL_UNUSED_ARG(enc);
1227     return ch;
1228 }
1229
1230 bool
1231 Perl_is_uni_alnum(pTHX_ UV c)
1232 {
1233     return isWORDCHAR_uni(c);
1234 }
1235
1236 bool
1237 Perl_is_uni_alnumc(pTHX_ UV c)
1238 {
1239     return isALNUM_uni(c);
1240 }
1241
1242 bool
1243 Perl_is_uni_alpha(pTHX_ UV c)
1244 {
1245     return isALPHA_uni(c);
1246 }
1247
1248 bool
1249 Perl_is_uni_ascii(pTHX_ UV c)
1250 {
1251     return isASCII_uni(c);
1252 }
1253
1254 bool
1255 Perl_is_uni_blank(pTHX_ UV c)
1256 {
1257     return isBLANK_uni(c);
1258 }
1259
1260 bool
1261 Perl_is_uni_space(pTHX_ UV c)
1262 {
1263     return isSPACE_uni(c);
1264 }
1265
1266 bool
1267 Perl_is_uni_digit(pTHX_ UV c)
1268 {
1269     return isDIGIT_uni(c);
1270 }
1271
1272 bool
1273 Perl_is_uni_upper(pTHX_ UV c)
1274 {
1275     return isUPPER_uni(c);
1276 }
1277
1278 bool
1279 Perl_is_uni_lower(pTHX_ UV c)
1280 {
1281     return isLOWER_uni(c);
1282 }
1283
1284 bool
1285 Perl_is_uni_cntrl(pTHX_ UV c)
1286 {
1287     return isCNTRL_L1(c);
1288 }
1289
1290 bool
1291 Perl_is_uni_graph(pTHX_ UV c)
1292 {
1293     return isGRAPH_uni(c);
1294 }
1295
1296 bool
1297 Perl_is_uni_print(pTHX_ UV c)
1298 {
1299     return isPRINT_uni(c);
1300 }
1301
1302 bool
1303 Perl_is_uni_punct(pTHX_ UV c)
1304 {
1305     return isPUNCT_uni(c);
1306 }
1307
1308 bool
1309 Perl_is_uni_xdigit(pTHX_ UV c)
1310 {
1311     return isXDIGIT_uni(c);
1312 }
1313
1314 bool
1315 Perl_is_uni_alnum_lc(pTHX_ UV c)
1316 {
1317     return isWORDCHAR_LC_uvchr(c);
1318 }
1319
1320 bool
1321 Perl_is_uni_alnumc_lc(pTHX_ UV c)
1322 {
1323     return isALPHANUMERIC_LC_uvchr(c);
1324 }
1325
1326 bool
1327 Perl_is_uni_idfirst_lc(pTHX_ UV c)
1328 {
1329     /* XXX Should probably be something that resolves to the old IDFIRST, but
1330      * this function is deprecated, so not bothering */
1331     return isIDFIRST_LC_uvchr(c);
1332 }
1333
1334 bool
1335 Perl_is_uni_alpha_lc(pTHX_ UV c)
1336 {
1337     return isALPHA_LC_uvchr(c);
1338 }
1339
1340 bool
1341 Perl_is_uni_ascii_lc(pTHX_ UV c)
1342 {
1343     return isASCII_LC_uvchr(c);
1344 }
1345
1346 bool
1347 Perl_is_uni_blank_lc(pTHX_ UV c)
1348 {
1349     return isBLANK_LC_uvchr(c);
1350 }
1351
1352 bool
1353 Perl_is_uni_space_lc(pTHX_ UV c)
1354 {
1355     return isSPACE_LC_uvchr(c);
1356 }
1357
1358 bool
1359 Perl_is_uni_digit_lc(pTHX_ UV c)
1360 {
1361     return isDIGIT_LC_uvchr(c);
1362 }
1363
1364 bool
1365 Perl_is_uni_upper_lc(pTHX_ UV c)
1366 {
1367     return isUPPER_LC_uvchr(c);
1368 }
1369
1370 bool
1371 Perl_is_uni_lower_lc(pTHX_ UV c)
1372 {
1373     return isLOWER_LC_uvchr(c);
1374 }
1375
1376 bool
1377 Perl_is_uni_cntrl_lc(pTHX_ UV c)
1378 {
1379     return isCNTRL_LC_uvchr(c);
1380 }
1381
1382 bool
1383 Perl_is_uni_graph_lc(pTHX_ UV c)
1384 {
1385     return isGRAPH_LC_uvchr(c);
1386 }
1387
1388 bool
1389 Perl_is_uni_print_lc(pTHX_ UV c)
1390 {
1391     return isPRINT_LC_uvchr(c);
1392 }
1393
1394 bool
1395 Perl_is_uni_punct_lc(pTHX_ UV c)
1396 {
1397     return isPUNCT_LC_uvchr(c);
1398 }
1399
1400 bool
1401 Perl_is_uni_xdigit_lc(pTHX_ UV c)
1402 {
1403     return isXDIGIT_LC_uvchr(c);
1404 }
1405
1406 U32
1407 Perl_to_uni_upper_lc(pTHX_ U32 c)
1408 {
1409     /* XXX returns only the first character -- do not use XXX */
1410     /* XXX no locale support yet */
1411     STRLEN len;
1412     U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
1413     return (U32)to_uni_upper(c, tmpbuf, &len);
1414 }
1415
1416 U32
1417 Perl_to_uni_title_lc(pTHX_ U32 c)
1418 {
1419     /* XXX returns only the first character XXX -- do not use XXX */
1420     /* XXX no locale support yet */
1421     STRLEN len;
1422     U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
1423     return (U32)to_uni_title(c, tmpbuf, &len);
1424 }
1425
1426 U32
1427 Perl_to_uni_lower_lc(pTHX_ U32 c)
1428 {
1429     /* XXX returns only the first character -- do not use XXX */
1430     /* XXX no locale support yet */
1431     STRLEN len;
1432     U8 tmpbuf[UTF8_MAXBYTES_CASE+1];
1433     return (U32)to_uni_lower(c, tmpbuf, &len);
1434 }
1435
1436 bool
1437 Perl_is_utf8_alnum(pTHX_ const U8 *p)
1438 {
1439     dVAR;
1440
1441     PERL_ARGS_ASSERT_IS_UTF8_ALNUM;
1442
1443     /* NOTE: "IsWord", not "IsAlnum", since Alnum is a true
1444      * descendant of isalnum(3), in other words, it doesn't
1445      * contain the '_'. --jhi */
1446     return isWORDCHAR_utf8(p);
1447 }
1448
1449 bool
1450 Perl_is_utf8_alnumc(pTHX_ const U8 *p)
1451 {
1452     dVAR;
1453
1454     PERL_ARGS_ASSERT_IS_UTF8_ALNUMC;
1455
1456     return isALPHANUMERIC_utf8(p);
1457 }
1458
1459 bool
1460 Perl_is_utf8_alpha(pTHX_ const U8 *p)
1461 {
1462     dVAR;
1463
1464     PERL_ARGS_ASSERT_IS_UTF8_ALPHA;
1465
1466     return isALPHA_utf8(p);
1467 }
1468
1469 bool
1470 Perl_is_utf8_ascii(pTHX_ const U8 *p)
1471 {
1472     dVAR;
1473
1474     PERL_ARGS_ASSERT_IS_UTF8_ASCII;
1475
1476     return isASCII_utf8(p);
1477 }
1478
1479 bool
1480 Perl_is_utf8_blank(pTHX_ const U8 *p)
1481 {
1482     dVAR;
1483
1484     PERL_ARGS_ASSERT_IS_UTF8_BLANK;
1485
1486     return isBLANK_utf8(p);
1487 }
1488
1489 bool
1490 Perl_is_utf8_space(pTHX_ const U8 *p)
1491 {
1492     dVAR;
1493
1494     PERL_ARGS_ASSERT_IS_UTF8_SPACE;
1495
1496     return isSPACE_utf8(p);
1497 }
1498
1499 bool
1500 Perl_is_utf8_perl_space(pTHX_ const U8 *p)
1501 {
1502     dVAR;
1503
1504     PERL_ARGS_ASSERT_IS_UTF8_PERL_SPACE;
1505
1506     /* Only true if is an ASCII space-like character, and ASCII is invariant
1507      * under utf8, so can just use the macro */
1508     return isSPACE_A(*p);
1509 }
1510
1511 bool
1512 Perl_is_utf8_perl_word(pTHX_ const U8 *p)
1513 {
1514     dVAR;
1515
1516     PERL_ARGS_ASSERT_IS_UTF8_PERL_WORD;
1517
1518     /* Only true if is an ASCII word character, and ASCII is invariant
1519      * under utf8, so can just use the macro */
1520     return isWORDCHAR_A(*p);
1521 }
1522
1523 bool
1524 Perl_is_utf8_digit(pTHX_ const U8 *p)
1525 {
1526     dVAR;
1527
1528     PERL_ARGS_ASSERT_IS_UTF8_DIGIT;
1529
1530     return isDIGIT_utf8(p);
1531 }
1532
1533 bool
1534 Perl_is_utf8_posix_digit(pTHX_ const U8 *p)
1535 {
1536     dVAR;
1537
1538     PERL_ARGS_ASSERT_IS_UTF8_POSIX_DIGIT;
1539
1540     /* Only true if is an ASCII digit character, and ASCII is invariant
1541      * under utf8, so can just use the macro */
1542     return isDIGIT_A(*p);
1543 }
1544
1545 bool
1546 Perl_is_utf8_upper(pTHX_ const U8 *p)
1547 {
1548     dVAR;
1549
1550     PERL_ARGS_ASSERT_IS_UTF8_UPPER;
1551
1552     return isUPPER_utf8(p);
1553 }
1554
1555 bool
1556 Perl_is_utf8_lower(pTHX_ const U8 *p)
1557 {
1558     dVAR;
1559
1560     PERL_ARGS_ASSERT_IS_UTF8_LOWER;
1561
1562     return isLOWER_utf8(p);
1563 }
1564
1565 bool
1566 Perl_is_utf8_cntrl(pTHX_ const U8 *p)
1567 {
1568     dVAR;
1569
1570     PERL_ARGS_ASSERT_IS_UTF8_CNTRL;
1571
1572     return isCNTRL_utf8(p);
1573 }
1574
1575 bool
1576 Perl_is_utf8_graph(pTHX_ const U8 *p)
1577 {
1578     dVAR;
1579
1580     PERL_ARGS_ASSERT_IS_UTF8_GRAPH;
1581
1582     return isGRAPH_utf8(p);
1583 }
1584
1585 bool
1586 Perl_is_utf8_print(pTHX_ const U8 *p)
1587 {
1588     dVAR;
1589
1590     PERL_ARGS_ASSERT_IS_UTF8_PRINT;
1591
1592     return isPRINT_utf8(p);
1593 }
1594
1595 bool
1596 Perl_is_utf8_punct(pTHX_ const U8 *p)
1597 {
1598     dVAR;
1599
1600     PERL_ARGS_ASSERT_IS_UTF8_PUNCT;
1601
1602     return isPUNCT_utf8(p);
1603 }
1604
1605 bool
1606 Perl_is_utf8_xdigit(pTHX_ const U8 *p)
1607 {
1608     dVAR;
1609
1610     PERL_ARGS_ASSERT_IS_UTF8_XDIGIT;
1611
1612     return isXDIGIT_utf8(p);
1613 }
1614
1615 bool
1616 Perl_is_utf8_mark(pTHX_ const U8 *p)
1617 {
1618     dVAR;
1619
1620     PERL_ARGS_ASSERT_IS_UTF8_MARK;
1621
1622     return _is_utf8_mark(p);
1623 }
1624
1625 END_EXTERN_C
1626
1627 #endif /* NO_MATHOMS */
1628
1629 /*
1630  * Local variables:
1631  * c-indentation-style: bsd
1632  * c-basic-offset: 4
1633  * indent-tabs-mode: nil
1634  * End:
1635  *
1636  * ex: set ts=8 sts=4 sw=4 et:
1637  */