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