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
  87 /* ref() is now a macro using Perl_doref;
  88  * this version provided for binary compatibility only.
  89  */
  90 OP *
  91 Perl_ref(pTHX_ OP *o, I32 type)
  92 {
  93     return doref(o, type, TRUE);
  94 }
  95
  96 /*
  97 =for apidoc sv_unref
  98
  99 Unsets the RV status of the SV, and decrements the reference count of
 100 whatever was being referenced by the RV.  This can almost be thought of
 101 as a reversal of C<newSVrv>.  This is C<sv_unref_flags> with the C<flag>
 102 being zero.  See C<SvROK_off>.
 103
 104 =cut
 105 */
 106
 107 void
 108 Perl_sv_unref(pTHX_ SV *sv)
 109 {
 110     PERL_ARGS_ASSERT_SV_UNREF;
 111
 112     sv_unref_flags(sv, 0);
 113 }
 114
 115 /*
 116 =for apidoc sv_taint
 117
 118 Taint an SV. Use C<SvTAINTED_on> instead.
 119 =cut
 120 */
 121
 122 void
 123 Perl_sv_taint(pTHX_ SV *sv)
 124 {
 125     PERL_ARGS_ASSERT_SV_TAINT;
 126
 127     sv_magic((sv), NULL, PERL_MAGIC_taint, NULL, 0);
 128 }
 129
 130 /* sv_2iv() is now a macro using Perl_sv_2iv_flags();
 131  * this function provided for binary compatibility only
 132  */
 133
 134 IV
 135 Perl_sv_2iv(pTHX_ register SV *sv)
 136 {
 137     return sv_2iv_flags(sv, SV_GMAGIC);
 138 }
 139
 140 /* sv_2uv() is now a macro using Perl_sv_2uv_flags();
 141  * this function provided for binary compatibility only
 142  */
 143
 144 UV
 145 Perl_sv_2uv(pTHX_ register SV *sv)
 146 {
 147     return sv_2uv_flags(sv, SV_GMAGIC);
 148 }
 149
 150 /* sv_2nv() is now a macro using Perl_sv_2nv_flags();
 151  * this function provided for binary compatibility only
 152  */
 153
 154 NV
 155 Perl_sv_2nv(pTHX_ register SV *sv)
 156 {
 157     return sv_2nv_flags(sv, SV_GMAGIC);
 158 }
 159
 160
 161 /* sv_2pv() is now a macro using Perl_sv_2pv_flags();
 162  * this function provided for binary compatibility only
 163  */
 164
 165 char *
 166 Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 167 {
 168     return sv_2pv_flags(sv, lp, SV_GMAGIC);
 169 }
 170
 171 /*
 172 =for apidoc sv_2pv_nolen
 173
 174 Like C<sv_2pv()>, but doesn't return the length too. You should usually
 175 use the macro wrapper C<SvPV_nolen(sv)> instead.
 176 =cut
 177 */
 178
 179 char *
 180 Perl_sv_2pv_nolen(pTHX_ register SV *sv)
 181 {
 182     PERL_ARGS_ASSERT_SV_2PV_NOLEN;
 183     return sv_2pv(sv, NULL);
 184 }
 185
 186 /*
 187 =for apidoc sv_2pvbyte_nolen
 188
 189 Return a pointer to the byte-encoded representation of the SV.
 190 May cause the SV to be downgraded from UTF-8 as a side-effect.
 191
 192 Usually accessed via the C<SvPVbyte_nolen> macro.
 193
 194 =cut
 195 */
 196
 197 char *
 198 Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv)
 199 {
 200     PERL_ARGS_ASSERT_SV_2PVBYTE_NOLEN;
 201
 202     return sv_2pvbyte(sv, NULL);
 203 }
 204
 205 /*
 206 =for apidoc sv_2pvutf8_nolen
 207
 208 Return a pointer to the UTF-8-encoded representation of the SV.
 209 May cause the SV to be upgraded to UTF-8 as a side-effect.
 210
 211 Usually accessed via the C<SvPVutf8_nolen> macro.
 212
 213 =cut
 214 */
 215
 216 char *
 217 Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv)
 218 {
 219     PERL_ARGS_ASSERT_SV_2PVUTF8_NOLEN;
 220
 221     return sv_2pvutf8(sv, NULL);
 222 }
 223
 224 /*
 225 =for apidoc sv_force_normal
 226
 227 Undo various types of fakery on an SV: if the PV is a shared string, make
 228 a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
 229 an xpvmg. See also C<sv_force_normal_flags>.
 230
 231 =cut
 232 */
 233
 234 void
 235 Perl_sv_force_normal(pTHX_ register SV *sv)
 236 {
 237     PERL_ARGS_ASSERT_SV_FORCE_NORMAL;
 238
 239     sv_force_normal_flags(sv, 0);
 240 }
 241
 242 /* sv_setsv() is now a macro using Perl_sv_setsv_flags();
 243  * this function provided for binary compatibility only
 244  */
 245
 246 void
 247 Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 248 {
 249     PERL_ARGS_ASSERT_SV_SETSV;
 250
 251     sv_setsv_flags(dstr, sstr, SV_GMAGIC);
 252 }
 253
 254 /* sv_catpvn() is now a macro using Perl_sv_catpvn_flags();
 255  * this function provided for binary compatibility only
 256  */
 257
 258 void
 259 Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen)
 260 {
 261     PERL_ARGS_ASSERT_SV_CATPVN;
 262
 263     sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC);
 264 }
 265
 266 /*
 267 =for apidoc sv_catpvn_mg
 268
 269 Like C<sv_catpvn>, but also handles 'set' magic.
 270
 271 =cut
 272 */
 273
 274 void
 275 Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
 276 {
 277     PERL_ARGS_ASSERT_SV_CATPVN_MG;
 278
 279     sv_catpvn_flags(sv,ptr,len,SV_GMAGIC|SV_SMAGIC);
 280 }
 281
 282 /* sv_catsv() is now a macro using Perl_sv_catsv_flags();
 283  * this function provided for binary compatibility only
 284  */
 285
 286 void
 287 Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
 288 {
 289     PERL_ARGS_ASSERT_SV_CATSV;
 290
 291     sv_catsv_flags(dstr, sstr, SV_GMAGIC);
 292 }
 293
 294 /*
 295 =for apidoc sv_catsv_mg
 296
 297 Like C<sv_catsv>, but also handles 'set' magic.
 298
 299 =cut
 300 */
 301
 302 void
 303 Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv)
 304 {
 305     PERL_ARGS_ASSERT_SV_CATSV_MG;
 306
 307     sv_catsv_flags(dsv,ssv,SV_GMAGIC|SV_SMAGIC);
 308 }
 309
 310 /*
 311 =for apidoc sv_iv
 312
 313 A private implementation of the C<SvIVx> macro for compilers which can't
 314 cope with complex macro expressions. Always use the macro instead.
 315
 316 =cut
 317 */
 318
 319 IV
 320 Perl_sv_iv(pTHX_ register SV *sv)
 321 {
 322     PERL_ARGS_ASSERT_SV_IV;
 323
 324     if (SvIOK(sv)) {
 325         if (SvIsUV(sv))
 326             return (IV)SvUVX(sv);
 327         return SvIVX(sv);
 328     }
 329     return sv_2iv(sv);
 330 }
 331
 332 /*
 333 =for apidoc sv_uv
 334
 335 A private implementation of the C<SvUVx> macro for compilers which can't
 336 cope with complex macro expressions. Always use the macro instead.
 337
 338 =cut
 339 */
 340
 341 UV
 342 Perl_sv_uv(pTHX_ register SV *sv)
 343 {
 344     PERL_ARGS_ASSERT_SV_UV;
 345
 346     if (SvIOK(sv)) {
 347         if (SvIsUV(sv))
 348             return SvUVX(sv);
 349         return (UV)SvIVX(sv);
 350     }
 351     return sv_2uv(sv);
 352 }
 353
 354 /*
 355 =for apidoc sv_nv
 356
 357 A private implementation of the C<SvNVx> macro for compilers which can't
 358 cope with complex macro expressions. Always use the macro instead.
 359
 360 =cut
 361 */
 362
 363 NV
 364 Perl_sv_nv(pTHX_ register SV *sv)
 365 {
 366     PERL_ARGS_ASSERT_SV_NV;
 367
 368     if (SvNOK(sv))
 369         return SvNVX(sv);
 370     return sv_2nv(sv);
 371 }
 372
 373 /*
 374 =for apidoc sv_pv
 375
 376 Use the C<SvPV_nolen> macro instead
 377
 378 =for apidoc sv_pvn
 379
 380 A private implementation of the C<SvPV> macro for compilers which can't
 381 cope with complex macro expressions. Always use the macro instead.
 382
 383 =cut
 384 */
 385
 386 char *
 387 Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp)
 388 {
 389     PERL_ARGS_ASSERT_SV_PVN;
 390
 391     if (SvPOK(sv)) {
 392         *lp = SvCUR(sv);
 393         return SvPVX(sv);
 394     }
 395     return sv_2pv(sv, lp);
 396 }
 397
 398
 399 char *
 400 Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp)
 401 {
 402     PERL_ARGS_ASSERT_SV_PVN_NOMG;
 403
 404     if (SvPOK(sv)) {
 405         *lp = SvCUR(sv);
 406         return SvPVX(sv);
 407     }
 408     return sv_2pv_flags(sv, lp, 0);
 409 }
 410
 411 /* sv_pv() is now a macro using SvPV_nolen();
 412  * this function provided for binary compatibility only
 413  */
 414
 415 char *
 416 Perl_sv_pv(pTHX_ SV *sv)
 417 {
 418     PERL_ARGS_ASSERT_SV_PV;
 419
 420     if (SvPOK(sv))
 421         return SvPVX(sv);
 422
 423     return sv_2pv(sv, NULL);
 424 }
 425
 426 /* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags();
 427  * this function provided for binary compatibility only
 428  */
 429
 430 char *
 431 Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
 432 {
 433     PERL_ARGS_ASSERT_SV_PVN_FORCE;
 434
 435     return sv_pvn_force_flags(sv, lp, SV_GMAGIC);
 436 }
 437
 438 /* sv_pvbyte () is now a macro using Perl_sv_2pv_flags();
 439  * this function provided for binary compatibility only
 440  */
 441
 442 char *
 443 Perl_sv_pvbyte(pTHX_ SV *sv)
 444 {
 445     PERL_ARGS_ASSERT_SV_PVBYTE;
 446
 447     sv_utf8_downgrade(sv, FALSE);
 448     return sv_pv(sv);
 449 }
 450
 451 /*
 452 =for apidoc sv_pvbyte
 453
 454 Use C<SvPVbyte_nolen> instead.
 455
 456 =for apidoc sv_pvbyten
 457
 458 A private implementation of the C<SvPVbyte> macro for compilers
 459 which can't cope with complex macro expressions. Always use the macro
 460 instead.
 461
 462 =cut
 463 */
 464
 465 char *
 466 Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp)
 467 {
 468     PERL_ARGS_ASSERT_SV_PVBYTEN;
 469
 470     sv_utf8_downgrade(sv, FALSE);
 471     return sv_pvn(sv,lp);
 472 }
 473
 474 /* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags();
 475  * this function provided for binary compatibility only
 476  */
 477
 478 char *
 479 Perl_sv_pvutf8(pTHX_ SV *sv)
 480 {
 481     PERL_ARGS_ASSERT_SV_PVUTF8;
 482
 483     sv_utf8_upgrade(sv);
 484     return sv_pv(sv);
 485 }
 486
 487 /*
 488 =for apidoc sv_pvutf8
 489
 490 Use the C<SvPVutf8_nolen> macro instead
 491
 492 =for apidoc sv_pvutf8n
 493
 494 A private implementation of the C<SvPVutf8> macro for compilers
 495 which can't cope with complex macro expressions. Always use the macro
 496 instead.
 497
 498 =cut
 499 */
 500
 501 char *
 502 Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp)
 503 {
 504     PERL_ARGS_ASSERT_SV_PVUTF8N;
 505
 506     sv_utf8_upgrade(sv);
 507     return sv_pvn(sv,lp);
 508 }
 509
 510 /* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags();
 511  * this function provided for binary compatibility only
 512  */
 513
 514 STRLEN
 515 Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
 516 {
 517     PERL_ARGS_ASSERT_SV_UTF8_UPGRADE;
 518
 519     return sv_utf8_upgrade_flags(sv, SV_GMAGIC);
 520 }
 521
 522 int
 523 Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
 524 {
 525     dTHXs;
 526     va_list(arglist);
 527
 528     /* Easier to special case this here than in embed.pl. (Look at what it
 529        generates for proto.h) */
 530 #ifdef PERL_IMPLICIT_CONTEXT
 531     PERL_ARGS_ASSERT_FPRINTF_NOCONTEXT;
 532 #endif
 533
 534     va_start(arglist, format);
 535     return PerlIO_vprintf(stream, format, arglist);
 536 }
 537
 538 int
 539 Perl_printf_nocontext(const char *format, ...)
 540 {
 541     dTHX;
 542     va_list(arglist);
 543
 544 #ifdef PERL_IMPLICIT_CONTEXT
 545     PERL_ARGS_ASSERT_PRINTF_NOCONTEXT;
 546 #endif
 547
 548     va_start(arglist, format);
 549     return PerlIO_vprintf(PerlIO_stdout(), format, arglist);
 550 }
 551
 552 #if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL))
 553 /*
 554  * This hack is to force load of "huge" support from libm.a
 555  * So it is in perl for (say) POSIX to use.
 556  * Needed for SunOS with Sun's 'acc' for example.
 557  */
 558 NV
 559 Perl_huge(void)
 560 {
 561 #  if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
 562     return HUGE_VALL;
 563 #  else
 564     return HUGE_VAL;
 565 #  endif
 566 }
 567 #endif
 568
 569 /* compatibility with versions <= 5.003. */
 570 void
 571 Perl_gv_fullname(pTHX_ SV *sv, const GV *gv)
 572 {
 573     PERL_ARGS_ASSERT_GV_FULLNAME;
 574
 575     gv_fullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
 576 }
 577
 578 /* compatibility with versions <= 5.003. */
 579 void
 580 Perl_gv_efullname(pTHX_ SV *sv, const GV *gv)
 581 {
 582     PERL_ARGS_ASSERT_GV_EFULLNAME;
 583
 584     gv_efullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
 585 }
 586
 587 void
 588 Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
 589 {
 590     PERL_ARGS_ASSERT_GV_FULLNAME3;
 591
 592     gv_fullname4(sv, gv, prefix, TRUE);
 593 }
 594
 595 void
 596 Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
 597 {
 598     PERL_ARGS_ASSERT_GV_EFULLNAME3;
 599
 600     gv_efullname4(sv, gv, prefix, TRUE);
 601 }
 602
 603 /*
 604 =for apidoc gv_fetchmethod
 605
 606 See L<gv_fetchmethod_autoload>.
 607
 608 =cut
 609 */
 610
 611 GV *
 612 Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name)
 613 {
 614     PERL_ARGS_ASSERT_GV_FETCHMETHOD;
 615
 616     return gv_fetchmethod_autoload(stash, name, TRUE);
 617 }
 618
 619 HE *
 620 Perl_hv_iternext(pTHX_ HV *hv)
 621 {
 622     PERL_ARGS_ASSERT_HV_ITERNEXT;
 623
 624     return hv_iternext_flags(hv, 0);
 625 }
 626
 627 void
 628 Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
 629 {
 630     PERL_ARGS_ASSERT_HV_MAGIC;
 631
 632     sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0);
 633 }
 634
 635 bool
 636 Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw,
 637              int rawmode, int rawperm, PerlIO *supplied_fp)
 638 {
 639     PERL_ARGS_ASSERT_DO_OPEN;
 640
 641     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
 642                     supplied_fp, (SV **) NULL, 0);
 643 }
 644
 645 bool
 646 Perl_do_open9(pTHX_ GV *gv, register const char *name, I32 len, int
 647 as_raw,
 648               int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
 649               I32 num_svs)
 650 {
 651     PERL_ARGS_ASSERT_DO_OPEN9;
 652
 653     PERL_UNUSED_ARG(num_svs);
 654     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
 655                     supplied_fp, &svs, 1);
 656 }
 657
 658 int
 659 Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
 660 {
 661  /* The old body of this is now in non-LAYER part of perlio.c
 662   * This is a stub for any XS code which might have been calling it.
 663   */
 664  const char *name = ":raw";
 665
 666  PERL_ARGS_ASSERT_DO_BINMODE;
 667
 668 #ifdef PERLIO_USING_CRLF
 669  if (!(mode & O_BINARY))
 670      name = ":crlf";
 671 #endif
 672  return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
 673 }
 674
 675 #ifndef OS2
 676 bool
 677 Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp)
 678 {
 679     PERL_ARGS_ASSERT_DO_AEXEC;
 680
 681     return do_aexec5(really, mark, sp, 0, 0);
 682 }
 683 #endif
 684
 685 #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
 686 bool
 687 Perl_do_exec(pTHX_ const char *cmd)
 688 {
 689     PERL_ARGS_ASSERT_DO_EXEC;
 690
 691     return do_exec3(cmd,0,0);
 692 }
 693 #endif
 694
 695 /* Backwards compatibility. */
 696 int
 697 Perl_init_i18nl14n(pTHX_ int printwarn)
 698 {
 699     return init_i18nl10n(printwarn);
 700 }
 701
 702 PP(pp_padany)
 703 {
 704     DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);
 705 }
 706
 707 PP(pp_mapstart)
 708 {
 709     DIE(aTHX_ "panic: mapstart");       /* uses grepstart */
 710 }
 711
 712 /* These ops all have the same body as pp_null.  */
 713 PP(pp_scalar)
 714 {
 715     dVAR;
 716     return NORMAL;
 717 }
 718
 719 PP(pp_regcmaybe)
 720 {
 721     dVAR;
 722     return NORMAL;
 723 }
 724
 725 PP(pp_lineseq)
 726 {
 727     dVAR;
 728     return NORMAL;
 729 }
 730
 731 PP(pp_scope)
 732 {
 733     dVAR;
 734     return NORMAL;
 735 }
 736
 737 /* Ops that are calls to do_kv.  */
 738 PP(pp_values)
 739 {
 740     return do_kv();
 741 }
 742
 743 PP(pp_keys)
 744 {
 745     return do_kv();
 746 }
 747
 748 /* Ops that are simply calls to other ops.  */
 749 PP(pp_dump)
 750 {
 751     return pp_goto();
 752     /*NOTREACHED*/
 753 }
 754
 755 PP(pp_dofile)
 756 {
 757     return pp_require();
 758 }
 759
 760 PP(pp_dbmclose)
 761 {
 762     return pp_untie();
 763 }
 764
 765 PP(pp_read)
 766 {
 767     return pp_sysread();
 768 }
 769
 770 PP(pp_recv)
 771 {
 772     return pp_sysread();
 773 }
 774
 775 PP(pp_seek)
 776 {
 777     return pp_sysseek();
 778 }
 779
 780 PP(pp_fcntl)
 781 {
 782     return pp_ioctl();
 783 }
 784
 785 PP(pp_gsockopt)
 786 {
 787     return pp_ssockopt();
 788 }
 789
 790 PP(pp_getsockname)
 791 {
 792     return pp_getpeername();
 793 }
 794
 795 PP(pp_lstat)
 796 {
 797     return pp_stat();
 798 }
 799
 800 PP(pp_fteowned)
 801 {
 802     return pp_ftrowned();
 803 }
 804
 805 PP(pp_ftbinary)
 806 {
 807     return pp_fttext();
 808 }
 809
 810 PP(pp_localtime)
 811 {
 812     return pp_gmtime();
 813 }
 814
 815 PP(pp_shmget)
 816 {
 817     return pp_semget();
 818 }
 819
 820 PP(pp_shmctl)
 821 {
 822     return pp_semctl();
 823 }
 824
 825 PP(pp_shmread)
 826 {
 827     return pp_shmwrite();
 828 }
 829
 830 PP(pp_msgget)
 831 {
 832     return pp_semget();
 833 }
 834
 835 PP(pp_msgctl)
 836 {
 837     return pp_semctl();
 838 }
 839
 840 PP(pp_ghbyname)
 841 {
 842     return pp_ghostent();
 843 }
 844
 845 PP(pp_ghbyaddr)
 846 {
 847     return pp_ghostent();
 848 }
 849
 850 PP(pp_gnbyname)
 851 {
 852     return pp_gnetent();
 853 }
 854
 855 PP(pp_gnbyaddr)
 856 {
 857     return pp_gnetent();
 858 }
 859
 860 PP(pp_gpbyname)
 861 {
 862     return pp_gprotoent();
 863 }
 864
 865 PP(pp_gpbynumber)
 866 {
 867     return pp_gprotoent();
 868 }
 869
 870 PP(pp_gsbyname)
 871 {
 872     return pp_gservent();
 873 }
 874
 875 PP(pp_gsbyport)
 876 {
 877     return pp_gservent();
 878 }
 879
 880 PP(pp_gpwnam)
 881 {
 882     return pp_gpwent();
 883 }
 884
 885 PP(pp_gpwuid)
 886 {
 887     return pp_gpwent();
 888 }
 889
 890 PP(pp_ggrnam)
 891 {
 892     return pp_ggrent();
 893 }
 894
 895 PP(pp_ggrgid)
 896 {
 897     return pp_ggrent();
 898 }
 899
 900 PP(pp_ftsize)
 901 {
 902     return pp_ftis();
 903 }
 904
 905 PP(pp_ftmtime)
 906 {
 907     return pp_ftis();
 908 }
 909
 910 PP(pp_ftatime)
 911 {
 912     return pp_ftis();
 913 }
 914
 915 PP(pp_ftctime)
 916 {
 917     return pp_ftis();
 918 }
 919
 920 PP(pp_ftzero)
 921 {
 922     return pp_ftrowned();
 923 }
 924
 925 PP(pp_ftsock)
 926 {
 927     return pp_ftrowned();
 928 }
 929
 930 PP(pp_ftchr)
 931 {
 932     return pp_ftrowned();
 933 }
 934
 935 PP(pp_ftblk)
 936 {
 937     return pp_ftrowned();
 938 }
 939
 940 PP(pp_ftfile)
 941 {
 942     return pp_ftrowned();
 943 }
 944
 945 PP(pp_ftdir)
 946 {
 947     return pp_ftrowned();
 948 }
 949
 950 PP(pp_ftpipe)
 951 {
 952     return pp_ftrowned();
 953 }
 954
 955 PP(pp_ftsuid)
 956 {
 957     return pp_ftrowned();
 958 }
 959
 960 PP(pp_ftsgid)
 961 {
 962     return pp_ftrowned();
 963 }
 964
 965 PP(pp_ftsvtx)
 966 {
 967     return pp_ftrowned();
 968 }
 969
 970 PP(pp_unlink)
 971 {
 972     return pp_chown();
 973 }
 974
 975 PP(pp_chmod)
 976 {
 977     return pp_chown();
 978 }
 979
 980 PP(pp_utime)
 981 {
 982     return pp_chown();
 983 }
 984
 985 PP(pp_kill)
 986 {
 987     return pp_chown();
 988 }
 989
 990 PP(pp_symlink)
 991 {
 992     return pp_link();
 993 }
 994
 995 PP(pp_ftrwrite)
 996 {
 997     return pp_ftrread();
 998 }
 999
