mathoms.c

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