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