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 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 #if 0 /* use the macro from hv.h instead */
 537
 538 char*
 539 Perl_sharepvn(pTHX_ const char *sv, I32 len, U32 hash)
 540 {
 541     return HEK_KEY(share_hek(sv, len, hash));
 542 }
 543
 544 #endif
 545
 546 AV *
 547 Perl_av_fake(pTHX_ register I32 size, register SV **strp)
 548 {
 549     register SV** ary;
 550     register AV * const av = (AV*)newSV_type(SVt_PVAV);
 551     Newx(ary,size+1,SV*);
 552     AvALLOC(av) = ary;
 553     Copy(strp,ary,size,SV*);
 554     AvREIFY_only(av);
 555     AvARRAY(av) = ary;
 556     AvFILLp(av) = size - 1;
 557     AvMAX(av) = size - 1;
 558     while (size--) {
 559         assert (*strp);
 560         SvTEMP_off(*strp);
 561         strp++;
 562     }
 563     return av;
 564 }
 565
 566 bool
 567 Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw,
 568              int rawmode, int rawperm, PerlIO *supplied_fp)
 569 {
 570     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
 571                     supplied_fp, (SV **) NULL, 0);
 572 }
 573
 574 bool
 575 Perl_do_open9(pTHX_ GV *gv, register const char *name, I32 len, int
 576 as_raw,
 577               int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
 578               I32 num_svs)
 579 {
 580     PERL_UNUSED_ARG(num_svs);
 581     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
 582                     supplied_fp, &svs, 1);
 583 }
 584
 585 int
 586 Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
 587 {
 588  /* The old body of this is now in non-LAYER part of perlio.c
 589   * This is a stub for any XS code which might have been calling it.
 590   */
 591  const char *name = ":raw";
 592 #ifdef PERLIO_USING_CRLF
 593  if (!(mode & O_BINARY))
 594      name = ":crlf";
 595 #endif
 596  return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
 597 }
 598
 599 #ifndef OS2
 600 bool
 601 Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp)
 602 {
 603     return do_aexec5(really, mark, sp, 0, 0);
 604 }
 605 #endif
 606
 607 #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
 608 bool
 609 Perl_do_exec(pTHX_ const char *cmd)
 610 {
 611     return do_exec3(cmd,0,0);
 612 }
 613 #endif
 614
 615 #ifdef HAS_PIPE
 616 void
 617 Perl_do_pipe(pTHX_ SV *sv, GV *rgv, GV *wgv)
 618 {
 619     dVAR;
 620     register IO *rstio;
 621     register IO *wstio;
 622     int fd[2];
 623
 624     if (!rgv)
 625         goto badexit;
 626     if (!wgv)
 627         goto badexit;
 628
 629     rstio = GvIOn(rgv);
 630     wstio = GvIOn(wgv);
 631
 632     if (IoIFP(rstio))
 633         do_close(rgv,FALSE);
 634     if (IoIFP(wstio))
 635         do_close(wgv,FALSE);
 636
 637     if (PerlProc_pipe(fd) < 0)
 638         goto badexit;
 639     IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPE_OPEN_MODE);
 640     IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPE_OPEN_MODE);
 641     IoOFP(rstio) = IoIFP(rstio);
 642     IoIFP(wstio) = IoOFP(wstio);
 643     IoTYPE(rstio) = IoTYPE_RDONLY;
 644     IoTYPE(wstio) = IoTYPE_WRONLY;
 645     if (!IoIFP(rstio) || !IoOFP(wstio)) {
 646         if (IoIFP(rstio)) PerlIO_close(IoIFP(rstio));
 647         else PerlLIO_close(fd[0]);
 648         if (IoOFP(wstio)) PerlIO_close(IoOFP(wstio));
 649         else PerlLIO_close(fd[1]);
 650         goto badexit;
 651     }
 652
 653     sv_setsv(sv,&PL_sv_yes);
 654     return;
 655
 656 badexit:
 657     sv_setsv(sv,&PL_sv_undef);
 658     return;
 659 }
 660 #endif
 661
 662 /* Backwards compatibility. */
 663 int
 664 Perl_init_i18nl14n(pTHX_ int printwarn)
 665 {
 666     return init_i18nl10n(printwarn);
 667 }
 668
 669 /* XXX kept for BINCOMPAT only */
 670 void
 671 Perl_save_hints(pTHX)
 672 {
 673     Perl_croak(aTHX_ "internal error: obsolete function save_hints() called");
 674 }
 675
 676 #if 0
 677 OP *
 678 Perl_ck_retarget(pTHX_ OP *o)
 679 {
 680     Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
 681     /* STUB */
 682     return o;
 683 }
 684 #endif
 685
 686 OP *
 687 Perl_oopsCV(pTHX_ OP *o)
 688 {
 689     Perl_croak(aTHX_ "NOT IMPL LINE %d",__LINE__);
 690     /* STUB */
 691     PERL_UNUSED_ARG(o);
 692     NORETURN_FUNCTION_END;
 693 }
 694
 695 PP(pp_padany)
 696 {
 697     DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);
 698 }
 699
 700 PP(pp_threadsv)
 701 {
 702     DIE(aTHX_ "tried to access per-thread data in non-threaded perl");
 703 }
 704
 705 PP(pp_mapstart)
 706 {
 707     DIE(aTHX_ "panic: mapstart");       /* uses grepstart */
 708 }
 709
 710 /* These ops all have the same body as pp_null.  */
 711 PP(pp_scalar)
 712 {
 713     dVAR;
 714     return NORMAL;
 715 }
 716
 717 PP(pp_regcmaybe)
 718 {
 719     dVAR;
 720     return NORMAL;
 721 }
 722
 723 PP(pp_lineseq)
 724 {
 725     dVAR;
 726     return NORMAL;
 727 }
 728
 729 PP(pp_scope)
 730 {
 731     dVAR;
 732     return NORMAL;
 733 }
 734
 735 /* Ops that are calls to do_kv.  */
 736 PP(pp_values)
 737 {
 738     return do_kv();
 739 }
 740
 741 PP(pp_keys)
 742 {
 743     return do_kv();
 744 }
 745
 746 /* Ops that are simply calls to other ops.  */
 747 PP(pp_dump)
 748 {
 749     return pp_goto();
 750     /*NOTREACHED*/
 751 }
 752
 753 PP(pp_dofile)
 754 {
 755     return pp_require();
 756 }
 757
 758 PP(pp_dbmclose)
 759 {
 760     return pp_untie();
 761 }
 762
 763 PP(pp_read)
 764 {
 765     return pp_sysread();
 766 }
 767
 768 PP(pp_recv)
 769 {
 770     return pp_sysread();
 771 }
 772
 773 PP(pp_seek)
 774 {
 775     return pp_sysseek();
 776 }
 777
 778 PP(pp_fcntl)
 779 {
 780     return pp_ioctl();
 781 }
 782
 783 PP(pp_gsockopt)
 784 {
 785     return pp_ssockopt();
 786 }
 787
 788 PP(pp_getsockname)
 789 {
 790     return pp_getpeername();
 791 }
 792
 793 PP(pp_lstat)
 794 {
 795     return pp_stat();
 796 }
 797
 798 PP(pp_fteowned)
 799 {
 800     return pp_ftrowned();
 801 }
 802
 803 PP(pp_ftbinary)
 804 {
 805     return pp_fttext();
 806 }
 807
 808 PP(pp_localtime)
 809 {
 810     return pp_gmtime();
 811 }
 812
 813 PP(pp_shmget)
 814 {
 815     return pp_semget();
 816 }
 817
 818 PP(pp_shmctl)
 819 {
 820     return pp_semctl();
 821 }
 822
 823 PP(pp_shmread)
 824 {
 825     return pp_shmwrite();
 826 }
 827
 828 PP(pp_msgget)
 829 {
 830     return pp_semget();
 831 }
 832
 833 PP(pp_msgctl)
 834 {
 835     return pp_semctl();
 836 }
 837
 838 PP(pp_ghbyname)
 839 {
 840     return pp_ghostent();
 841 }
 842
 843 PP(pp_ghbyaddr)
 844 {
 845     return pp_ghostent();
 846 }
 847
 848 PP(pp_gnbyname)
 849 {
 850     return pp_gnetent();
 851 }
 852
 853 PP(pp_gnbyaddr)
 854 {
 855     return pp_gnetent();
 856 }
 857
 858 PP(pp_gpbyname)
 859 {
 860     return pp_gprotoent();
 861 }
 862
 863 PP(pp_gpbynumber)
 864 {
 865     return pp_gprotoent();
 866 }
 867
 868 PP(pp_gsbyname)
 869 {
 870     return pp_gservent();
 871 }
 872
 873 PP(pp_gsbyport)
 874 {
 875     return pp_gservent();
 876 }
 877
 878 PP(pp_gpwnam)
 879 {
 880     return pp_gpwent();
 881 }
 882
 883 PP(pp_gpwuid)
 884 {
 885     return pp_gpwent();
 886 }
 887
 888 PP(pp_ggrnam)
 889 {
 890     return pp_ggrent();
 891 }
 892
 893 PP(pp_ggrgid)
 894 {
 895     return pp_ggrent();
 896 }
 897
 898 PP(pp_ftsize)
 899 {
 900     return pp_ftis();
 901 }
 902
 903 PP(pp_ftmtime)
 904 {
 905     return pp_ftis();
 906 }
 907
 908 PP(pp_ftatime)
 909 {
 910     return pp_ftis();
 911 }
 912
 913 PP(pp_ftctime)
 914 {
 915     return pp_ftis();
 916 }
 917
 918 PP(pp_ftzero)
 919 {
 920     return pp_ftrowned();
 921 }
 922
 923 PP(pp_ftsock)
 924 {
 925     return pp_ftrowned();
 926 }
 927
 928 PP(pp_ftchr)
 929 {
 930     return pp_ftrowned();
 931 }
 932
 933 PP(pp_ftblk)
 934 {
 935     return pp_ftrowned();
 936 }
 937
 938 PP(pp_ftfile)
 939 {
 940     return pp_ftrowned();
 941 }
 942
 943 PP(pp_ftdir)
 944 {
 945     return pp_ftrowned();
 946 }
 947
 948 PP(pp_ftpipe)
 949 {
 950     return pp_ftrowned();
 951 }
 952
 953 PP(pp_ftsuid)
 954 {
 955     return pp_ftrowned();
 956 }
 957
 958 PP(pp_ftsgid)
 959 {
 960     return pp_ftrowned();
 961 }
 962
 963 PP(pp_ftsvtx)
 964 {
 965     return pp_ftrowned();
 966 }
 967
 968 PP(pp_unlink)
 969 {
 970     return pp_chown();
 971 }
 972
 973 PP(pp_chmod)
 974 {
 975     return pp_chown();
 976 }
 977
 978 PP(pp_utime)
 979 {
 980     return pp_chown();
 981 }
 982
 983 PP(pp_kill)
 984 {
 985     return pp_chown();
 986 }
 987
 988 PP(pp_symlink)
 989 {
 990     return pp_link();
 991 }
 992
 993 PP(pp_ftrwrite)
 994 {
 995     return pp_ftrread();
 996 }
 997
 998 PP(pp_ftrexec)
 999 {
1000     return pp_ftrread();
1001 }
1002
1003 PP(pp_fteread)
1004 {
1005     return pp_ftrread();
1006 }
1007
1008 PP(pp_ftewrite)
1009 {
1010     return pp_ftrread();
1011 }
1012
1013 PP(pp_fteexec)
1014 {
1015     return pp_ftrread();
1016 }
1017
1018 PP(pp_msgsnd)
1019 {
1020     return pp_shmwrite();
1021 }
1022
1023 PP(pp_msgrcv)
1024 {
1025     return pp_shmwrite();
1026 }
1027
1028 PP(pp_syswrite)
1029 {
1030     return pp_send();
1031 }
1032
1033 PP(pp_semop)
1034 {
1035     return pp_shmwrite();
1036 }
1037
1038 PP(pp_dor)
1039 {
1040     return pp_defined();
1041 }
1042
1043 PP(pp_andassign)
1044 {
1045     return pp_and();
1046 }
1047
1048 PP(pp_orassign)
1049 {
1050     return pp_or();
1051 }
1052
1053 PP(pp_dorassign)
1054 {
1055     return pp_defined();
1056 }
1057
1058 PP(pp_lcfirst)
1059 {
1060     return pp_ucfirst();
1061 }
1062
1063 PP(pp_slt)
1064 {
1065     return pp_sle();
1066 }
1067
1068 PP(pp_sgt)
1069 {
1070     return pp_sle();
1071 }
1072
1073 PP(pp_sge)
1074 {
1075     return pp_sle();
1076 }
1077
1078 PP(pp_rindex)
1079 {
1080     return pp_index();
1081 }
1082
1083 PP(pp_hex)
1084 {
1085     return pp_oct();
1086 }
1087
1088 PP(pp_pop)
1089 {
1090     return pp_shift();
1091 }
1092
1093 PP(pp_cos)
1094 {
1095     return pp_sin();
1096 }
1097
1098 PP(pp_exp)
1099 {
1100     return pp_sin();
1101 }
1102
1103 PP(pp_log)
1104 {
1105     return pp_sin();
1106 }
1107
1108 PP(pp_sqrt)
1109 {
1110     return pp_sin();
1111 }
1112
1113 PP(pp_bit_xor)
1114 {
1115     return pp_bit_or();
1116 }
1117
1118 PP(pp_rv2hv)
1119 {
1120     return Perl_pp_rv2av(aTHX);
1121 }
1122
1123 U8 *
1124 Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
1125 {
1126     return Perl_uvuni_to_utf8_flags(aTHX_ d, uv, 0);
1127 }
1128
1129 bool
1130 Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep)
1131 {
1132     return is_utf8_string_loclen(s, len, ep, 0);
1133 }
1134
1135 /*
1136 =for apidoc sv_nolocking
1137
1138 Dummy routine which "locks" an SV when there is no locking module present.
1139 Exists to avoid test for a NULL function pointer and because it could
1140 potentially warn under some level of strict-ness.
1141
1142 "Superseded" by sv_nosharing().
1143
1144 =cut
1145 */
1146
1147 void
1148 Perl_sv_nolocking(pTHX_ SV *sv)
1149 {
1150     PERL_UNUSED_CONTEXT;
1151     PERL_UNUSED_ARG(sv);
1152 }
1153
1154
1155 /*
1156 =for apidoc sv_nounlocking
1157
1158 Dummy routine which "unlocks" an SV when there is no locking module present.
1159 Exists to avoid test for a NULL function pointer and because it could
1160 potentially warn under some level of strict-ness.
1161
1162 "Superseded" by sv_nosharing().
1163
1164 =cut
1165 */
1166
1167 void
1168 Perl_sv_nounlocking(pTHX_ SV *sv)
1169 {
1170     PERL_UNUSED_CONTEXT;
1171     PERL_UNUSED_ARG(sv);
1172 }
1173
1174 void
1175 Perl_save_long(pTHX_ long int *longp)
1176 {
1177     dVAR;
1178     SSCHECK(3);
1179     SSPUSHLONG(*longp);
1180     SSPUSHPTR(longp);
1181     SSPUSHINT(SAVEt_LONG);
1182 }
1183
1184 void
1185 Perl_save_I16(pTHX_ I16 *intp)
1186 {
1187     dVAR;
1188     SSCHECK(3);
1189     SSPUSHINT(*intp);
1190     SSPUSHPTR(intp);
1191     SSPUSHINT(SAVEt_I16);
1192 }
1193
1194 void
1195 Perl_save_iv(pTHX_ IV *ivp)
1196 {
1197     dVAR;
1198     SSCHECK(3);
1199     SSPUSHIV(*ivp);
1200     SSPUSHPTR(ivp);
1201     SSPUSHINT(SAVEt_IV);
1202 }
1203
1204 void
1205 Perl_save_nogv(pTHX_ GV *gv)
1206 {
1207     dVAR;
1208     SSCHECK(2);
1209     SSPUSHPTR(gv);
1210     SSPUSHINT(SAVEt_NSTAB);
1211 }
1212
1213 void
1214 Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
1215 {
1216     dVAR;
1217     register I32 i;
1218
1219     for (i = 1; i <= maxsarg; i++) {
1220         register SV * const sv = newSV(0);
1221         sv_setsv(sv,sarg[i]);
1222         SSCHECK(3);
1223         SSPUSHPTR(sarg[i]);             /* remember the pointer */
1224         SSPUSHPTR(sv);                  /* remember the value */
1225         SSPUSHINT(SAVEt_ITEM);
1226     }
1227 }
1228
1229 /*
1230 =for apidoc sv_usepvn_mg
1231
1232 Like C<sv_usepvn>, but also handles 'set' magic.
1233
1234 =cut
1235 */
1236
1237 void
1238 Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
1239 {
1240     sv_usepvn_flags(sv,ptr,len, SV_SMAGIC);
1241 }
1242
1243 /*
1244 =for apidoc sv_usepvn
1245
1246 Tells an SV to use C<ptr> to find its string value. Implemented by
1247 calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
1248 magic. See C<sv_usepvn_flags>.
1249
1250 =cut
1251 */
1252
1253 void
1254 Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
1255 {
1256     sv_usepvn_flags(sv,ptr,len, 0);
1257 }
1258
1259 void
1260 Perl_cv_ckproto(pTHX_ const CV *cv, const GV *gv, const char *p)
1261 {
1262     cv_ckproto_len(cv, gv, p, p ? strlen(p) : 0);
1263 }
1264
1265 /*
1266 =for apidoc unpack_str
1267
1268 The engine implementing unpack() Perl function. Note: parameters strbeg, new_s
1269 and ocnt are not used. This call should not be used, use unpackstring instead.
1270
1271 =cut */
1272
1273 I32
1274 Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s,
1275                 const char *strbeg, const char *strend, char **new_s, I32 ocnt,
1276                 U32 flags)
1277 {
1278     PERL_UNUSED_ARG(strbeg);
1279     PERL_UNUSED_ARG(new_s);
1280     PERL_UNUSED_ARG(ocnt);
1281
1282     return unpackstring(pat, patend, s, strend, flags);
1283 }
1284
1285 /*
1286 =for apidoc pack_cat
1287
1288 The engine implementing pack() Perl function. Note: parameters next_in_list and
1289 flags are not used. This call should not be used; use packlist instead.
1290
1291 =cut
1292 */
1293
1294 void
1295 Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
1296 {
1297     PERL_UNUSED_ARG(next_in_list);
1298     PERL_UNUSED_ARG(flags);
1299
1300     packlist(cat, pat, patend, beglist, endlist);
1301 }
1302 #endif /* NO_MATHOMS */
1303
1304 /*
1305  * Local variables:
1306  * c-indentation-style: bsd
1307  * c-basic-offset: 4
1308  * indent-tabs-mode: t
1309  * End:
1310  *
1311  * ex: set ts=8 sts=4 sw=4 noet:
1312  */