mathoms.c

   1 /*    mathoms.c
   2  *
   3  *    Copyright (C) 2005, 2006, 2007, 2008 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  *     [p.5 of _The Lord of the Rings_: "Prologue"]
  17  */
  18
  19
  20
  21 /*
  22  * This file contains mathoms, various binary artifacts from previous
  23  * versions of Perl.  For binary or source compatibility reasons, though,
  24  * we cannot completely remove them from the core code.
  25  *
  26  * SMP - Oct. 24, 2005
  27  *
  28  */
  29
  30 #include "EXTERN.h"
  31 #define PERL_IN_MATHOMS_C
  32 #include "perl.h"
  33
  34 #ifdef NO_MATHOMS
  35 /* ..." warning: ISO C forbids an empty source file"
  36    So make sure we have something in here by processing the headers anyway.
  37  */
  38 #else
  39
  40 PERL_CALLCONV OP * Perl_ref(pTHX_ OP *o, I32 type);
  41 PERL_CALLCONV void Perl_sv_unref(pTHX_ SV *sv);
  42 PERL_CALLCONV void Perl_sv_taint(pTHX_ SV *sv);
  43 PERL_CALLCONV IV Perl_sv_2iv(pTHX_ register SV *sv);
  44 PERL_CALLCONV UV Perl_sv_2uv(pTHX_ register SV *sv);
  45 PERL_CALLCONV NV Perl_sv_2nv(pTHX_ register SV *sv);
  46 PERL_CALLCONV char * Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp);
  47 PERL_CALLCONV char * Perl_sv_2pv_nolen(pTHX_ register SV *sv);
  48 PERL_CALLCONV char * Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv);
  49 PERL_CALLCONV char * Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv);
  50 PERL_CALLCONV void Perl_sv_force_normal(pTHX_ register SV *sv);
  51 PERL_CALLCONV void Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr);
  52 PERL_CALLCONV void Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen);
  53 PERL_CALLCONV void Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len);
  54 PERL_CALLCONV void Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr);
  55 PERL_CALLCONV void Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv);
  56 PERL_CALLCONV char * Perl_sv_pv(pTHX_ SV *sv);
  57 PERL_CALLCONV char * Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp);
  58 PERL_CALLCONV char * Perl_sv_pvbyte(pTHX_ SV *sv);
  59 PERL_CALLCONV char * Perl_sv_pvutf8(pTHX_ SV *sv);
  60 PERL_CALLCONV STRLEN Perl_sv_utf8_upgrade(pTHX_ register SV *sv);
  61 PERL_CALLCONV NV Perl_huge(void);
  62 PERL_CALLCONV void Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
  63 PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
  64 PERL_CALLCONV GV * Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name);
  65 PERL_CALLCONV HE * Perl_hv_iternext(pTHX_ HV *hv);
  66 PERL_CALLCONV void Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how);
  67 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);
  68 PERL_CALLCONV bool Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp);
  69 PERL_CALLCONV bool Perl_do_exec(pTHX_ const char *cmd);
  70 PERL_CALLCONV U8 * Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv);
  71 PERL_CALLCONV bool Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep);
  72 PERL_CALLCONV void Perl_sv_nolocking(pTHX_ SV *sv);
  73 PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
  74 PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len);
  75 PERL_CALLCONV int Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...);
  76 PERL_CALLCONV int Perl_printf_nocontext(const char *format, ...);
  77 PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg);
  78 PERL_CALLCONV AV * Perl_newAV(pTHX);
  79 PERL_CALLCONV HV * Perl_newHV(pTHX);
  80 PERL_CALLCONV IO * Perl_newIO(pTHX);
  81 PERL_CALLCONV I32 Perl_my_stat(pTHX);
  82 PERL_CALLCONV I32 Perl_my_lstat(pTHX);
  83 PERL_CALLCONV I32 Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2);
  84 PERL_CALLCONV char * Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp);
  85 PERL_CALLCONV bool Perl_sv_2bool(pTHX_ register SV *const sv);
  86 PERL_CALLCONV CV * Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP* block);
  87
  88 /* ref() is now a macro using Perl_doref;
  89  * this version provided for binary compatibility only.
  90  */
  91 OP *
  92 Perl_ref(pTHX_ OP *o, I32 type)
  93 {
  94     return doref(o, type, TRUE);
  95 }
  96
  97 /*
  98 =for apidoc sv_unref
  99
 100 Unsets the RV status of the SV, and decrements the reference count of
 101 whatever was being referenced by the RV.  This can almost be thought of
 102 as a reversal of C<newSVrv>.  This is C<sv_unref_flags> with the C<flag>
 103 being zero.  See C<SvROK_off>.
 104
 105 =cut
 106 */
 107
 108 void
 109 Perl_sv_unref(pTHX_ SV *sv)
 110 {
 111     PERL_ARGS_ASSERT_SV_UNREF;
 112
 113     sv_unref_flags(sv, 0);
 114 }
 115
 116 /*
 117 =for apidoc sv_taint
 118
 119 Taint an SV. Use C<SvTAINTED_on> instead.
 120 =cut
 121 */
 122
 123 void
 124 Perl_sv_taint(pTHX_ SV *sv)
 125 {
 126     PERL_ARGS_ASSERT_SV_TAINT;
 127
 128     sv_magic((sv), NULL, PERL_MAGIC_taint, NULL, 0);
 129 }
 130
 131 /* sv_2iv() is now a macro using Perl_sv_2iv_flags();
 132  * this function provided for binary compatibility only
 133  */
 134
 135 IV
 136 Perl_sv_2iv(pTHX_ register SV *sv)
 137 {
 138     return sv_2iv_flags(sv, SV_GMAGIC);
 139 }
 140
 141 /* sv_2uv() is now a macro using Perl_sv_2uv_flags();
 142  * this function provided for binary compatibility only
 143  */
 144
 145 UV
 146 Perl_sv_2uv(pTHX_ register SV *sv)
 147 {
 148     return sv_2uv_flags(sv, SV_GMAGIC);
 149 }
 150
 151 /* sv_2nv() is now a macro using Perl_sv_2nv_flags();
 152  * this function provided for binary compatibility only
 153  */
 154
 155 NV
 156 Perl_sv_2nv(pTHX_ register SV *sv)
 157 {
 158     return sv_2nv_flags(sv, SV_GMAGIC);
 159 }
 160
 161
 162 /* sv_2pv() is now a macro using Perl_sv_2pv_flags();
 163  * this function provided for binary compatibility only
 164  */
 165
 166 char *
 167 Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp)
 168 {
 169     return sv_2pv_flags(sv, lp, SV_GMAGIC);
 170 }
 171
 172 /*
 173 =for apidoc sv_2pv_nolen
 174
 175 Like C<sv_2pv()>, but doesn't return the length too. You should usually
 176 use the macro wrapper C<SvPV_nolen(sv)> instead.
 177 =cut
 178 */
 179
 180 char *
 181 Perl_sv_2pv_nolen(pTHX_ register SV *sv)
 182 {
 183     PERL_ARGS_ASSERT_SV_2PV_NOLEN;
 184     return sv_2pv(sv, NULL);
 185 }
 186
 187 /*
 188 =for apidoc sv_2pvbyte_nolen
 189
 190 Return a pointer to the byte-encoded representation of the SV.
 191 May cause the SV to be downgraded from UTF-8 as a side-effect.
 192
 193 Usually accessed via the C<SvPVbyte_nolen> macro.
 194
 195 =cut
 196 */
 197
 198 char *
 199 Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv)
 200 {
 201     PERL_ARGS_ASSERT_SV_2PVBYTE_NOLEN;
 202
 203     return sv_2pvbyte(sv, NULL);
 204 }
 205
 206 /*
 207 =for apidoc sv_2pvutf8_nolen
 208
 209 Return a pointer to the UTF-8-encoded representation of the SV.
 210 May cause the SV to be upgraded to UTF-8 as a side-effect.
 211
 212 Usually accessed via the C<SvPVutf8_nolen> macro.
 213
 214 =cut
 215 */
 216
 217 char *
 218 Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv)
 219 {
 220     PERL_ARGS_ASSERT_SV_2PVUTF8_NOLEN;
 221
 222     return sv_2pvutf8(sv, NULL);
 223 }
 224
 225 /*
 226 =for apidoc sv_force_normal
 227
 228 Undo various types of fakery on an SV: if the PV is a shared string, make
 229 a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
 230 an xpvmg. See also C<sv_force_normal_flags>.
 231
 232 =cut
 233 */
 234
 235 void
 236 Perl_sv_force_normal(pTHX_ register SV *sv)
 237 {
 238     PERL_ARGS_ASSERT_SV_FORCE_NORMAL;
 239
 240     sv_force_normal_flags(sv, 0);
 241 }
 242
 243 /* sv_setsv() is now a macro using Perl_sv_setsv_flags();
 244  * this function provided for binary compatibility only
 245  */
 246
 247 void
 248 Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr)
 249 {
 250     PERL_ARGS_ASSERT_SV_SETSV;
 251
 252     sv_setsv_flags(dstr, sstr, SV_GMAGIC);
 253 }
 254
 255 /* sv_catpvn() is now a macro using Perl_sv_catpvn_flags();
 256  * this function provided for binary compatibility only
 257  */
 258
 259 void
 260 Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen)
 261 {
 262     PERL_ARGS_ASSERT_SV_CATPVN;
 263
 264     sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC);
 265 }
 266
 267 /*
 268 =for apidoc sv_catpvn_mg
 269
 270 Like C<sv_catpvn>, but also handles 'set' magic.
 271
 272 =cut
 273 */
 274
 275 void
 276 Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len)
 277 {
 278     PERL_ARGS_ASSERT_SV_CATPVN_MG;
 279
 280     sv_catpvn_flags(sv,ptr,len,SV_GMAGIC|SV_SMAGIC);
 281 }
 282
 283 /* sv_catsv() is now a macro using Perl_sv_catsv_flags();
 284  * this function provided for binary compatibility only
 285  */
 286
 287 void
 288 Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr)
 289 {
 290     PERL_ARGS_ASSERT_SV_CATSV;
 291
 292     sv_catsv_flags(dstr, sstr, SV_GMAGIC);
 293 }
 294
 295 /*
 296 =for apidoc sv_catsv_mg
 297
 298 Like C<sv_catsv>, but also handles 'set' magic.
 299
 300 =cut
 301 */
 302
 303 void
 304 Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv)
 305 {
 306     PERL_ARGS_ASSERT_SV_CATSV_MG;
 307
 308     sv_catsv_flags(dsv,ssv,SV_GMAGIC|SV_SMAGIC);
 309 }
 310
 311 /*
 312 =for apidoc sv_iv
 313
 314 A private implementation of the C<SvIVx> macro for compilers which can't
 315 cope with complex macro expressions. Always use the macro instead.
 316
 317 =cut
 318 */
 319
 320 IV
 321 Perl_sv_iv(pTHX_ register SV *sv)
 322 {
 323     PERL_ARGS_ASSERT_SV_IV;
 324
 325     if (SvIOK(sv)) {
 326         if (SvIsUV(sv))
 327             return (IV)SvUVX(sv);
 328         return SvIVX(sv);
 329     }
 330     return sv_2iv(sv);
 331 }
 332
 333 /*
 334 =for apidoc sv_uv
 335
 336 A private implementation of the C<SvUVx> macro for compilers which can't
 337 cope with complex macro expressions. Always use the macro instead.
 338
 339 =cut
 340 */
 341
 342 UV
 343 Perl_sv_uv(pTHX_ register SV *sv)
 344 {
 345     PERL_ARGS_ASSERT_SV_UV;
 346
 347     if (SvIOK(sv)) {
 348         if (SvIsUV(sv))
 349             return SvUVX(sv);
 350         return (UV)SvIVX(sv);
 351     }
 352     return sv_2uv(sv);
 353 }
 354
 355 /*
 356 =for apidoc sv_nv
 357
 358 A private implementation of the C<SvNVx> macro for compilers which can't
 359 cope with complex macro expressions. Always use the macro instead.
 360
 361 =cut
 362 */
 363
 364 NV
 365 Perl_sv_nv(pTHX_ register SV *sv)
 366 {
 367     PERL_ARGS_ASSERT_SV_NV;
 368
 369     if (SvNOK(sv))
 370         return SvNVX(sv);
 371     return sv_2nv(sv);
 372 }
 373
 374 /*
 375 =for apidoc sv_pv
 376
 377 Use the C<SvPV_nolen> macro instead
 378
 379 =for apidoc sv_pvn
 380
 381 A private implementation of the C<SvPV> macro for compilers which can't
 382 cope with complex macro expressions. Always use the macro instead.
 383
 384 =cut
 385 */
 386
 387 char *
 388 Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp)
 389 {
 390     PERL_ARGS_ASSERT_SV_PVN;
 391
 392     if (SvPOK(sv)) {
 393         *lp = SvCUR(sv);
 394         return SvPVX(sv);
 395     }
 396     return sv_2pv(sv, lp);
 397 }
 398
 399
 400 char *
 401 Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp)
 402 {
 403     PERL_ARGS_ASSERT_SV_PVN_NOMG;
 404
 405     if (SvPOK(sv)) {
 406         *lp = SvCUR(sv);
 407         return SvPVX(sv);
 408     }
 409     return sv_2pv_flags(sv, lp, 0);
 410 }
 411
 412 /* sv_pv() is now a macro using SvPV_nolen();
 413  * this function provided for binary compatibility only
 414  */
 415
 416 char *
 417 Perl_sv_pv(pTHX_ SV *sv)
 418 {
 419     PERL_ARGS_ASSERT_SV_PV;
 420
 421     if (SvPOK(sv))
 422         return SvPVX(sv);
 423
 424     return sv_2pv(sv, NULL);
 425 }
 426
 427 /* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags();
 428  * this function provided for binary compatibility only
 429  */
 430
 431 char *
 432 Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
 433 {
 434     PERL_ARGS_ASSERT_SV_PVN_FORCE;
 435
 436     return sv_pvn_force_flags(sv, lp, SV_GMAGIC);
 437 }
 438
 439 /* sv_pvbyte () is now a macro using Perl_sv_2pv_flags();
 440  * this function provided for binary compatibility only
 441  */
 442
 443 char *
 444 Perl_sv_pvbyte(pTHX_ SV *sv)
 445 {
 446     PERL_ARGS_ASSERT_SV_PVBYTE;
 447
 448     sv_utf8_downgrade(sv, FALSE);
 449     return sv_pv(sv);
 450 }
 451
 452 /*
 453 =for apidoc sv_pvbyte
 454
 455 Use C<SvPVbyte_nolen> instead.
 456
 457 =for apidoc sv_pvbyten
 458
 459 A private implementation of the C<SvPVbyte> macro for compilers
 460 which can't cope with complex macro expressions. Always use the macro
 461 instead.
 462
 463 =cut
 464 */
 465
 466 char *
 467 Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp)
 468 {
 469     PERL_ARGS_ASSERT_SV_PVBYTEN;
 470
 471     sv_utf8_downgrade(sv, FALSE);
 472     return sv_pvn(sv,lp);
 473 }
 474
 475 /* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags();
 476  * this function provided for binary compatibility only
 477  */
 478
 479 char *
 480 Perl_sv_pvutf8(pTHX_ SV *sv)
 481 {
 482     PERL_ARGS_ASSERT_SV_PVUTF8;
 483
 484     sv_utf8_upgrade(sv);
 485     return sv_pv(sv);
 486 }
 487
 488 /*
 489 =for apidoc sv_pvutf8
 490
 491 Use the C<SvPVutf8_nolen> macro instead
 492
 493 =for apidoc sv_pvutf8n
 494
 495 A private implementation of the C<SvPVutf8> macro for compilers
 496 which can't cope with complex macro expressions. Always use the macro
 497 instead.
 498
 499 =cut
 500 */
 501
 502 char *
 503 Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp)
 504 {
 505     PERL_ARGS_ASSERT_SV_PVUTF8N;
 506
 507     sv_utf8_upgrade(sv);
 508     return sv_pvn(sv,lp);
 509 }
 510
 511 /* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags();
 512  * this function provided for binary compatibility only
 513  */
 514
 515 STRLEN
 516 Perl_sv_utf8_upgrade(pTHX_ register SV *sv)
 517 {
 518     PERL_ARGS_ASSERT_SV_UTF8_UPGRADE;
 519
 520     return sv_utf8_upgrade_flags(sv, SV_GMAGIC);
 521 }
 522
 523 int
 524 Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
 525 {
 526     dTHXs;
 527     va_list(arglist);
 528
 529     /* Easier to special case this here than in embed.pl. (Look at what it
 530        generates for proto.h) */
 531 #ifdef PERL_IMPLICIT_CONTEXT
 532     PERL_ARGS_ASSERT_FPRINTF_NOCONTEXT;
 533 #endif
 534
 535     va_start(arglist, format);
 536     return PerlIO_vprintf(stream, format, arglist);
 537 }
 538
 539 int
 540 Perl_printf_nocontext(const char *format, ...)
 541 {
 542     dTHX;
 543     va_list(arglist);
 544
 545 #ifdef PERL_IMPLICIT_CONTEXT
 546     PERL_ARGS_ASSERT_PRINTF_NOCONTEXT;
 547 #endif
 548
 549     va_start(arglist, format);
 550     return PerlIO_vprintf(PerlIO_stdout(), format, arglist);
 551 }
 552
 553 #if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL))
 554 /*
 555  * This hack is to force load of "huge" support from libm.a
 556  * So it is in perl for (say) POSIX to use.
 557  * Needed for SunOS with Sun's 'acc' for example.
 558  */
 559 NV
 560 Perl_huge(void)
 561 {
 562 #  if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
 563     return HUGE_VALL;
 564 #  else
 565     return HUGE_VAL;
 566 #  endif
 567 }
 568 #endif
 569
 570 /* compatibility with versions <= 5.003. */
 571 void
 572 Perl_gv_fullname(pTHX_ SV *sv, const GV *gv)
 573 {
 574     PERL_ARGS_ASSERT_GV_FULLNAME;
 575
 576     gv_fullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
 577 }
 578
 579 /* compatibility with versions <= 5.003. */
 580 void
 581 Perl_gv_efullname(pTHX_ SV *sv, const GV *gv)
 582 {
 583     PERL_ARGS_ASSERT_GV_EFULLNAME;
 584
 585     gv_efullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
 586 }
 587
 588 void
 589 Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
 590 {
 591     PERL_ARGS_ASSERT_GV_FULLNAME3;
 592
 593     gv_fullname4(sv, gv, prefix, TRUE);
 594 }
 595
 596 void
 597 Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
 598 {
 599     PERL_ARGS_ASSERT_GV_EFULLNAME3;
 600
 601     gv_efullname4(sv, gv, prefix, TRUE);
 602 }
 603
 604 /*
 605 =for apidoc gv_fetchmethod
 606
 607 See L<gv_fetchmethod_autoload>.
 608
 609 =cut
 610 */
 611
 612 GV *
 613 Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name)
 614 {
 615     PERL_ARGS_ASSERT_GV_FETCHMETHOD;
 616
 617     return gv_fetchmethod_autoload(stash, name, TRUE);
 618 }
 619
 620 HE *
 621 Perl_hv_iternext(pTHX_ HV *hv)
 622 {
 623     PERL_ARGS_ASSERT_HV_ITERNEXT;
 624
 625     return hv_iternext_flags(hv, 0);
 626 }
 627
 628 void
 629 Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
 630 {
 631     PERL_ARGS_ASSERT_HV_MAGIC;
 632
 633     sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0);
 634 }
 635
 636 bool
 637 Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw,
 638              int rawmode, int rawperm, PerlIO *supplied_fp)
 639 {
 640     PERL_ARGS_ASSERT_DO_OPEN;
 641
 642     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
 643                     supplied_fp, (SV **) NULL, 0);
 644 }
 645
 646 bool
 647 Perl_do_open9(pTHX_ GV *gv, register const char *name, I32 len, int
 648 as_raw,
 649               int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
 650               I32 num_svs)
 651 {
 652     PERL_ARGS_ASSERT_DO_OPEN9;
 653
 654     PERL_UNUSED_ARG(num_svs);
 655     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
 656                     supplied_fp, &svs, 1);
 657 }
 658
 659 int
 660 Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
 661 {
 662  /* The old body of this is now in non-LAYER part of perlio.c
 663   * This is a stub for any XS code which might have been calling it.
 664   */
 665  const char *name = ":raw";
 666
 667  PERL_ARGS_ASSERT_DO_BINMODE;
 668
 669 #ifdef PERLIO_USING_CRLF
 670  if (!(mode & O_BINARY))
 671      name = ":crlf";
 672 #endif
 673  return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
 674 }
 675
 676 #ifndef OS2
 677 bool
 678 Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp)
 679 {
 680     PERL_ARGS_ASSERT_DO_AEXEC;
 681
 682     return do_aexec5(really, mark, sp, 0, 0);
 683 }
 684 #endif
 685
 686 #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION
 687 bool
 688 Perl_do_exec(pTHX_ const char *cmd)
 689 {
 690     PERL_ARGS_ASSERT_DO_EXEC;
 691
 692     return do_exec3(cmd,0,0);
 693 }
 694 #endif
 695
 696 /* Backwards compatibility. */
 697 int
 698 Perl_init_i18nl14n(pTHX_ int printwarn)
 699 {
 700     return init_i18nl10n(printwarn);
 701 }
 702
 703 PP(pp_padany)
 704 {
 705     DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);
 706 }
 707
 708 PP(pp_mapstart)
 709 {
 710     DIE(aTHX_ "panic: mapstart");       /* uses grepstart */
 711 }
 712
 713 /* These ops all have the same body as pp_null.  */
 714 PP(pp_scalar)
 715 {
 716     dVAR;
 717     return NORMAL;
 718 }
 719
 720 PP(pp_regcmaybe)
 721 {
 722     dVAR;
 723     return NORMAL;
 724 }
 725
 726 PP(pp_lineseq)
 727 {
 728     dVAR;
 729     return NORMAL;
 730 }
 731
 732 PP(pp_scope)
 733 {
 734     dVAR;
 735     return NORMAL;
 736 }
 737
 738 /* Ops that are calls to do_kv.  */
 739 PP(pp_values)
 740 {
 741     return do_kv();
 742 }
 743
 744 PP(pp_keys)
 745 {
 746     return do_kv();
 747 }
 748
 749 /* Ops that are simply calls to other ops.  */
 750 PP(pp_dump)
 751 {
 752     return pp_goto();
 753     /*NOTREACHED*/
 754 }
 755
 756 PP(pp_dofile)
 757 {
 758     return pp_require();
 759 }
 760
 761 PP(pp_dbmclose)
 762 {
 763     return pp_untie();
 764 }
 765
 766 PP(pp_read)
 767 {
 768     return pp_sysread();
 769 }
 770
 771 PP(pp_recv)
 772 {
 773     return pp_sysread();
 774 }
 775
 776 PP(pp_seek)
 777 {
 778     return pp_sysseek();
 779 }
 780
 781 PP(pp_fcntl)
 782 {
 783     return pp_ioctl();
 784 }
 785
 786 PP(pp_gsockopt)
 787 {
 788     return pp_ssockopt();
 789 }
 790
 791 PP(pp_getsockname)
 792 {
 793     return pp_getpeername();
 794 }
 795
 796 PP(pp_lstat)
 797 {
 798     return pp_stat();
 799 }
 800
 801 PP(pp_fteowned)
 802 {
 803     return pp_ftrowned();
 804 }
 805
 806 PP(pp_ftbinary)
 807 {
 808     return pp_fttext();
 809 }
 810
 811 PP(pp_localtime)
 812 {
 813     return pp_gmtime();
 814 }
 815
 816 PP(pp_shmget)
 817 {
 818     return pp_semget();
 819 }
 820
 821 PP(pp_shmctl)
 822 {
 823     return pp_semctl();
 824 }
 825
 826 PP(pp_shmread)
 827 {
 828     return pp_shmwrite();
 829 }
 830
 831 PP(pp_msgget)
 832 {
 833     return pp_semget();
 834 }
 835
 836 PP(pp_msgctl)
 837 {
 838     return pp_semctl();
 839 }
 840
 841 PP(pp_ghbyname)
 842 {
 843     return pp_ghostent();
 844 }
 845
 846 PP(pp_ghbyaddr)
 847 {
 848     return pp_ghostent();
 849 }
 850
 851 PP(pp_gnbyname)
 852 {
 853     return pp_gnetent();
 854 }
 855
 856 PP(pp_gnbyaddr)
 857 {
 858     return pp_gnetent();
 859 }
 860
 861 PP(pp_gpbyname)
 862 {
 863     return pp_gprotoent();
 864 }
 865
 866 PP(pp_gpbynumber)
 867 {
 868     return pp_gprotoent();
 869 }
 870
 871 PP(pp_gsbyname)
 872 {
 873     return pp_gservent();
 874 }
 875
 876 PP(pp_gsbyport)
 877 {
 878     return pp_gservent();
 879 }
 880
 881 PP(pp_gpwnam)
 882 {
 883     return pp_gpwent();
 884 }
 885
 886 PP(pp_gpwuid)
 887 {
 888     return pp_gpwent();
 889 }
 890
 891 PP(pp_ggrnam)
 892 {
 893     return pp_ggrent();
 894 }
 895
 896 PP(pp_ggrgid)
 897 {
 898     return pp_ggrent();
 899 }
 900
 901 PP(pp_ftsize)
 902 {
 903     return pp_ftis();
 904 }
 905
 906 PP(pp_ftmtime)
 907 {
 908     return pp_ftis();
 909 }
 910
 911 PP(pp_ftatime)
 912 {
 913     return pp_ftis();
 914 }
 915
 916 PP(pp_ftctime)
 917 {
 918     return pp_ftis();
 919 }
 920
 921 PP(pp_ftzero)
 922 {
 923     return pp_ftrowned();
 924 }
 925
 926 PP(pp_ftsock)
 927 {
 928     return pp_ftrowned();
 929 }
 930
 931 PP(pp_ftchr)
 932 {
 933     return pp_ftrowned();
 934 }
 935
 936 PP(pp_ftblk)
 937 {
 938     return pp_ftrowned();
 939 }
 940
 941 PP(pp_ftfile)
 942 {
 943     return pp_ftrowned();
 944 }
 945
 946 PP(pp_ftdir)
 947 {
 948     return pp_ftrowned();
 949 }
 950
 951 PP(pp_ftpipe)
 952 {
 953     return pp_ftrowned();
 954 }
 955
 956 PP(pp_ftsuid)
 957 {
 958     return pp_ftrowned();
 959 }
 960
 961 PP(pp_ftsgid)
 962 {
 963     return pp_ftrowned();
 964 }
 965
 966 PP(pp_ftsvtx)
 967 {
 968     return pp_ftrowned();
 969 }
 970
 971 PP(pp_unlink)
 972 {
 973     return pp_chown();
 974 }
 975
 976 PP(pp_chmod)
 977 {
 978     return pp_chown();
 979 }
 980
 981 PP(pp_utime)
 982 {
 983     return pp_chown();
 984 }
 985
 986 PP(pp_kill)
 987 {
 988     return pp_chown();
 989 }
 990
 991 PP(pp_symlink)
 992 {
 993     return pp_link();
 994 }
 995
 996 PP(pp_ftrwrite)
 997 {
 998     return pp_ftrread();
 999 }
