mathoms.c

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