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