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