mathoms.c

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