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