1000 PP(pp_ftrexec)
1001 {
1002     return pp_ftrread();
1003 }
1004
1005 PP(pp_fteread)
1006 {
1007     return pp_ftrread();
1008 }
1009
1010 PP(pp_ftewrite)
1011 {
1012     return pp_ftrread();
1013 }
1014
1015 PP(pp_fteexec)
1016 {
1017     return pp_ftrread();
1018 }
1019
1020 PP(pp_msgsnd)
1021 {
1022     return pp_shmwrite();
1023 }
1024
1025 PP(pp_msgrcv)
1026 {
1027     return pp_shmwrite();
1028 }
1029
1030 PP(pp_syswrite)
1031 {
1032     return pp_send();
1033 }
1034
1035 PP(pp_semop)
1036 {
1037     return pp_shmwrite();
1038 }
1039
1040 PP(pp_dor)
1041 {
1042     return pp_defined();
1043 }
1044
1045 PP(pp_andassign)
1046 {
1047     return pp_and();
1048 }
1049
1050 PP(pp_orassign)
1051 {
1052     return pp_or();
1053 }
1054
1055 PP(pp_dorassign)
1056 {
1057     return pp_defined();
1058 }
1059
1060 PP(pp_lcfirst)
1061 {
1062     return pp_ucfirst();
1063 }
1064
1065 PP(pp_slt)
1066 {
1067     return pp_sle();
1068 }
1069
1070 PP(pp_sgt)
1071 {
1072     return pp_sle();
1073 }
1074
1075 PP(pp_sge)
1076 {
1077     return pp_sle();
1078 }
1079
1080 PP(pp_rindex)
1081 {
1082     return pp_index();
1083 }
1084
1085 PP(pp_hex)
1086 {
1087     return pp_oct();
1088 }
1089
1090 PP(pp_pop)
1091 {
1092     return pp_shift();
1093 }
1094
1095 PP(pp_cos)
1096 {
1097     return pp_sin();
1098 }
1099
1100 PP(pp_exp)
1101 {
1102     return pp_sin();
1103 }
1104
1105 PP(pp_log)
1106 {
1107     return pp_sin();
1108 }
1109
1110 PP(pp_sqrt)
1111 {
1112     return pp_sin();
1113 }
1114
1115 PP(pp_bit_xor)
1116 {
1117     return pp_bit_or();
1118 }
1119
1120 PP(pp_rv2hv)
1121 {
1122     return Perl_pp_rv2av(aTHX);
1123 }
1124
1125 U8 *
1126 Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
1127 {
1128     PERL_ARGS_ASSERT_UVUNI_TO_UTF8;
1129
1130     return Perl_uvuni_to_utf8_flags(aTHX_ d, uv, 0);
1131 }
1132
1133 bool
1134 Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep)
1135 {
1136     PERL_ARGS_ASSERT_IS_UTF8_STRING_LOC;
1137
1138     return is_utf8_string_loclen(s, len, ep, 0);
1139 }
1140
1141 /*
1142 =for apidoc sv_nolocking
1143
1144 Dummy routine which "locks" an SV when there is no locking module present.
1145 Exists to avoid test for a NULL function pointer and because it could
1146 potentially warn under some level of strict-ness.
1147
1148 "Superseded" by sv_nosharing().
1149
1150 =cut
1151 */
1152
1153 void
1154 Perl_sv_nolocking(pTHX_ SV *sv)
1155 {
1156     PERL_UNUSED_CONTEXT;
1157     PERL_UNUSED_ARG(sv);
1158 }
1159
1160
1161 /*
1162 =for apidoc sv_nounlocking
1163
1164 Dummy routine which "unlocks" an SV when there is no locking module present.
1165 Exists to avoid test for a NULL function pointer and because it could
1166 potentially warn under some level of strict-ness.
1167
1168 "Superseded" by sv_nosharing().
1169
1170 =cut
1171 */
1172
1173 void
1174 Perl_sv_nounlocking(pTHX_ SV *sv)
1175 {
1176     PERL_UNUSED_CONTEXT;
1177     PERL_UNUSED_ARG(sv);
1178 }
1179
1180 void
1181 Perl_save_long(pTHX_ long int *longp)
1182 {
1183     dVAR;
1184
1185     PERL_ARGS_ASSERT_SAVE_LONG;
1186
1187     SSCHECK(3);
1188     SSPUSHLONG(*longp);
1189     SSPUSHPTR(longp);
1190     SSPUSHUV(SAVEt_LONG);
1191 }
1192
1193 void
1194 Perl_save_iv(pTHX_ IV *ivp)
1195 {
1196     dVAR;
1197
1198     PERL_ARGS_ASSERT_SAVE_IV;
1199
1200     SSCHECK(3);
1201     SSPUSHIV(*ivp);
1202     SSPUSHPTR(ivp);
1203     SSPUSHUV(SAVEt_IV);
1204 }
1205
1206 void
1207 Perl_save_nogv(pTHX_ GV *gv)
1208 {
1209     dVAR;
1210
1211     PERL_ARGS_ASSERT_SAVE_NOGV;
1212
1213     SSCHECK(2);
1214     SSPUSHPTR(gv);
1215     SSPUSHUV(SAVEt_NSTAB);
1216 }
1217
1218 void
1219 Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
1220 {
1221     dVAR;
1222     register I32 i;
1223
1224     PERL_ARGS_ASSERT_SAVE_LIST;
1225
1226     for (i = 1; i <= maxsarg; i++) {
1227         register SV * const sv = newSV(0);
1228         sv_setsv(sv,sarg[i]);
1229         SSCHECK(3);
1230         SSPUSHPTR(sarg[i]);             /* remember the pointer */
1231         SSPUSHPTR(sv);                  /* remember the value */
1232         SSPUSHUV(SAVEt_ITEM);
1233     }
1234 }
1235
1236 /*
1237 =for apidoc sv_usepvn_mg
1238
1239 Like C<sv_usepvn>, but also handles 'set' magic.
1240
1241 =cut
1242 */
1243
1244 void
1245 Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
1246 {
1247     PERL_ARGS_ASSERT_SV_USEPVN_MG;
1248
1249     sv_usepvn_flags(sv,ptr,len, SV_SMAGIC);
1250 }
1251
1252 /*
1253 =for apidoc sv_usepvn
1254
1255 Tells an SV to use C<ptr> to find its string value. Implemented by
1256 calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
1257 magic. See C<sv_usepvn_flags>.
1258
1259 =cut
1260 */
1261
1262 void
1263 Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
1264 {
1265     PERL_ARGS_ASSERT_SV_USEPVN;
1266
1267     sv_usepvn_flags(sv,ptr,len, 0);
1268 }
1269
1270 /*
1271 =for apidoc unpack_str
1272
1273 The engine implementing unpack() Perl function. Note: parameters strbeg, new_s
1274 and ocnt are not used. This call should not be used, use unpackstring instead.
1275
1276 =cut */
1277
1278 I32
1279 Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s,
1280                 const char *strbeg, const char *strend, char **new_s, I32 ocnt,
1281                 U32 flags)
1282 {
1283     PERL_ARGS_ASSERT_UNPACK_STR;
1284
1285     PERL_UNUSED_ARG(strbeg);
1286     PERL_UNUSED_ARG(new_s);
1287     PERL_UNUSED_ARG(ocnt);
1288
1289     return unpackstring(pat, patend, s, strend, flags);
1290 }
1291
1292 /*
1293 =for apidoc pack_cat
1294
1295 The engine implementing pack() Perl function. Note: parameters next_in_list and
1296 flags are not used. This call should not be used; use packlist instead.
1297
1298 =cut
1299 */
1300
1301 void
1302 Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
1303 {
1304     PERL_ARGS_ASSERT_PACK_CAT;
1305
1306     PERL_UNUSED_ARG(next_in_list);
1307     PERL_UNUSED_ARG(flags);
1308
1309     packlist(cat, pat, patend, beglist, endlist);
1310 }
1311
1312 HE *
1313 Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
1314 {
1315   return (HE *)hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash);
1316 }
1317
1318 bool
1319 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
1320 {
1321     PERL_ARGS_ASSERT_HV_EXISTS_ENT;
1322
1323     return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)
1324         ? TRUE : FALSE;
1325 }
1326
1327 HE *
1328 Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash)
1329 {
1330     PERL_ARGS_ASSERT_HV_FETCH_ENT;
1331
1332     return (HE *)hv_common(hv, keysv, NULL, 0, 0,
1333                      (lval ? HV_FETCH_LVALUE : 0), NULL, hash);
1334 }
1335
1336 SV *
1337 Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
1338 {
1339     PERL_ARGS_ASSERT_HV_DELETE_ENT;
1340
1341     return MUTABLE_SV(hv_common(hv, keysv, NULL, 0, 0, flags | HV_DELETE, NULL,
1342                                 hash));
1343 }
1344
1345 SV**
1346 Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash,
1347                     int flags)
1348 {
1349     return (SV**) hv_common(hv, NULL, key, klen, flags,
1350                             (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
1351 }
1352
1353 SV**
1354 Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
1355 {
1356     STRLEN klen;
1357     int flags;
1358
1359     if (klen_i32 < 0) {
1360         klen = -klen_i32;
1361         flags = HVhek_UTF8;
1362     } else {
1363         klen = klen_i32;
1364         flags = 0;
1365     }
1366     return (SV **) hv_common(hv, NULL, key, klen, flags,
1367                              (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
1368 }
1369
1370 bool
1371 Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32)
1372 {
1373     STRLEN klen;
1374     int flags;
1375
1376     PERL_ARGS_ASSERT_HV_EXISTS;
1377
1378     if (klen_i32 < 0) {
1379         klen = -klen_i32;
1380         flags = HVhek_UTF8;
1381     } else {
1382         klen = klen_i32;
1383         flags = 0;
1384     }
1385     return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)
1386         ? TRUE : FALSE;
1387 }
1388
1389 SV**
1390 Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
1391 {
1392     STRLEN klen;
1393     int flags;
1394
1395     PERL_ARGS_ASSERT_HV_FETCH;
1396
1397     if (klen_i32 < 0) {
1398         klen = -klen_i32;
1399         flags = HVhek_UTF8;
1400     } else {
1401         klen = klen_i32;
1402         flags = 0;
1403     }
1404     return (SV **) hv_common(hv, NULL, key, klen, flags,
1405                              lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE)
1406                              : HV_FETCH_JUST_SV, NULL, 0);
1407 }
1408
1409 SV *
1410 Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
1411 {
1412     STRLEN klen;
1413     int k_flags;
1414
1415     PERL_ARGS_ASSERT_HV_DELETE;
1416
1417     if (klen_i32 < 0) {
1418         klen = -klen_i32;
1419         k_flags = HVhek_UTF8;
1420     } else {
1421         klen = klen_i32;
1422         k_flags = 0;
1423     }
1424     return MUTABLE_SV(hv_common(hv, NULL, key, klen, k_flags, flags | HV_DELETE,
1425                                 NULL, 0));
1426 }
1427
1428 /* Functions after here were made mathoms post 5.10.0 but pre 5.8.9 */
1429
1430 AV *
1431 Perl_newAV(pTHX)
1432 {
1433     return MUTABLE_AV(newSV_type(SVt_PVAV));
1434     /* sv_upgrade does AvREAL_only():
1435     AvALLOC(av) = 0;
1436     AvARRAY(av) = NULL;
1437     AvMAX(av) = AvFILLp(av) = -1; */
1438 }
1439
1440 HV *
1441 Perl_newHV(pTHX)
1442 {
1443     HV * const hv = MUTABLE_HV(newSV_type(SVt_PVHV));
1444     assert(!SvOK(hv));
1445
1446     return hv;
1447 }
1448
1449 void
1450 Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len,
1451               const char *const little, const STRLEN littlelen)
1452 {
1453     PERL_ARGS_ASSERT_SV_INSERT;
1454     sv_insert_flags(bigstr, offset, len, little, littlelen, SV_GMAGIC);
1455 }
1456
1457 void
1458 Perl_save_freesv(pTHX_ SV *sv)
1459 {
1460     dVAR;
1461     save_freesv(sv);
1462 }
1463
1464 void
1465 Perl_save_mortalizesv(pTHX_ SV *sv)
1466 {
1467     dVAR;
1468
1469     PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
1470
1471     save_mortalizesv(sv);
1472 }
1473
1474 void
1475 Perl_save_freeop(pTHX_ OP *o)
1476 {
1477     dVAR;
1478     save_freeop(o);
1479 }
1480
1481 void
1482 Perl_save_freepv(pTHX_ char *pv)
1483 {
1484     dVAR;
1485     save_freepv(pv);
1486 }
1487
1488 void
1489 Perl_save_op(pTHX)
1490 {
1491     dVAR;
1492     save_op();
1493 }
1494
1495 #ifdef PERL_DONT_CREATE_GVSV
1496 GV *
1497 Perl_gv_SVadd(pTHX_ GV *gv)
1498 {
1499     return gv_SVadd(gv);
1500 }
1501 #endif
1502
1503 GV *
1504 Perl_gv_AVadd(pTHX_ GV *gv)
1505 {
1506     return gv_AVadd(gv);
1507 }
1508
1509 GV *
1510 Perl_gv_HVadd(pTHX_ register GV *gv)
1511 {
1512     return gv_HVadd(gv);
1513 }
1514
1515 GV *
1516 Perl_gv_IOadd(pTHX_ register GV *gv)
1517 {
1518     return gv_IOadd(gv);
1519 }
1520
1521 IO *
1522 Perl_newIO(pTHX)
1523 {
1524     return MUTABLE_IO(newSV_type(SVt_PVIO));
1525 }
1526
1527 I32
1528 Perl_my_stat(pTHX)
1529 {
1530     return my_stat_flags(SV_GMAGIC);
1531 }
1532
1533 I32
1534 Perl_my_lstat(pTHX)
1535 {
1536     return my_lstat_flags(SV_GMAGIC);
1537 }
1538
1539 I32
1540 Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
1541 {
1542     return sv_eq_flags(sv1, sv2, SV_GMAGIC);
1543 }
1544
1545 char *
1546 Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp)
1547 {
1548     return sv_collxfrm_flags(sv, nxp, SV_GMAGIC);
1549 }
1550
1551 bool
1552 Perl_sv_2bool(pTHX_ register SV *const sv)
1553 {
1554     return sv_2bool_flags(sv, SV_GMAGIC);
1555 }
1556
1557 #endif /* NO_MATHOMS */
1558
1559 /*
1560  * Local variables:
1561  * c-indentation-style: bsd
1562  * c-basic-offset: 4
1563  * indent-tabs-mode: t
1564  * End:
1565  *
1566  * ex: set ts=8 sts=4 sw=4 noet:
1567  */