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  */
  30
  31 #include "EXTERN.h"
  32 #define PERL_IN_MATHOMS_C
  33 #include "perl.h"
  34
  35 #ifdef NO_MATHOMS
  36 /* ..." warning: ISO C forbids an empty source file"
  37    So make sure we have something in here by processing the headers anyway.
  38  */
  39 #else
  40
  41 PERL_CALLCONV OP * Perl_ref(pTHX_ OP *o, I32 type);
  42 PERL_CALLCONV void Perl_sv_unref(pTHX_ SV *sv);
  43 PERL_CALLCONV void Perl_sv_taint(pTHX_ SV *sv);
  44 PERL_CALLCONV IV Perl_sv_2iv(pTHX_ register SV *sv);
  45 PERL_CALLCONV UV Perl_sv_2uv(pTHX_ register SV *sv);
  46 PERL_CALLCONV NV Perl_sv_2nv(pTHX_ register SV *sv);
  47 PERL_CALLCONV char * Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp);
  48 PERL_CALLCONV char * Perl_sv_2pv_nolen(pTHX_ register SV *sv);
  49 PERL_CALLCONV char * Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv);
  50 PERL_CALLCONV char * Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv);
  51 PERL_CALLCONV void Perl_sv_force_normal(pTHX_ register SV *sv);
  52 PERL_CALLCONV void Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr);
  53 PERL_CALLCONV void Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen);
  54 PERL_CALLCONV void Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len);
  55 PERL_CALLCONV void Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr);
  56 PERL_CALLCONV void Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv);
  57 PERL_CALLCONV char * Perl_sv_pv(pTHX_ SV *sv);
  58 PERL_CALLCONV char * Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp);
  59 PERL_CALLCONV char * Perl_sv_pvbyte(pTHX_ SV *sv);
  60 PERL_CALLCONV char * Perl_sv_pvutf8(pTHX_ SV *sv);
  61 PERL_CALLCONV STRLEN Perl_sv_utf8_upgrade(pTHX_ register SV *sv);
  62 PERL_CALLCONV NV Perl_huge(void);
  63 PERL_CALLCONV void Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
  64 PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
  65 PERL_CALLCONV GV * Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name);
  66 PERL_CALLCONV HE * Perl_hv_iternext(pTHX_ HV *hv);
  67 PERL_CALLCONV void Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how);
  68 PERL_CALLCONV bool Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp);
  69 PERL_CALLCONV bool Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp);
  70 PERL_CALLCONV U8 * Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv);
  71 PERL_CALLCONV bool Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep);
  72 PERL_CALLCONV void Perl_sv_nolocking(pTHX_ SV *sv);
  73 PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
  74 PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len);
  75 PERL_CALLCONV int Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...);
  76 PERL_CALLCONV int Perl_printf_nocontext(const char *format, ...);
  77 PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg);
  78 PERL_CALLCONV AV * Perl_newAV(pTHX);
  79 PERL_CALLCONV HV * Perl_newHV(pTHX);
  80 PERL_CALLCONV IO * Perl_newIO(pTHX);
  81 PERL_CALLCONV I32 Perl_my_stat(pTHX);
  82 PERL_CALLCONV I32 Perl_my_lstat(pTHX);
  83 PERL_CALLCONV I32 Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2);
  84 PERL_CALLCONV char * Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp);
  85 PERL_CALLCONV bool Perl_sv_2bool(pTHX_ register SV *const sv);
  86 PERL_CALLCONV CV * Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP* block);
  87 PERL_CALLCONV UV Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
  88 PERL_CALLCONV UV Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
  89 PERL_CALLCONV UV Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
  90 PERL_CALLCONV UV Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
  91
  92 /* ref() is now a macro using Perl_doref;
  93  * this version provided for binary compatibility only.
  94  */
  95 OP *
  96 Perl_ref(pTHX_ OP *o, I32 type)
  97 {
  98     return doref(o, type, TRUE);
  99 }
 100
 101 /*
 102 =for apidoc sv_unref
 103
 104 Unsets the RV status of the SV, and decrements the reference count of
 105 whatever was being referenced by the RV.  This can almost be thought of
 106 as a reversal of C<newSVrv>.  This is C<sv_unref_flags> with the C<flag>
 107 being zero.  See C<SvROK_off>.
 108
 109 =cut
 110 */
 111
 112 void
 113 Perl_sv_unref(pTHX_ SV *sv)
 114 {
 115     PERL_ARGS_ASSERT_SV_UNREF;
 116
 117     sv_unref_flags(sv, 0);
 118 }
 119
 120 /*
 121 =for apidoc sv_taint
 122
 123 Taint an SV. Use C<SvTAINTED_on> instead.
 124
 125 =cut
 126 */
 127
 128 void
 129 Perl_sv_taint(pTHX_ SV *sv)
 130 {
 131     PERL_ARGS_ASSERT_SV_TAINT;
 132
 133     sv_magic((sv), NULL, PERL_MAGIC_taint, NULL, 0);
 134 }
 135
 136 /* sv_2iv() is now a macro using Perl_sv_2iv_flags();
 137  * this function provided for binary compatibility only
 138  */
 139
 140 IV
 141 Perl_sv_2iv(pTHX_ register SV *sv)
 142 {
 143     return sv_2iv_flags(sv, SV_GMAGIC);
 144 }
 145
 146 /* sv_2uv() is now a macro using Perl_sv_2uv_flags();
 147  * this function provided for binary compatibility only
 148  */
 149
 150 UV
 151 Perl_sv_2uv(pTHX_ register SV *sv)
 152 {
 153     return sv_2uv_flags(sv, SV_GMAGIC);
 154 }
 155
 156 /* sv_2nv() is now a macro using Perl_sv_2nv_flags();
 157  * this function provided for binary compatibility only
 158  */
 159
 160 NV
 161 Perl_sv_2nv(pTHX_ register SV *sv)
 162 {
 163     return sv_2nv_flags(sv, SV_GMAGIC);
 164 }
 165
 166
 167 /* sv_2pv() is now a macro using Perl_sv_2pv_flags();
 168  * this function provided for binary compatibility only
 169  */
 170
 171 char *
 172 Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 173 {
 174     return sv_2pv_flags(sv, lp, SV_GMAGIC);
 175 }
 176
 177 /*
 178 =for apidoc sv_2pv_nolen
 179
 180 Like C<sv_2pv()>, but doesn't return the length too. You should usually
 181 use the macro wrapper C<SvPV_nolen(sv)> instead.
 182
 183 =cut
 184 */
 185
 186 char *
 187 Perl_sv_2pv_nolen(pTHX_ register SV *sv)
 188 {
 189     PERL_ARGS_ASSERT_SV_2PV_NOLEN;
 190     return sv_2pv(sv, NULL);
 191 }
 192
 193 /*
 194 =for apidoc sv_2pvbyte_nolen
 195
 196 Return a pointer to the byte-encoded representation of the SV.
 197 May cause the SV to be downgraded from UTF-8 as a side-effect.
 198
 199 Usually accessed via the C<SvPVbyte_nolen> macro.
 200
 201 =cut
 202 */
 203
 204 char *
 205 Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv)
 206 {
 207     PERL_ARGS_ASSERT_SV_2PVBYTE_NOLEN;
 208
 209     return sv_2pvbyte(sv, NULL);
 210 }
 211
 212 /*
 213 =for apidoc sv_2pvutf8_nolen
 214
 215 Return a pointer to the UTF-8-encoded representation of the SV.
 216 May cause the SV to be upgraded to UTF-8 as a side-effect.
 217
 218 Usually accessed via the C<SvPVutf8_nolen> macro.
 219
 220 =cut
 221 */
 222
 223 char *
 224 Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv)
 225 {
 226     PERL_ARGS_ASSERT_SV_2PVUTF8_NOLEN;
 227
 228     return sv_2pvutf8(sv, NULL);
 229 }
 230
 231 /*
 232 =for apidoc sv_force_normal
 233
 234 Undo various types of fakery on an SV: if the PV is a shared string, make
 235 a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
 236 an xpvmg. See also C<sv_force_normal_flags>.
 237
 238 =cut
 239 */
 240
 241 void
 242 Perl_sv_force_normal(pTHX_ register SV *sv)
 243 {
 244     PERL_ARGS_ASSERT_SV_FORCE_NORMAL;
 245
 246     sv_force_normal_flags(sv, 0);
 247 }
 248
 249 /* sv_setsv() is now a macro using Perl_sv_setsv_flags();
 250  * this function provided for binary compatibility only
 251  */
 252
 253 void
 254 Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 255 {
 256     PERL_ARGS_ASSERT_SV_SETSV;
 257
 258     sv_setsv_flags(dstr, sstr, SV_GMAGIC);
 259 }
 260
 261 /* sv_catpvn() is now a macro using Perl_sv_catpvn_flags();
 262  * this function provided for binary compatibility only
 263  */
 264
 265 void
 266 Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen)
 267 {
 268     PERL_ARGS_ASSERT_SV_CATPVN;
 269
 270     sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC);
 271 }
 272
 273 /*
 274 =for apidoc sv_catpvn_mg
 275
 276 Like C<sv_catpvn>, but also handles 'set' magic.
 277
 278 =cut
 279 */
 280
 281 void
 282 Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
 283 {
 284     PERL_ARGS_ASSERT_SV_CATPVN_MG;
 285
 286     sv_catpvn_flags(sv,ptr,len,SV_GMAGIC|SV_SMAGIC);
 287 }
 288
 289 /* sv_catsv() is now a macro using Perl_sv_catsv_flags();
 290  * this function provided for binary compatibility only
 291  */
 292
 293 void
 294 Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
 295 {
 296     PERL_ARGS_ASSERT_SV_CATSV;
 297
 298     sv_catsv_flags(dstr, sstr, SV_GMAGIC);
 299 }
 300
 301 /*
 302 =for apidoc sv_catsv_mg
 303
 304 Like C<sv_catsv>, but also handles 'set' magic.
 305
 306 =cut
 307 */
 308
 309 void
 310 Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv)
 311 {
 312     PERL_ARGS_ASSERT_SV_CATSV_MG;
 313
 314     sv_catsv_flags(dsv,ssv,SV_GMAGIC|SV_SMAGIC);
 315 }
 316
 317 /*
 318 =for apidoc sv_iv
 319
 320 A private implementation of the C<SvIVx> macro for compilers which can't
 321 cope with complex macro expressions. Always use the macro instead.
 322
 323 =cut
 324 */
 325
 326 IV
 327 Perl_sv_iv(pTHX_ register SV *sv)
 328 {
 329     PERL_ARGS_ASSERT_SV_IV;
 330
 331     if (SvIOK(sv)) {
 332         if (SvIsUV(sv))
 333             return (IV)SvUVX(sv);
 334         return SvIVX(sv);
 335     }
 336     return sv_2iv(sv);
 337 }
 338
 339 /*
 340 =for apidoc sv_uv
 341
 342 A private implementation of the C<SvUVx> macro for compilers which can't
 343 cope with complex macro expressions. Always use the macro instead.
 344
 345 =cut
 346 */
 347
 348 UV
 349 Perl_sv_uv(pTHX_ register SV *sv)
 350 {
 351     PERL_ARGS_ASSERT_SV_UV;
 352
 353     if (SvIOK(sv)) {
 354         if (SvIsUV(sv))
 355             return SvUVX(sv);
 356         return (UV)SvIVX(sv);
 357     }
 358     return sv_2uv(sv);
 359 }
 360
 361 /*
 362 =for apidoc sv_nv
 363
 364 A private implementation of the C<SvNVx> macro for compilers which can't
 365 cope with complex macro expressions. Always use the macro instead.
 366
 367 =cut
 368 */
 369
 370 NV
 371 Perl_sv_nv(pTHX_ register SV *sv)
 372 {
 373     PERL_ARGS_ASSERT_SV_NV;
 374
 375     if (SvNOK(sv))
 376         return SvNVX(sv);
 377     return sv_2nv(sv);
 378 }
 379
 380 /*
 381 =for apidoc sv_pv
 382
 383 Use the C<SvPV_nolen> macro instead
 384
 385 =for apidoc sv_pvn
 386
 387 A private implementation of the C<SvPV> macro for compilers which can't
 388 cope with complex macro expressions. Always use the macro instead.
 389
 390 =cut
 391 */
 392
 393 char *
 394 Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp)
 395 {
 396     PERL_ARGS_ASSERT_SV_PVN;
 397
 398     if (SvPOK(sv)) {
 399         *lp = SvCUR(sv);
 400         return SvPVX(sv);
 401     }
 402     return sv_2pv(sv, lp);
 403 }
 404
 405
 406 char *
 407 Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp)
 408 {
 409     PERL_ARGS_ASSERT_SV_PVN_NOMG;
 410
 411     if (SvPOK(sv)) {
 412         *lp = SvCUR(sv);
 413         return SvPVX(sv);
 414     }
 415     return sv_2pv_flags(sv, lp, 0);
 416 }
 417
 418 /* sv_pv() is now a macro using SvPV_nolen();
 419  * this function provided for binary compatibility only
 420  */
 421
 422 char *
 423 Perl_sv_pv(pTHX_ SV *sv)
 424 {
 425     PERL_ARGS_ASSERT_SV_PV;
 426
 427     if (SvPOK(sv))
 428         return SvPVX(sv);
 429
 430     return sv_2pv(sv, NULL);
 431 }
 432
 433 /* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags();
 434  * this function provided for binary compatibility only
 435  */
 436
 437 char *
 438 Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
 439 {
 440     PERL_ARGS_ASSERT_SV_PVN_FORCE;
 441
 442     return sv_pvn_force_flags(sv, lp, SV_GMAGIC);
 443 }
 444
 445 /* sv_pvbyte () is now a macro using Perl_sv_2pv_flags();
 446  * this function provided for binary compatibility only
 447  */
 448
 449 char *
 450 Perl_sv_pvbyte(pTHX_ SV *sv)
 451 {
 452     PERL_ARGS_ASSERT_SV_PVBYTE;
 453
 454     sv_utf8_downgrade(sv, FALSE);
 455     return sv_pv(sv);
 456 }
 457
 458 /*
 459 =for apidoc sv_pvbyte
 460
 461 Use C<SvPVbyte_nolen> instead.
 462
 463 =for apidoc sv_pvbyten
 464
 465 A private implementation of the C<SvPVbyte> macro for compilers
 466 which can't cope with complex macro expressions. Always use the macro
 467 instead.
 468
 469 =cut
 470 */
 471
 472 char *
 473 Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp)
 474 {
 475     PERL_ARGS_ASSERT_SV_PVBYTEN;
 476
 477     sv_utf8_downgrade(sv, FALSE);
 478     return sv_pvn(sv,lp);
 479 }
 480
 481 /* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags();
 482  * this function provided for binary compatibility only
 483  */
 484
 485 char *
 486 Perl_sv_pvutf8(pTHX_ SV *sv)
 487 {
 488     PERL_ARGS_ASSERT_SV_PVUTF8;
 489
 490     sv_utf8_upgrade(sv);
 491     return sv_pv(sv);
 492 }
 493
 494 /*
 495 =for apidoc sv_pvutf8
 496
 497 Use the C<SvPVutf8_nolen> macro instead
 498
 499 =for apidoc sv_pvutf8n
 500
 501 A private implementation of the C<SvPVutf8> macro for compilers
 502 which can't cope with complex macro expressions. Always use the macro
 503 instead.
 504
 505 =cut
 506 */
 507
 508 char *
 509 Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp)
 510 {
 511     PERL_ARGS_ASSERT_SV_PVUTF8N;
 512
 513     sv_utf8_upgrade(sv);
 514     return sv_pvn(sv,lp);
 515 }
 516
 517 /* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags();
 518  * this function provided for binary compatibility only
 519  */
 520
 521 STRLEN
 522 Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
 523 {
 524     PERL_ARGS_ASSERT_SV_UTF8_UPGRADE;
 525
 526     return sv_utf8_upgrade_flags(sv, SV_GMAGIC);
 527 }
 528
 529 int
 530 Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
 531 {
 532     dTHXs;
 533     va_list(arglist);
 534
 535     /* Easier to special case this here than in embed.pl. (Look at what it
 536        generates for proto.h) */
 537 #ifdef PERL_IMPLICIT_CONTEXT
 538     PERL_ARGS_ASSERT_FPRINTF_NOCONTEXT;
 539 #endif
 540
 541     va_start(arglist, format);
 542     return PerlIO_vprintf(stream, format, arglist);
 543 }
 544
 545 int
 546 Perl_printf_nocontext(const char *format, ...)
 547 {
 548     dTHX;
 549     va_list(arglist);
 550
 551 #ifdef PERL_IMPLICIT_CONTEXT
 552     PERL_ARGS_ASSERT_PRINTF_NOCONTEXT;
 553 #endif
 554
 555     va_start(arglist, format);
 556     return PerlIO_vprintf(PerlIO_stdout(), format, arglist);
 557 }
 558
 559 #if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL))
 560 /*
 561  * This hack is to force load of "huge" support from libm.a
 562  * So it is in perl for (say) POSIX to use.
 563  * Needed for SunOS with Sun's 'acc' for example.
 564  */
 565 NV
 566 Perl_huge(void)
 567 {
 568 #  if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
 569     return HUGE_VALL;
 570 #  else
 571     return HUGE_VAL;
 572 #  endif
 573 }
 574 #endif
 575
 576 /* compatibility with versions <= 5.003. */
 577 void
 578 Perl_gv_fullname(pTHX_ SV *sv, const GV *gv)
 579 {
 580     PERL_ARGS_ASSERT_GV_FULLNAME;
 581
 582     gv_fullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
 583 }
 584
 585 /* compatibility with versions <= 5.003. */
 586 void
 587 Perl_gv_efullname(pTHX_ SV *sv, const GV *gv)
 588 {
 589     PERL_ARGS_ASSERT_GV_EFULLNAME;
 590
 591     gv_efullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
 592 }
 593
 594 void
 595 Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
 596 {
 597     PERL_ARGS_ASSERT_GV_FULLNAME3;
 598
 599     gv_fullname4(sv, gv, prefix, TRUE);
 600 }
 601
 602 void
 603 Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
 604 {
 605     PERL_ARGS_ASSERT_GV_EFULLNAME3;
 606
 607     gv_efullname4(sv, gv, prefix, TRUE);
 608 }
 609
 610 /*
 611 =for apidoc gv_fetchmethod
 612
 613 See L</gv_fetchmethod_autoload>.
 614
 615 =cut
 616 */
 617
 618 GV *
 619 Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name)
 620 {
 621     PERL_ARGS_ASSERT_GV_FETCHMETHOD;
 622
 623     return gv_fetchmethod_autoload(stash, name, TRUE);
 624 }
 625
 626 HE *
 627 Perl_hv_iternext(pTHX_ HV *hv)
 628 {
 629     PERL_ARGS_ASSERT_HV_ITERNEXT;
 630
 631     return hv_iternext_flags(hv, 0);
 632 }
 633
 634 void
 635 Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
 636 {
 637     PERL_ARGS_ASSERT_HV_MAGIC;
 638
 639     sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0);
 640 }
 641
 642 bool
 643 Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw,
 644              int rawmode, int rawperm, PerlIO *supplied_fp)
 645 {
 646     PERL_ARGS_ASSERT_DO_OPEN;
 647
 648     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
 649                     supplied_fp, (SV **) NULL, 0);
 650 }
 651
 652 bool
 653 Perl_do_open9(pTHX_ GV *gv, register const char *name, I32 len, int
 654 as_raw,
 655               int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
 656               I32 num_svs)
 657 {
 658     PERL_ARGS_ASSERT_DO_OPEN9;
 659
 660     PERL_UNUSED_ARG(num_svs);
 661     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
 662                     supplied_fp, &svs, 1);
 663 }
 664
 665 int
 666 Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
 667 {
 668  /* The old body of this is now in non-LAYER part of perlio.c
 669   * This is a stub for any XS code which might have been calling it.
 670   */
 671  const char *name = ":raw";
 672
 673  PERL_ARGS_ASSERT_DO_BINMODE;
 674
 675 #ifdef PERLIO_USING_CRLF
 676  if (!(mode & O_BINARY))
 677      name = ":crlf";
 678 #endif
 679  return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
 680 }
 681
 682 #ifndef OS2
 683 bool
 684 Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp)
 685 {
 686     PERL_ARGS_ASSERT_DO_AEXEC;
 687
 688     return do_aexec5(really, mark, sp, 0, 0);
 689 }
 690 #endif
 691
 692 /* Backwards compatibility. */
 693 int
 694 Perl_init_i18nl14n(pTHX_ int printwarn)
 695 {
 696     return init_i18nl10n(printwarn);
 697 }
 698
 699 U8 *
 700 Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
 701 {
 702     PERL_ARGS_ASSERT_UVUNI_TO_UTF8;
 703
 704     return Perl_uvuni_to_utf8_flags(aTHX_ d, uv, 0);
 705 }
 706
 707 bool
 708 Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep)
 709 {
 710     PERL_ARGS_ASSERT_IS_UTF8_STRING_LOC;
 711
 712     return is_utf8_string_loclen(s, len, ep, 0);
 713 }
 714
 715 /*
 716 =for apidoc sv_nolocking
 717
 718 Dummy routine which "locks" an SV when there is no locking module present.
 719 Exists to avoid test for a NULL function pointer and because it could
 720 potentially warn under some level of strict-ness.
 721
 722 "Superseded" by sv_nosharing().
 723
 724 =cut
 725 */
 726
 727 void
 728 Perl_sv_nolocking(pTHX_ SV *sv)
 729 {
 730     PERL_UNUSED_CONTEXT;
 731     PERL_UNUSED_ARG(sv);
 732 }
 733
 734
 735 /*
 736 =for apidoc sv_nounlocking
 737
 738 Dummy routine which "unlocks" an SV when there is no locking module present.
 739 Exists to avoid test for a NULL function pointer and because it could
 740 potentially warn under some level of strict-ness.
 741
 742 "Superseded" by sv_nosharing().
 743
 744 =cut
 745 */
 746
 747 void
 748 Perl_sv_nounlocking(pTHX_ SV *sv)
 749 {
 750     PERL_UNUSED_CONTEXT;
 751     PERL_UNUSED_ARG(sv);
 752 }
 753
 754 void
 755 Perl_save_long(pTHX_ long int *longp)
 756 {
 757     dVAR;
 758
 759     PERL_ARGS_ASSERT_SAVE_LONG;
 760
 761     SSCHECK(3);
 762     SSPUSHLONG(*longp);
 763     SSPUSHPTR(longp);
 764     SSPUSHUV(SAVEt_LONG);
 765 }
 766
 767 void
 768 Perl_save_iv(pTHX_ IV *ivp)
 769 {
 770     dVAR;
 771
 772     PERL_ARGS_ASSERT_SAVE_IV;
 773
 774     SSCHECK(3);
 775     SSPUSHIV(*ivp);
 776     SSPUSHPTR(ivp);
 777     SSPUSHUV(SAVEt_IV);
 778 }
 779
 780 void
 781 Perl_save_nogv(pTHX_ GV *gv)
 782 {
 783     dVAR;
 784
 785     PERL_ARGS_ASSERT_SAVE_NOGV;
 786
 787     SSCHECK(2);
 788     SSPUSHPTR(gv);
 789     SSPUSHUV(SAVEt_NSTAB);
 790 }
 791
 792 void
 793 Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
 794 {
 795     dVAR;
 796     register I32 i;
 797
 798     PERL_ARGS_ASSERT_SAVE_LIST;
 799
 800     for (i = 1; i <= maxsarg; i++) {
 801         register SV * const sv = newSV(0);
 802         sv_setsv(sv,sarg[i]);
 803         SSCHECK(3);
 804         SSPUSHPTR(sarg[i]);             /* remember the pointer */
 805         SSPUSHPTR(sv);                  /* remember the value */
 806         SSPUSHUV(SAVEt_ITEM);
 807     }
 808 }
 809
 810 /*
 811 =for apidoc sv_usepvn_mg
 812
 813 Like C<sv_usepvn>, but also handles 'set' magic.
 814
 815 =cut
 816 */
 817
 818 void
 819 Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
 820 {
 821     PERL_ARGS_ASSERT_SV_USEPVN_MG;
 822
 823     sv_usepvn_flags(sv,ptr,len, SV_SMAGIC);
 824 }
 825
 826 /*
 827 =for apidoc sv_usepvn
 828
 829 Tells an SV to use C<ptr> to find its string value. Implemented by
 830 calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
 831 magic. See C<sv_usepvn_flags>.
 832
 833 =cut
 834 */
 835
 836 void
 837 Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
 838 {
 839     PERL_ARGS_ASSERT_SV_USEPVN;
 840
 841     sv_usepvn_flags(sv,ptr,len, 0);
 842 }
 843
 844 /*
 845 =for apidoc unpack_str
 846
 847 The engine implementing unpack() Perl function. Note: parameters strbeg, new_s
 848 and ocnt are not used. This call should not be used, use unpackstring instead.
 849
 850 =cut */
 851
 852 I32
 853 Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s,
 854                 const char *strbeg, const char *strend, char **new_s, I32 ocnt,
 855                 U32 flags)
 856 {
 857     PERL_ARGS_ASSERT_UNPACK_STR;
 858
 859     PERL_UNUSED_ARG(strbeg);
 860     PERL_UNUSED_ARG(new_s);
 861     PERL_UNUSED_ARG(ocnt);
 862
 863     return unpackstring(pat, patend, s, strend, flags);
 864 }
 865
 866 /*
 867 =for apidoc pack_cat
 868
 869 The engine implementing pack() Perl function. Note: parameters next_in_list and
 870 flags are not used. This call should not be used; use packlist instead.
 871
 872 =cut
 873 */
 874
 875 void
 876 Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
 877 {
 878     PERL_ARGS_ASSERT_PACK_CAT;
 879
 880     PERL_UNUSED_ARG(next_in_list);
 881     PERL_UNUSED_ARG(flags);
 882
 883     packlist(cat, pat, patend, beglist, endlist);
 884 }
 885
 886 HE *
 887 Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
 888 {
 889   return (HE *)hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash);
 890 }
 891
 892 bool
 893 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
 894 {
 895     PERL_ARGS_ASSERT_HV_EXISTS_ENT;
 896
 897     return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)
 898         ? TRUE : FALSE;
 899 }
 900
 901 HE *
 902 Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash)
 903 {
 904     PERL_ARGS_ASSERT_HV_FETCH_ENT;
 905
 906     return (HE *)hv_common(hv, keysv, NULL, 0, 0,
 907                      (lval ? HV_FETCH_LVALUE : 0), NULL, hash);
 908 }
 909
 910 SV *
 911 Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
 912 {
 913     PERL_ARGS_ASSERT_HV_DELETE_ENT;
 914
 915     return MUTABLE_SV(hv_common(hv, keysv, NULL, 0, 0, flags | HV_DELETE, NULL,
 916                                 hash));
 917 }
 918
 919 SV**
 920 Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash,
 921                     int flags)
 922 {
 923     return (SV**) hv_common(hv, NULL, key, klen, flags,
 924                             (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
 925 }
 926
 927 SV**
 928 Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
 929 {
 930     STRLEN klen;
 931     int flags;
 932
 933     if (klen_i32 < 0) {
 934         klen = -klen_i32;
 935         flags = HVhek_UTF8;
 936     } else {
 937         klen = klen_i32;
 938         flags = 0;
 939     }
 940     return (SV **) hv_common(hv, NULL, key, klen, flags,
 941                              (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
 942 }
 943
 944 bool
 945 Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32)
 946 {
 947     STRLEN klen;
 948     int flags;
 949
 950     PERL_ARGS_ASSERT_HV_EXISTS;
 951
 952     if (klen_i32 < 0) {
 953         klen = -klen_i32;
 954         flags = HVhek_UTF8;
 955     } else {
 956         klen = klen_i32;
 957         flags = 0;
 958     }
 959     return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)
 960         ? TRUE : FALSE;
 961 }
 962
 963 SV**
 964 Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
 965 {
 966     STRLEN klen;
 967     int flags;
 968
 969     PERL_ARGS_ASSERT_HV_FETCH;
 970
 971     if (klen_i32 < 0) {
 972         klen = -klen_i32;
 973         flags = HVhek_UTF8;
 974     } else {
 975         klen = klen_i32;
 976         flags = 0;
 977     }
 978     return (SV **) hv_common(hv, NULL, key, klen, flags,
 979                              lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE)
 980                              : HV_FETCH_JUST_SV, NULL, 0);
 981 }
 982
 983 SV *
 984 Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
 985 {
 986     STRLEN klen;
 987     int k_flags;
 988
 989     PERL_ARGS_ASSERT_HV_DELETE;
 990
 991     if (klen_i32 < 0) {
 992         klen = -klen_i32;
 993         k_flags = HVhek_UTF8;
 994     } else {
 995         klen = klen_i32;
 996         k_flags = 0;
 997     }
 998     return MUTABLE_SV(hv_common(hv, NULL, key, klen, k_flags, flags | HV_DELETE,
 999                                 NULL, 0));
1000 }
1001
1002 /* Functions after here were made mathoms post 5.10.0 but pre 5.8.9 */
1003
1004 AV *
1005 Perl_newAV(pTHX)
1006 {
1007     return MUTABLE_AV(newSV_type(SVt_PVAV));
1008     /* sv_upgrade does AvREAL_only():
1009     AvALLOC(av) = 0;
1010     AvARRAY(av) = NULL;
1011     AvMAX(av) = AvFILLp(av) = -1; */
1012 }
1013
1014 HV *
1015 Perl_newHV(pTHX)
1016 {
1017     HV * const hv = MUTABLE_HV(newSV_type(SVt_PVHV));
1018     assert(!SvOK(hv));
1019
1020     return hv;
1021 }
1022
1023 void
1024 Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len,
1025               const char *const little, const STRLEN littlelen)
1026 {
1027     PERL_ARGS_ASSERT_SV_INSERT;
1028     sv_insert_flags(bigstr, offset, len, little, littlelen, SV_GMAGIC);
1029 }
1030
1031 void
1032 Perl_save_freesv(pTHX_ SV *sv)
1033 {
1034     dVAR;
1035     save_freesv(sv);
1036 }
1037
1038 void
1039 Perl_save_mortalizesv(pTHX_ SV *sv)
1040 {
1041     dVAR;
1042
1043     PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
1044
1045     save_mortalizesv(sv);
1046 }
1047
1048 void
1049 Perl_save_freeop(pTHX_ OP *o)
1050 {
1051     dVAR;
1052     save_freeop(o);
1053 }
1054
1055 void
1056 Perl_save_freepv(pTHX_ char *pv)
1057 {
1058     dVAR;
1059     save_freepv(pv);
1060 }
1061
1062 void
1063 Perl_save_op(pTHX)
1064 {
1065     dVAR;
1066     save_op();
1067 }
1068
1069 #ifdef PERL_DONT_CREATE_GVSV
1070 GV *
1071 Perl_gv_SVadd(pTHX_ GV *gv)
1072 {
1073     return gv_SVadd(gv);
1074 }
1075 #endif
1076
1077 GV *
1078 Perl_gv_AVadd(pTHX_ GV *gv)
1079 {
1080     return gv_AVadd(gv);
1081 }
1082
1083 GV *
1084 Perl_gv_HVadd(pTHX_ register GV *gv)
1085 {
1086     return gv_HVadd(gv);
1087 }
1088
1089 GV *
1090 Perl_gv_IOadd(pTHX_ register GV *gv)
1091 {
1092     return gv_IOadd(gv);
1093 }
1094
1095 IO *
1096 Perl_newIO(pTHX)
1097 {
1098     return MUTABLE_IO(newSV_type(SVt_PVIO));
1099 }
1100
1101 I32
1102 Perl_my_stat(pTHX)
1103 {
1104     return my_stat_flags(SV_GMAGIC);
1105 }
1106
1107 I32
1108 Perl_my_lstat(pTHX)
1109 {
1110     return my_lstat_flags(SV_GMAGIC);
1111 }
1112
1113 I32
1114 Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
1115 {
1116     return sv_eq_flags(sv1, sv2, SV_GMAGIC);
1117 }
1118
1119 #ifdef USE_LOCALE_COLLATE
1120 char *
1121 Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp)
1122 {
1123     return sv_collxfrm_flags(sv, nxp, SV_GMAGIC);
1124 }
1125 #endif
1126
1127 bool
1128 Perl_sv_2bool(pTHX_ register SV *const sv)
1129 {
1130     return sv_2bool_flags(sv, SV_GMAGIC);
1131 }
1132
1133
1134 /*
1135 =for apidoc custom_op_name
1136 Return the name for a given custom op. This was once used by the OP_NAME
1137 macro, but is no longer: it has only been kept for compatibility, and
1138 should not be used.
1139
1140 =for apidoc custom_op_desc
1141 Return the description of a given custom op. This was once used by the
1142 OP_DESC macro, but is no longer: it has only been kept for
1143 compatibility, and should not be used.
1144
1145 =cut
1146 */
1147
1148 const char*
1149 Perl_custom_op_name(pTHX_ const OP* o)
1150 {
1151     PERL_ARGS_ASSERT_CUSTOM_OP_NAME;
1152     return XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_name);
1153 }
1154
1155 const char*
1156 Perl_custom_op_desc(pTHX_ const OP* o)
1157 {
1158     PERL_ARGS_ASSERT_CUSTOM_OP_DESC;
1159     return XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_desc);
1160 }
1161
1162 CV *
1163 Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block)
1164 {
1165     return Perl_newATTRSUB(aTHX_ floor, o, proto, NULL, block);
1166 }
1167
1168 UV
1169 Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1170 {
1171     PERL_ARGS_ASSERT_TO_UTF8_FOLD;
1172
1173     return _to_utf8_fold_flags(p, ustrp, lenp, FOLD_FLAGS_FULL, NULL);
1174 }
1175
1176 UV
1177 Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1178 {
1179     PERL_ARGS_ASSERT_TO_UTF8_LOWER;
1180
1181     return _to_utf8_lower_flags(p, ustrp, lenp, FALSE, NULL);
1182 }
1183
1184 UV
1185 Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1186 {
1187     PERL_ARGS_ASSERT_TO_UTF8_TITLE;
1188
1189     return _to_utf8_title_flags(p, ustrp, lenp, FALSE, NULL);
1190 }
1191
1192 UV
1193 Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1194 {
1195     PERL_ARGS_ASSERT_TO_UTF8_UPPER;
1196
1197     return _to_utf8_upper_flags(p, ustrp, lenp, FALSE, NULL);
1198 }
1199
1200 #endif /* NO_MATHOMS */
1201
1202 /*
1203  * Local variables:
1204  * c-indentation-style: bsd
1205  * c-basic-offset: 4
1206  * indent-tabs-mode: t
1207  * End:
1208  *
1209  * ex: set ts=8 sts=4 sw=4 noet:
1210  */