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