1000
1001 PP(pp_ftrexec)
1002 {
1003     return pp_ftrread();
1004 }
1005
1006 PP(pp_fteread)
1007 {
1008     return pp_ftrread();
1009 }
1010
1011 PP(pp_ftewrite)
1012 {
1013     return pp_ftrread();
1014 }
1015
1016 PP(pp_fteexec)
1017 {
1018     return pp_ftrread();
1019 }
1020
1021 PP(pp_msgsnd)
1022 {
1023     return pp_shmwrite();
1024 }
1025
1026 PP(pp_msgrcv)
1027 {
1028     return pp_shmwrite();
1029 }
1030
1031 PP(pp_syswrite)
1032 {
1033     return pp_send();
1034 }
1035
1036 PP(pp_semop)
1037 {
1038     return pp_shmwrite();
1039 }
1040
1041 PP(pp_dor)
1042 {
1043     return pp_defined();
1044 }
1045
1046 PP(pp_andassign)
1047 {
1048     return pp_and();
1049 }
1050
1051 PP(pp_orassign)
1052 {
1053     return pp_or();
1054 }
1055
1056 PP(pp_dorassign)
1057 {
1058     return pp_defined();
1059 }
1060
1061 PP(pp_lcfirst)
1062 {
1063     return pp_ucfirst();
1064 }
1065
1066 PP(pp_slt)
1067 {
1068     return pp_sle();
1069 }
1070
1071 PP(pp_sgt)
1072 {
1073     return pp_sle();
1074 }
1075
1076 PP(pp_sge)
1077 {
1078     return pp_sle();
1079 }
1080
1081 PP(pp_rindex)
1082 {
1083     return pp_index();
1084 }
1085
1086 PP(pp_hex)
1087 {
1088     return pp_oct();
1089 }
1090
1091 PP(pp_pop)
1092 {
1093     return pp_shift();
1094 }
1095
1096 PP(pp_cos)
1097 {
1098     return pp_sin();
1099 }
1100
1101 PP(pp_exp)
1102 {
1103     return pp_sin();
1104 }
1105
1106 PP(pp_log)
1107 {
1108     return pp_sin();
1109 }
1110
1111 PP(pp_sqrt)
1112 {
1113     return pp_sin();
1114 }
1115
1116 PP(pp_bit_xor)
1117 {
1118     return pp_bit_or();
1119 }
1120
1121 PP(pp_rv2hv)
1122 {
1123     return Perl_pp_rv2av(aTHX);
1124 }
1125
1126 PP(pp_schomp)
1127 {
1128     return Perl_pp_chomp(aTHX);
1129 }
1130
1131 PP(pp_chomp)
1132 {
1133     return Perl_pp_chop(aTHX);
1134 }
1135
1136 PP(pp_connect)
1137 {
1138     return Perl_pp_bind(aTHX);
1139 }
1140
1141 U8 *
1142 Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv)
1143 {
1144     PERL_ARGS_ASSERT_UVUNI_TO_UTF8;
1145
1146     return Perl_uvuni_to_utf8_flags(aTHX_ d, uv, 0);
1147 }
1148
1149 bool
1150 Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep)
1151 {
1152     PERL_ARGS_ASSERT_IS_UTF8_STRING_LOC;
1153
1154     return is_utf8_string_loclen(s, len, ep, 0);
1155 }
1156
1157 /*
1158 =for apidoc sv_nolocking
1159
1160 Dummy routine which "locks" an SV when there is no locking module present.
1161 Exists to avoid test for a NULL function pointer and because it could
1162 potentially warn under some level of strict-ness.
1163
1164 "Superseded" by sv_nosharing().
1165
1166 =cut
1167 */
1168
1169 void
1170 Perl_sv_nolocking(pTHX_ SV *sv)
1171 {
1172     PERL_UNUSED_CONTEXT;
1173     PERL_UNUSED_ARG(sv);
1174 }
1175
1176
1177 /*
1178 =for apidoc sv_nounlocking
1179
1180 Dummy routine which "unlocks" an SV when there is no locking module present.
1181 Exists to avoid test for a NULL function pointer and because it could
1182 potentially warn under some level of strict-ness.
1183
1184 "Superseded" by sv_nosharing().
1185
1186 =cut
1187 */
1188
1189 void
1190 Perl_sv_nounlocking(pTHX_ SV *sv)
1191 {
1192     PERL_UNUSED_CONTEXT;
1193     PERL_UNUSED_ARG(sv);
1194 }
1195
1196 void
1197 Perl_save_long(pTHX_ long int *longp)
1198 {
1199     dVAR;
1200
1201     PERL_ARGS_ASSERT_SAVE_LONG;
1202
1203     SSCHECK(3);
1204     SSPUSHLONG(*longp);
1205     SSPUSHPTR(longp);
1206     SSPUSHUV(SAVEt_LONG);
1207 }
1208
1209 void
1210 Perl_save_iv(pTHX_ IV *ivp)
1211 {
1212     dVAR;
1213
1214     PERL_ARGS_ASSERT_SAVE_IV;
1215
1216     SSCHECK(3);
1217     SSPUSHIV(*ivp);
1218     SSPUSHPTR(ivp);
1219     SSPUSHUV(SAVEt_IV);
1220 }
1221
1222 void
1223 Perl_save_nogv(pTHX_ GV *gv)
1224 {
1225     dVAR;
1226
1227     PERL_ARGS_ASSERT_SAVE_NOGV;
1228
1229     SSCHECK(2);
1230     SSPUSHPTR(gv);
1231     SSPUSHUV(SAVEt_NSTAB);
1232 }
1233
1234 void
1235 Perl_save_list(pTHX_ register SV **sarg, I32 maxsarg)
1236 {
1237     dVAR;
1238     register I32 i;
1239
1240     PERL_ARGS_ASSERT_SAVE_LIST;
1241
1242     for (i = 1; i <= maxsarg; i++) {
1243         register SV * const sv = newSV(0);
1244         sv_setsv(sv,sarg[i]);
1245         SSCHECK(3);
1246         SSPUSHPTR(sarg[i]);             /* remember the pointer */
1247         SSPUSHPTR(sv);                  /* remember the value */
1248         SSPUSHUV(SAVEt_ITEM);
1249     }
1250 }
1251
1252 /*
1253 =for apidoc sv_usepvn_mg
1254
1255 Like C<sv_usepvn>, but also handles 'set' magic.
1256
1257 =cut
1258 */
1259
1260 void
1261 Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
1262 {
1263     PERL_ARGS_ASSERT_SV_USEPVN_MG;
1264
1265     sv_usepvn_flags(sv,ptr,len, SV_SMAGIC);
1266 }
1267
1268 /*
1269 =for apidoc sv_usepvn
1270
1271 Tells an SV to use C<ptr> to find its string value. Implemented by
1272 calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
1273 magic. See C<sv_usepvn_flags>.
1274
1275 =cut
1276 */
1277
1278 void
1279 Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
1280 {
1281     PERL_ARGS_ASSERT_SV_USEPVN;
1282
1283     sv_usepvn_flags(sv,ptr,len, 0);
1284 }
1285
1286 /*
1287 =for apidoc unpack_str
1288
1289 The engine implementing unpack() Perl function. Note: parameters strbeg, new_s
1290 and ocnt are not used. This call should not be used, use unpackstring instead.
1291
1292 =cut */
1293
1294 I32
1295 Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s,
1296                 const char *strbeg, const char *strend, char **new_s, I32 ocnt,
1297                 U32 flags)
1298 {
1299     PERL_ARGS_ASSERT_UNPACK_STR;
1300
1301     PERL_UNUSED_ARG(strbeg);
1302     PERL_UNUSED_ARG(new_s);
1303     PERL_UNUSED_ARG(ocnt);
1304
1305     return unpackstring(pat, patend, s, strend, flags);
1306 }
1307
1308 /*
1309 =for apidoc pack_cat
1310
1311 The engine implementing pack() Perl function. Note: parameters next_in_list and
1312 flags are not used. This call should not be used; use packlist instead.
1313
1314 =cut
1315 */
1316
1317 void
1318 Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
1319 {
1320     PERL_ARGS_ASSERT_PACK_CAT;
1321
1322     PERL_UNUSED_ARG(next_in_list);
1323     PERL_UNUSED_ARG(flags);
1324
1325     packlist(cat, pat, patend, beglist, endlist);
1326 }
1327
1328 HE *
1329 Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
1330 {
1331   return (HE *)hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash);
1332 }
1333
1334 bool
1335 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
1336 {
1337     PERL_ARGS_ASSERT_HV_EXISTS_ENT;
1338
1339     return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)
1340         ? TRUE : FALSE;
1341 }
1342
1343 HE *
1344 Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash)
1345 {
1346     PERL_ARGS_ASSERT_HV_FETCH_ENT;
1347
1348     return (HE *)hv_common(hv, keysv, NULL, 0, 0,
1349                      (lval ? HV_FETCH_LVALUE : 0), NULL, hash);
1350 }
1351
1352 SV *
1353 Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
1354 {
1355     PERL_ARGS_ASSERT_HV_DELETE_ENT;
1356
1357     return MUTABLE_SV(hv_common(hv, keysv, NULL, 0, 0, flags | HV_DELETE, NULL,
1358                                 hash));
1359 }
1360
1361 SV**
1362 Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash,
1363                     int flags)
1364 {
1365     return (SV**) hv_common(hv, NULL, key, klen, flags,
1366                             (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
1367 }
1368
1369 SV**
1370 Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
1371 {
1372     STRLEN klen;
1373     int flags;
1374
1375     if (klen_i32 < 0) {
1376         klen = -klen_i32;
1377         flags = HVhek_UTF8;
1378     } else {
1379         klen = klen_i32;
1380         flags = 0;
1381     }
1382     return (SV **) hv_common(hv, NULL, key, klen, flags,
1383                              (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
1384 }
1385
1386 bool
1387 Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32)
1388 {
1389     STRLEN klen;
1390     int flags;
1391
1392     PERL_ARGS_ASSERT_HV_EXISTS;
1393
1394     if (klen_i32 < 0) {
1395         klen = -klen_i32;
1396         flags = HVhek_UTF8;
1397     } else {
1398         klen = klen_i32;
1399         flags = 0;
1400     }
1401     return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)
1402         ? TRUE : FALSE;
1403 }
1404
1405 SV**
1406 Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
1407 {
1408     STRLEN klen;
1409     int flags;
1410
1411     PERL_ARGS_ASSERT_HV_FETCH;
1412
1413     if (klen_i32 < 0) {
1414         klen = -klen_i32;
1415         flags = HVhek_UTF8;
1416     } else {
1417         klen = klen_i32;
1418         flags = 0;
1419     }
1420     return (SV **) hv_common(hv, NULL, key, klen, flags,
1421                              lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE)
1422                              : HV_FETCH_JUST_SV, NULL, 0);
1423 }
1424
1425 SV *
1426 Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
1427 {
1428     STRLEN klen;
1429     int k_flags;
1430
1431     PERL_ARGS_ASSERT_HV_DELETE;
1432
1433     if (klen_i32 < 0) {
1434         klen = -klen_i32;
1435         k_flags = HVhek_UTF8;
1436     } else {
1437         klen = klen_i32;
1438         k_flags = 0;
1439     }
1440     return MUTABLE_SV(hv_common(hv, NULL, key, klen, k_flags, flags | HV_DELETE,
1441                                 NULL, 0));
1442 }
1443
1444 /* Functions after here were made mathoms post 5.10.0 but pre 5.8.9 */
1445
1446 AV *
1447 Perl_newAV(pTHX)
1448 {
1449     return MUTABLE_AV(newSV_type(SVt_PVAV));
1450     /* sv_upgrade does AvREAL_only():
1451     AvALLOC(av) = 0;
1452     AvARRAY(av) = NULL;
1453     AvMAX(av) = AvFILLp(av) = -1; */
1454 }
1455
1456 HV *
1457 Perl_newHV(pTHX)
1458 {
1459     HV * const hv = MUTABLE_HV(newSV_type(SVt_PVHV));
1460     assert(!SvOK(hv));
1461
1462     return hv;
1463 }
1464
1465 void
1466 Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len,
1467               const char *const little, const STRLEN littlelen)
1468 {
1469     PERL_ARGS_ASSERT_SV_INSERT;
1470     sv_insert_flags(bigstr, offset, len, little, littlelen, SV_GMAGIC);
1471 }
1472
1473 void
1474 Perl_save_freesv(pTHX_ SV *sv)
1475 {
1476     dVAR;
1477     save_freesv(sv);
1478 }
1479
1480 void
1481 Perl_save_mortalizesv(pTHX_ SV *sv)
1482 {
1483     dVAR;
1484
1485     PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
1486
1487     save_mortalizesv(sv);
1488 }
1489
1490 void
1491 Perl_save_freeop(pTHX_ OP *o)
1492 {
1493     dVAR;
1494     save_freeop(o);
1495 }
1496
1497 void
1498 Perl_save_freepv(pTHX_ char *pv)
1499 {
1500     dVAR;
1501     save_freepv(pv);
1502 }
1503
1504 void
1505 Perl_save_op(pTHX)
1506 {
1507     dVAR;
1508     save_op();
1509 }
1510
1511 #ifdef PERL_DONT_CREATE_GVSV
1512 GV *
1513 Perl_gv_SVadd(pTHX_ GV *gv)
1514 {
1515     return gv_SVadd(gv);
1516 }
1517 #endif
1518
1519 GV *
1520 Perl_gv_AVadd(pTHX_ GV *gv)
1521 {
1522     return gv_AVadd(gv);
1523 }
1524
1525 GV *
1526 Perl_gv_HVadd(pTHX_ register GV *gv)
1527 {
1528     return gv_HVadd(gv);
1529 }
1530
1531 GV *
1532 Perl_gv_IOadd(pTHX_ register GV *gv)
1533 {
1534     return gv_IOadd(gv);
1535 }
1536
1537 IO *
1538 Perl_newIO(pTHX)
1539 {
1540     return MUTABLE_IO(newSV_type(SVt_PVIO));
1541 }
1542
1543 I32
1544 Perl_my_stat(pTHX)
1545 {
1546     return my_stat_flags(SV_GMAGIC);
1547 }
1548
1549 I32
1550 Perl_my_lstat(pTHX)
1551 {
1552     return my_lstat_flags(SV_GMAGIC);
1553 }
1554
1555 I32
1556 Perl_sv_eq(pTHX_ register SV *sv1, register SV *sv2)
1557 {
1558     return sv_eq_flags(sv1, sv2, SV_GMAGIC);
1559 }
1560
1561 char *
1562 Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp)
1563 {
1564     return sv_collxfrm_flags(sv, nxp, SV_GMAGIC);
1565 }
1566
1567 bool
1568 Perl_sv_2bool(pTHX_ register SV *const sv)
1569 {
1570     return sv_2bool_flags(sv, SV_GMAGIC);
1571 }
1572
1573
1574 /*
1575 =for apidoc custom_op_name
1576 Return the name for a given custom op. This was once used by the OP_NAME
1577 macro, but is no longer: it has only been kept for compatibility, and
1578 should not be used.
1579
1580 =for apidoc custom_op_desc
1581 Return the description of a given custom op. This was once used by the
1582 OP_DESC macro, but is no longer: it has only been kept for
1583 compatibility, and should not be used.
1584
1585 =cut
1586 */
1587
1588 const char*
1589 Perl_custom_op_name(pTHX_ const OP* o)
1590 {
1591     PERL_ARGS_ASSERT_CUSTOM_OP_NAME;
1592     return XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_name);
1593 }
1594
1595 const char*
1596 Perl_custom_op_desc(pTHX_ const OP* o)
1597 {
1598     PERL_ARGS_ASSERT_CUSTOM_OP_DESC;
1599     return XopENTRY(Perl_custom_op_xop(aTHX_ o), xop_desc);
1600 }
1601
1602 CV *
1603 Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block)
1604 {
1605     return Perl_newATTRSUB(aTHX_ floor, o, proto, NULL, block);
1606 }
1607 #endif /* NO_MATHOMS */
1608
1609 /*
1610  * Local variables:
1611  * c-indentation-style: bsd
1612  * c-basic-offset: 4
1613  * indent-tabs-mode: t
1614  * End:
1615  *
1616  * ex: set ts=8 sts=4 sw=4 noet:
1617  */