mathoms.c

   1 /*    mathoms.c
   2  *
   3  *    Copyright (C) 2005, 2006, 2007, 2008, 2009, 2010,
   4  *    2011, 2012 by Larry Wall and others
   5  *
   6  *    You may distribute under the terms of either the GNU General Public
   7  *    License or the Artistic License, as specified in the README file.
   8  *
   9  */
  10
  11 /*
  12  *  Anything that Hobbits had no immediate use for, but were unwilling to
  13  *  throw away, they called a mathom.  Their dwellings were apt to become
  14  *  rather crowded with mathoms, and many of the presents that passed from
  15  *  hand to hand were of that sort.
  16  *
  17  *     [p.5 of _The Lord of the Rings_: "Prologue"]
  18  */
  19
  20
  21
  22 /*
  23  * This file contains mathoms, various binary artifacts from previous
  24  * versions of Perl.  For binary or source compatibility reasons, though,
  25  * we cannot completely remove them from the core code.
  26  *
  27  * SMP - Oct. 24, 2005
  28  *
  29  * The compilation of this file can be suppressed; see INSTALL
  30  *
  31  */
  32
  33 #include "EXTERN.h"
  34 #define PERL_IN_MATHOMS_C
  35 #include "perl.h"
  36
  37 #ifdef NO_MATHOMS
  38 /* ..." warning: ISO C forbids an empty source file"
  39    So make sure we have something in here by processing the headers anyway.
  40  */
  41 #else
  42
  43 /* Not all of these have prototypes elsewhere, so do this to get
  44  * non-mangled names.
  45  */
  46 START_EXTERN_C
  47
  48 PERL_CALLCONV OP * Perl_ref(pTHX_ OP *o, I32 type);
  49 PERL_CALLCONV void Perl_sv_unref(pTHX_ SV *sv);
  50 PERL_CALLCONV void Perl_sv_taint(pTHX_ SV *sv);
  51 PERL_CALLCONV IV Perl_sv_2iv(pTHX_ SV *sv);
  52 PERL_CALLCONV UV Perl_sv_2uv(pTHX_ SV *sv);
  53 PERL_CALLCONV NV Perl_sv_2nv(pTHX_ SV *sv);
  54 PERL_CALLCONV char * Perl_sv_2pv(pTHX_ SV *sv, STRLEN *lp);
  55 PERL_CALLCONV char * Perl_sv_2pv_nolen(pTHX_ SV *sv);
  56 PERL_CALLCONV char * Perl_sv_2pvbyte_nolen(pTHX_ SV *sv);
  57 PERL_CALLCONV char * Perl_sv_2pvutf8_nolen(pTHX_ SV *sv);
  58 PERL_CALLCONV void Perl_sv_force_normal(pTHX_ SV *sv);
  59 PERL_CALLCONV void Perl_sv_setsv(pTHX_ SV *dstr, SV *sstr);
  60 PERL_CALLCONV void Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen);
  61 PERL_CALLCONV void Perl_sv_catpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len);
  62 PERL_CALLCONV void Perl_sv_catsv(pTHX_ SV *dstr, SV *sstr);
  63 PERL_CALLCONV void Perl_sv_catsv_mg(pTHX_ SV *dsv, SV *ssv);
  64 PERL_CALLCONV char * Perl_sv_pv(pTHX_ SV *sv);
  65 PERL_CALLCONV char * Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp);
  66 PERL_CALLCONV char * Perl_sv_pvbyte(pTHX_ SV *sv);
  67 PERL_CALLCONV char * Perl_sv_pvutf8(pTHX_ SV *sv);
  68 PERL_CALLCONV STRLEN Perl_sv_utf8_upgrade(pTHX_ SV *sv);
  69 PERL_CALLCONV NV Perl_huge(void);
  70 PERL_CALLCONV void Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
  71 PERL_CALLCONV void Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix);
  72 PERL_CALLCONV GV * Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name);
  73 PERL_CALLCONV HE * Perl_hv_iternext(pTHX_ HV *hv);
  74 PERL_CALLCONV void Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how);
  75 PERL_CALLCONV bool Perl_do_open(pTHX_ GV *gv, const char *name, I32 len, int as_raw, int rawmode, int rawperm, PerlIO *supplied_fp);
  76 PERL_CALLCONV bool Perl_do_aexec(pTHX_ SV *really, SV **mark, SV **sp);
  77 PERL_CALLCONV U8 * Perl_uvuni_to_utf8(pTHX_ U8 *d, UV uv);
  78 PERL_CALLCONV bool Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep);
  79 PERL_CALLCONV void Perl_sv_nolocking(pTHX_ SV *sv);
  80 PERL_CALLCONV void Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len);
  81 PERL_CALLCONV void Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len);
  82 PERL_CALLCONV int Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...);
  83 PERL_CALLCONV int Perl_printf_nocontext(const char *format, ...);
  84 PERL_CALLCONV int Perl_magic_setglob(pTHX_ SV* sv, MAGIC* mg);
  85 PERL_CALLCONV AV * Perl_newAV(pTHX);
  86 PERL_CALLCONV HV * Perl_newHV(pTHX);
  87 PERL_CALLCONV IO * Perl_newIO(pTHX);
  88 PERL_CALLCONV I32 Perl_my_stat(pTHX);
  89 PERL_CALLCONV I32 Perl_my_lstat(pTHX);
  90 PERL_CALLCONV I32 Perl_sv_eq(pTHX_ SV *sv1, SV *sv2);
  91 PERL_CALLCONV char * Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp);
  92 PERL_CALLCONV bool Perl_sv_2bool(pTHX_ SV *const sv);
  93 PERL_CALLCONV CV * Perl_newSUB(pTHX_ I32 floor, OP* o, OP* proto, OP* block);
  94 PERL_CALLCONV UV Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
  95 PERL_CALLCONV UV Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
  96 PERL_CALLCONV UV Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
  97 PERL_CALLCONV UV Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp);
  98 PERL_CALLCONV SV *Perl_sv_mortalcopy(pTHX_ SV *const oldstr);
  99
 100 /* ref() is now a macro using Perl_doref;
 101  * this version provided for binary compatibility only.
 102  */
 103 OP *
 104 Perl_ref(pTHX_ OP *o, I32 type)
 105 {
 106     return doref(o, type, TRUE);
 107 }
 108
 109 /*
 110 =for apidoc sv_unref
 111
 112 Unsets the RV status of the SV, and decrements the reference count of
 113 whatever was being referenced by the RV.  This can almost be thought of
 114 as a reversal of C<newSVrv>.  This is C<sv_unref_flags> with the C<flag>
 115 being zero.  See C<SvROK_off>.
 116
 117 =cut
 118 */
 119
 120 void
 121 Perl_sv_unref(pTHX_ SV *sv)
 122 {
 123     PERL_ARGS_ASSERT_SV_UNREF;
 124
 125     sv_unref_flags(sv, 0);
 126 }
 127
 128 /*
 129 =for apidoc sv_taint
 130
 131 Taint an SV. Use C<SvTAINTED_on> instead.
 132
 133 =cut
 134 */
 135
 136 void
 137 Perl_sv_taint(pTHX_ SV *sv)
 138 {
 139     PERL_ARGS_ASSERT_SV_TAINT;
 140
 141     sv_magic((sv), NULL, PERL_MAGIC_taint, NULL, 0);
 142 }
 143
 144 /* sv_2iv() is now a macro using Perl_sv_2iv_flags();
 145  * this function provided for binary compatibility only
 146  */
 147
 148 IV
 149 Perl_sv_2iv(pTHX_ SV *sv)
 150 {
 151     return sv_2iv_flags(sv, SV_GMAGIC);
 152 }
 153
 154 /* sv_2uv() is now a macro using Perl_sv_2uv_flags();
 155  * this function provided for binary compatibility only
 156  */
 157
 158 UV
 159 Perl_sv_2uv(pTHX_ SV *sv)
 160 {
 161     return sv_2uv_flags(sv, SV_GMAGIC);
 162 }
 163
 164 /* sv_2nv() is now a macro using Perl_sv_2nv_flags();
 165  * this function provided for binary compatibility only
 166  */
 167
 168 NV
 169 Perl_sv_2nv(pTHX_ SV *sv)
 170 {
 171     return sv_2nv_flags(sv, SV_GMAGIC);
 172 }
 173
 174
 175 /* sv_2pv() is now a macro using Perl_sv_2pv_flags();
 176  * this function provided for binary compatibility only
 177  */
 178
 179 char *
 180 Perl_sv_2pv(pTHX_ SV *sv, STRLEN *lp)
 181 {
 182     return sv_2pv_flags(sv, lp, SV_GMAGIC);
 183 }
 184
 185 /*
 186 =for apidoc sv_2pv_nolen
 187
 188 Like C<sv_2pv()>, but doesn't return the length too. You should usually
 189 use the macro wrapper C<SvPV_nolen(sv)> instead.
 190
 191 =cut
 192 */
 193
 194 char *
 195 Perl_sv_2pv_nolen(pTHX_ SV *sv)
 196 {
 197     PERL_ARGS_ASSERT_SV_2PV_NOLEN;
 198     return sv_2pv(sv, NULL);
 199 }
 200
 201 /*
 202 =for apidoc sv_2pvbyte_nolen
 203
 204 Return a pointer to the byte-encoded representation of the SV.
 205 May cause the SV to be downgraded from UTF-8 as a side-effect.
 206
 207 Usually accessed via the C<SvPVbyte_nolen> macro.
 208
 209 =cut
 210 */
 211
 212 char *
 213 Perl_sv_2pvbyte_nolen(pTHX_ SV *sv)
 214 {
 215     PERL_ARGS_ASSERT_SV_2PVBYTE_NOLEN;
 216
 217     return sv_2pvbyte(sv, NULL);
 218 }
 219
 220 /*
 221 =for apidoc sv_2pvutf8_nolen
 222
 223 Return a pointer to the UTF-8-encoded representation of the SV.
 224 May cause the SV to be upgraded to UTF-8 as a side-effect.
 225
 226 Usually accessed via the C<SvPVutf8_nolen> macro.
 227
 228 =cut
 229 */
 230
 231 char *
 232 Perl_sv_2pvutf8_nolen(pTHX_ SV *sv)
 233 {
 234     PERL_ARGS_ASSERT_SV_2PVUTF8_NOLEN;
 235
 236     return sv_2pvutf8(sv, NULL);
 237 }
 238
 239 /*
 240 =for apidoc sv_force_normal
 241
 242 Undo various types of fakery on an SV: if the PV is a shared string, make
 243 a private copy; if we're a ref, stop refing; if we're a glob, downgrade to
 244 an xpvmg. See also C<sv_force_normal_flags>.
 245
 246 =cut
 247 */
 248
 249 void
 250 Perl_sv_force_normal(pTHX_ SV *sv)
 251 {
 252     PERL_ARGS_ASSERT_SV_FORCE_NORMAL;
 253
 254     sv_force_normal_flags(sv, 0);
 255 }
 256
 257 /* sv_setsv() is now a macro using Perl_sv_setsv_flags();
 258  * this function provided for binary compatibility only
 259  */
 260
 261 void
 262 Perl_sv_setsv(pTHX_ SV *dstr, SV *sstr)
 263 {
 264     PERL_ARGS_ASSERT_SV_SETSV;
 265
 266     sv_setsv_flags(dstr, sstr, SV_GMAGIC);
 267 }
 268
 269 /* sv_catpvn() is now a macro using Perl_sv_catpvn_flags();
 270  * this function provided for binary compatibility only
 271  */
 272
 273 void
 274 Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen)
 275 {
 276     PERL_ARGS_ASSERT_SV_CATPVN;
 277
 278     sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC);
 279 }
 280
 281 /*
 282 =for apidoc sv_catpvn_mg
 283
 284 Like C<sv_catpvn>, but also handles 'set' magic.
 285
 286 =cut
 287 */
 288
 289 void
 290 Perl_sv_catpvn_mg(pTHX_ SV *sv, const char *ptr, STRLEN len)
 291 {
 292     PERL_ARGS_ASSERT_SV_CATPVN_MG;
 293
 294     sv_catpvn_flags(sv,ptr,len,SV_GMAGIC|SV_SMAGIC);
 295 }
 296
 297 /* sv_catsv() is now a macro using Perl_sv_catsv_flags();
 298  * this function provided for binary compatibility only
 299  */
 300
 301 void
 302 Perl_sv_catsv(pTHX_ SV *dstr, SV *sstr)
 303 {
 304     PERL_ARGS_ASSERT_SV_CATSV;
 305
 306     sv_catsv_flags(dstr, sstr, SV_GMAGIC);
 307 }
 308
 309 /*
 310 =for apidoc sv_catsv_mg
 311
 312 Like C<sv_catsv>, but also handles 'set' magic.
 313
 314 =cut
 315 */
 316
 317 void
 318 Perl_sv_catsv_mg(pTHX_ SV *dsv, SV *ssv)
 319 {
 320     PERL_ARGS_ASSERT_SV_CATSV_MG;
 321
 322     sv_catsv_flags(dsv,ssv,SV_GMAGIC|SV_SMAGIC);
 323 }
 324
 325 /*
 326 =for apidoc sv_iv
 327
 328 A private implementation of the C<SvIVx> macro for compilers which can't
 329 cope with complex macro expressions. Always use the macro instead.
 330
 331 =cut
 332 */
 333
 334 IV
 335 Perl_sv_iv(pTHX_ SV *sv)
 336 {
 337     PERL_ARGS_ASSERT_SV_IV;
 338
 339     if (SvIOK(sv)) {
 340         if (SvIsUV(sv))
 341             return (IV)SvUVX(sv);
 342         return SvIVX(sv);
 343     }
 344     return sv_2iv(sv);
 345 }
 346
 347 /*
 348 =for apidoc sv_uv
 349
 350 A private implementation of the C<SvUVx> macro for compilers which can't
 351 cope with complex macro expressions. Always use the macro instead.
 352
 353 =cut
 354 */
 355
 356 UV
 357 Perl_sv_uv(pTHX_ SV *sv)
 358 {
 359     PERL_ARGS_ASSERT_SV_UV;
 360
 361     if (SvIOK(sv)) {
 362         if (SvIsUV(sv))
 363             return SvUVX(sv);
 364         return (UV)SvIVX(sv);
 365     }
 366     return sv_2uv(sv);
 367 }
 368
 369 /*
 370 =for apidoc sv_nv
 371
 372 A private implementation of the C<SvNVx> macro for compilers which can't
 373 cope with complex macro expressions. Always use the macro instead.
 374
 375 =cut
 376 */
 377
 378 NV
 379 Perl_sv_nv(pTHX_ SV *sv)
 380 {
 381     PERL_ARGS_ASSERT_SV_NV;
 382
 383     if (SvNOK(sv))
 384         return SvNVX(sv);
 385     return sv_2nv(sv);
 386 }
 387
 388 /*
 389 =for apidoc sv_pv
 390
 391 Use the C<SvPV_nolen> macro instead
 392
 393 =for apidoc sv_pvn
 394
 395 A private implementation of the C<SvPV> macro for compilers which can't
 396 cope with complex macro expressions. Always use the macro instead.
 397
 398 =cut
 399 */
 400
 401 char *
 402 Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp)
 403 {
 404     PERL_ARGS_ASSERT_SV_PVN;
 405
 406     if (SvPOK(sv)) {
 407         *lp = SvCUR(sv);
 408         return SvPVX(sv);
 409     }
 410     return sv_2pv(sv, lp);
 411 }
 412
 413
 414 char *
 415 Perl_sv_pvn_nomg(pTHX_ SV *sv, STRLEN *lp)
 416 {
 417     PERL_ARGS_ASSERT_SV_PVN_NOMG;
 418
 419     if (SvPOK(sv)) {
 420         *lp = SvCUR(sv);
 421         return SvPVX(sv);
 422     }
 423     return sv_2pv_flags(sv, lp, 0);
 424 }
 425
 426 /* sv_pv() is now a macro using SvPV_nolen();
 427  * this function provided for binary compatibility only
 428  */
 429
 430 char *
 431 Perl_sv_pv(pTHX_ SV *sv)
 432 {
 433     PERL_ARGS_ASSERT_SV_PV;
 434
 435     if (SvPOK(sv))
 436         return SvPVX(sv);
 437
 438     return sv_2pv(sv, NULL);
 439 }
 440
 441 /* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags();
 442  * this function provided for binary compatibility only
 443  */
 444
 445 char *
 446 Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp)
 447 {
 448     PERL_ARGS_ASSERT_SV_PVN_FORCE;
 449
 450     return sv_pvn_force_flags(sv, lp, SV_GMAGIC);
 451 }
 452
 453 /* sv_pvbyte () is now a macro using Perl_sv_2pv_flags();
 454  * this function provided for binary compatibility only
 455  */
 456
 457 char *
 458 Perl_sv_pvbyte(pTHX_ SV *sv)
 459 {
 460     PERL_ARGS_ASSERT_SV_PVBYTE;
 461
 462     sv_utf8_downgrade(sv, FALSE);
 463     return sv_pv(sv);
 464 }
 465
 466 /*
 467 =for apidoc sv_pvbyte
 468
 469 Use C<SvPVbyte_nolen> instead.
 470
 471 =for apidoc sv_pvbyten
 472
 473 A private implementation of the C<SvPVbyte> macro for compilers
 474 which can't cope with complex macro expressions. Always use the macro
 475 instead.
 476
 477 =cut
 478 */
 479
 480 char *
 481 Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp)
 482 {
 483     PERL_ARGS_ASSERT_SV_PVBYTEN;
 484
 485     sv_utf8_downgrade(sv, FALSE);
 486     return sv_pvn(sv,lp);
 487 }
 488
 489 /* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags();
 490  * this function provided for binary compatibility only
 491  */
 492
 493 char *
 494 Perl_sv_pvutf8(pTHX_ SV *sv)
 495 {
 496     PERL_ARGS_ASSERT_SV_PVUTF8;
 497
 498     sv_utf8_upgrade(sv);
 499     return sv_pv(sv);
 500 }
 501
 502 /*
 503 =for apidoc sv_pvutf8
 504
 505 Use the C<SvPVutf8_nolen> macro instead
 506
 507 =for apidoc sv_pvutf8n
 508
 509 A private implementation of the C<SvPVutf8> macro for compilers
 510 which can't cope with complex macro expressions. Always use the macro
 511 instead.
 512
 513 =cut
 514 */
 515
 516 char *
 517 Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp)
 518 {
 519     PERL_ARGS_ASSERT_SV_PVUTF8N;
 520
 521     sv_utf8_upgrade(sv);
 522     return sv_pvn(sv,lp);
 523 }
 524
 525 /* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags();
 526  * this function provided for binary compatibility only
 527  */
 528
 529 STRLEN
 530 Perl_sv_utf8_upgrade(pTHX_ SV *sv)
 531 {
 532     PERL_ARGS_ASSERT_SV_UTF8_UPGRADE;
 533
 534     return sv_utf8_upgrade_flags(sv, SV_GMAGIC);
 535 }
 536
 537 int
 538 Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...)
 539 {
 540     dTHXs;
 541     va_list(arglist);
 542
 543     /* Easier to special case this here than in embed.pl. (Look at what it
 544        generates for proto.h) */
 545 #ifdef PERL_IMPLICIT_CONTEXT
 546     PERL_ARGS_ASSERT_FPRINTF_NOCONTEXT;
 547 #endif
 548
 549     va_start(arglist, format);
 550     return PerlIO_vprintf(stream, format, arglist);
 551 }
 552
 553 int
 554 Perl_printf_nocontext(const char *format, ...)
 555 {
 556     dTHX;
 557     va_list(arglist);
 558
 559 #ifdef PERL_IMPLICIT_CONTEXT
 560     PERL_ARGS_ASSERT_PRINTF_NOCONTEXT;
 561 #endif
 562
 563     va_start(arglist, format);
 564     return PerlIO_vprintf(PerlIO_stdout(), format, arglist);
 565 }
 566
 567 #if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL))
 568 /*
 569  * This hack is to force load of "huge" support from libm.a
 570  * So it is in perl for (say) POSIX to use.
 571  * Needed for SunOS with Sun's 'acc' for example.
 572  */
 573 NV
 574 Perl_huge(void)
 575 {
 576 #  if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)
 577     return HUGE_VALL;
 578 #  else
 579     return HUGE_VAL;
 580 #  endif
 581 }
 582 #endif
 583
 584 /* compatibility with versions <= 5.003. */
 585 void
 586 Perl_gv_fullname(pTHX_ SV *sv, const GV *gv)
 587 {
 588     PERL_ARGS_ASSERT_GV_FULLNAME;
 589
 590     gv_fullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
 591 }
 592
 593 /* compatibility with versions <= 5.003. */
 594 void
 595 Perl_gv_efullname(pTHX_ SV *sv, const GV *gv)
 596 {
 597     PERL_ARGS_ASSERT_GV_EFULLNAME;
 598
 599     gv_efullname3(sv, gv, sv == (const SV*)gv ? "*" : "");
 600 }
 601
 602 void
 603 Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
 604 {
 605     PERL_ARGS_ASSERT_GV_FULLNAME3;
 606
 607     gv_fullname4(sv, gv, prefix, TRUE);
 608 }
 609
 610 void
 611 Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix)
 612 {
 613     PERL_ARGS_ASSERT_GV_EFULLNAME3;
 614
 615     gv_efullname4(sv, gv, prefix, TRUE);
 616 }
 617
 618 /*
 619 =for apidoc gv_fetchmethod
 620
 621 See L</gv_fetchmethod_autoload>.
 622
 623 =cut
 624 */
 625
 626 GV *
 627 Perl_gv_fetchmethod(pTHX_ HV *stash, const char *name)
 628 {
 629     PERL_ARGS_ASSERT_GV_FETCHMETHOD;
 630
 631     return gv_fetchmethod_autoload(stash, name, TRUE);
 632 }
 633
 634 HE *
 635 Perl_hv_iternext(pTHX_ HV *hv)
 636 {
 637     PERL_ARGS_ASSERT_HV_ITERNEXT;
 638
 639     return hv_iternext_flags(hv, 0);
 640 }
 641
 642 void
 643 Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
 644 {
 645     PERL_ARGS_ASSERT_HV_MAGIC;
 646
 647     sv_magic(MUTABLE_SV(hv), MUTABLE_SV(gv), how, NULL, 0);
 648 }
 649
 650 bool
 651 Perl_do_open(pTHX_ GV *gv, const char *name, I32 len, int as_raw,
 652              int rawmode, int rawperm, PerlIO *supplied_fp)
 653 {
 654     PERL_ARGS_ASSERT_DO_OPEN;
 655
 656     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
 657                     supplied_fp, (SV **) NULL, 0);
 658 }
 659
 660 bool
 661 Perl_do_open9(pTHX_ GV *gv, const char *name, I32 len, int
 662 as_raw,
 663               int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs,
 664               I32 num_svs)
 665 {
 666     PERL_ARGS_ASSERT_DO_OPEN9;
 667
 668     PERL_UNUSED_ARG(num_svs);
 669     return do_openn(gv, name, len, as_raw, rawmode, rawperm,
 670                     supplied_fp, &svs, 1);
 671 }
 672
 673 int
 674 Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode)
 675 {
 676  /* The old body of this is now in non-LAYER part of perlio.c
 677   * This is a stub for any XS code which might have been calling it.
 678   */
 679  const char *name = ":raw";
 680
 681  PERL_ARGS_ASSERT_DO_BINMODE;
 682
 683 #ifdef PERLIO_USING_CRLF
 684  if (!(mode & O_BINARY))
 685      name = ":crlf";
 686 #endif
 687  return PerlIO_binmode(aTHX_ fp, iotype, mode, name);
 688 }
 689
 690 #ifndef OS2
 691 bool
 692 Perl_do_aexec(pTHX_ SV *really, SV **mark, SV **sp)
 693 {
 694     PERL_ARGS_ASSERT_DO_AEXEC;
 695
 696     return do_aexec5(really, mark, sp, 0, 0);
 697 }
 698 #endif
 699
 700 /* Backwards compatibility. */
 701 int
 702 Perl_init_i18nl14n(pTHX_ int printwarn)
 703 {
 704     return init_i18nl10n(printwarn);
 705 }
 706
 707 bool
 708 Perl_is_utf8_string_loc(pTHX_ const U8 *s, STRLEN len, const U8 **ep)
 709 {
 710     PERL_ARGS_ASSERT_IS_UTF8_STRING_LOC;
 711
 712     return is_utf8_string_loclen(s, len, ep, 0);
 713 }
 714
 715 /*
 716 =for apidoc sv_nolocking
 717
 718 Dummy routine which "locks" an SV when there is no locking module present.
 719 Exists to avoid test for a NULL function pointer and because it could
 720 potentially warn under some level of strict-ness.
 721
 722 "Superseded" by sv_nosharing().
 723
 724 =cut
 725 */
 726
 727 void
 728 Perl_sv_nolocking(pTHX_ SV *sv)
 729 {
 730     PERL_UNUSED_CONTEXT;
 731     PERL_UNUSED_ARG(sv);
 732 }
 733
 734
 735 /*
 736 =for apidoc sv_nounlocking
 737
 738 Dummy routine which "unlocks" an SV when there is no locking module present.
 739 Exists to avoid test for a NULL function pointer and because it could
 740 potentially warn under some level of strict-ness.
 741
 742 "Superseded" by sv_nosharing().
 743
 744 =cut
 745 */
 746
 747 void
 748 Perl_sv_nounlocking(pTHX_ SV *sv)
 749 {
 750     PERL_UNUSED_CONTEXT;
 751     PERL_UNUSED_ARG(sv);
 752 }
 753
 754 void
 755 Perl_save_long(pTHX_ long int *longp)
 756 {
 757     dVAR;
 758
 759     PERL_ARGS_ASSERT_SAVE_LONG;
 760
 761     SSCHECK(3);
 762     SSPUSHLONG(*longp);
 763     SSPUSHPTR(longp);
 764     SSPUSHUV(SAVEt_LONG);
 765 }
 766
 767 void
 768 Perl_save_iv(pTHX_ IV *ivp)
 769 {
 770     dVAR;
 771
 772     PERL_ARGS_ASSERT_SAVE_IV;
 773
 774     SSCHECK(3);
 775     SSPUSHIV(*ivp);
 776     SSPUSHPTR(ivp);
 777     SSPUSHUV(SAVEt_IV);
 778 }
 779
 780 void
 781 Perl_save_nogv(pTHX_ GV *gv)
 782 {
 783     dVAR;
 784
 785     PERL_ARGS_ASSERT_SAVE_NOGV;
 786
 787     SSCHECK(2);
 788     SSPUSHPTR(gv);
 789     SSPUSHUV(SAVEt_NSTAB);
 790 }
 791
 792 void
 793 Perl_save_list(pTHX_ SV **sarg, I32 maxsarg)
 794 {
 795     dVAR;
 796     I32 i;
 797
 798     PERL_ARGS_ASSERT_SAVE_LIST;
 799
 800     for (i = 1; i <= maxsarg; i++) {
 801         SV *sv;
 802         SvGETMAGIC(sarg[i]);
 803         sv = newSV(0);
 804         sv_setsv_nomg(sv,sarg[i]);
 805         SSCHECK(3);
 806         SSPUSHPTR(sarg[i]);             /* remember the pointer */
 807         SSPUSHPTR(sv);                  /* remember the value */
 808         SSPUSHUV(SAVEt_ITEM);
 809     }
 810 }
 811
 812 /*
 813 =for apidoc sv_usepvn_mg
 814
 815 Like C<sv_usepvn>, but also handles 'set' magic.
 816
 817 =cut
 818 */
 819
 820 void
 821 Perl_sv_usepvn_mg(pTHX_ SV *sv, char *ptr, STRLEN len)
 822 {
 823     PERL_ARGS_ASSERT_SV_USEPVN_MG;
 824
 825     sv_usepvn_flags(sv,ptr,len, SV_SMAGIC);
 826 }
 827
 828 /*
 829 =for apidoc sv_usepvn
 830
 831 Tells an SV to use C<ptr> to find its string value. Implemented by
 832 calling C<sv_usepvn_flags> with C<flags> of 0, hence does not handle 'set'
 833 magic. See C<sv_usepvn_flags>.
 834
 835 =cut
 836 */
 837
 838 void
 839 Perl_sv_usepvn(pTHX_ SV *sv, char *ptr, STRLEN len)
 840 {
 841     PERL_ARGS_ASSERT_SV_USEPVN;
 842
 843     sv_usepvn_flags(sv,ptr,len, 0);
 844 }
 845
 846 /*
 847 =for apidoc unpack_str
 848
 849 The engine implementing unpack() Perl function. Note: parameters strbeg, new_s
 850 and ocnt are not used. This call should not be used, use unpackstring instead.
 851
 852 =cut */
 853
 854 I32
 855 Perl_unpack_str(pTHX_ const char *pat, const char *patend, const char *s,
 856                 const char *strbeg, const char *strend, char **new_s, I32 ocnt,
 857                 U32 flags)
 858 {
 859     PERL_ARGS_ASSERT_UNPACK_STR;
 860
 861     PERL_UNUSED_ARG(strbeg);
 862     PERL_UNUSED_ARG(new_s);
 863     PERL_UNUSED_ARG(ocnt);
 864
 865     return unpackstring(pat, patend, s, strend, flags);
 866 }
 867
 868 /*
 869 =for apidoc pack_cat
 870
 871 The engine implementing pack() Perl function. Note: parameters next_in_list and
 872 flags are not used. This call should not be used; use packlist instead.
 873
 874 =cut
 875 */
 876
 877 void
 878 Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
 879 {
 880     PERL_ARGS_ASSERT_PACK_CAT;
 881
 882     PERL_UNUSED_ARG(next_in_list);
 883     PERL_UNUSED_ARG(flags);
 884
 885     packlist(cat, pat, patend, beglist, endlist);
 886 }
 887
 888 HE *
 889 Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
 890 {
 891   return (HE *)hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISSTORE, val, hash);
 892 }
 893
 894 bool
 895 Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
 896 {
 897     PERL_ARGS_ASSERT_HV_EXISTS_ENT;
 898
 899     return hv_common(hv, keysv, NULL, 0, 0, HV_FETCH_ISEXISTS, 0, hash)
 900         ? TRUE : FALSE;
 901 }
 902
 903 HE *
 904 Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, U32 hash)
 905 {
 906     PERL_ARGS_ASSERT_HV_FETCH_ENT;
 907
 908     return (HE *)hv_common(hv, keysv, NULL, 0, 0,
 909                      (lval ? HV_FETCH_LVALUE : 0), NULL, hash);
 910 }
 911
 912 SV *
 913 Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
 914 {
 915     PERL_ARGS_ASSERT_HV_DELETE_ENT;
 916
 917     return MUTABLE_SV(hv_common(hv, keysv, NULL, 0, 0, flags | HV_DELETE, NULL,
 918                                 hash));
 919 }
 920
 921 SV**
 922 Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val, U32 hash,
 923                     int flags)
 924 {
 925     return (SV**) hv_common(hv, NULL, key, klen, flags,
 926                             (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
 927 }
 928
 929 SV**
 930 Perl_hv_store(pTHX_ HV *hv, const char *key, I32 klen_i32, SV *val, U32 hash)
 931 {
 932     STRLEN klen;
 933     int flags;
 934
 935     if (klen_i32 < 0) {
 936         klen = -klen_i32;
 937         flags = HVhek_UTF8;
 938     } else {
 939         klen = klen_i32;
 940         flags = 0;
 941     }
 942     return (SV **) hv_common(hv, NULL, key, klen, flags,
 943                              (HV_FETCH_ISSTORE|HV_FETCH_JUST_SV), val, hash);
 944 }
 945
 946 bool
 947 Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen_i32)
 948 {
 949     STRLEN klen;
 950     int flags;
 951
 952     PERL_ARGS_ASSERT_HV_EXISTS;
 953
 954     if (klen_i32 < 0) {
 955         klen = -klen_i32;
 956         flags = HVhek_UTF8;
 957     } else {
 958         klen = klen_i32;
 959         flags = 0;
 960     }
 961     return hv_common(hv, NULL, key, klen, flags, HV_FETCH_ISEXISTS, 0, 0)
 962         ? TRUE : FALSE;
 963 }
 964
 965 SV**
 966 Perl_hv_fetch(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 lval)
 967 {
 968     STRLEN klen;
 969     int flags;
 970
 971     PERL_ARGS_ASSERT_HV_FETCH;
 972
 973     if (klen_i32 < 0) {
 974         klen = -klen_i32;
 975         flags = HVhek_UTF8;
 976     } else {
 977         klen = klen_i32;
 978         flags = 0;
 979     }
 980     return (SV **) hv_common(hv, NULL, key, klen, flags,
 981                              lval ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE)
 982                              : HV_FETCH_JUST_SV, NULL, 0);
 983 }
 984
 985 SV *
 986 Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen_i32, I32 flags)
 987 {
 988     STRLEN klen;
 989     int k_flags;
 990
 991     PERL_ARGS_ASSERT_HV_DELETE;
 992
 993     if (klen_i32 < 0) {
 994         klen = -klen_i32;
 995         k_flags = HVhek_UTF8;
 996     } else {
 997         klen = klen_i32;
 998         k_flags = 0;
 999     }
1000     return MUTABLE_SV(hv_common(hv, NULL, key, klen, k_flags, flags | HV_DELETE,
1001                                 NULL, 0));
1002 }
1003
1004 /* Functions after here were made mathoms post 5.10.0 but pre 5.8.9 */
1005
1006 AV *
1007 Perl_newAV(pTHX)
1008 {
1009     return MUTABLE_AV(newSV_type(SVt_PVAV));
1010     /* sv_upgrade does AvREAL_only():
1011     AvALLOC(av) = 0;
1012     AvARRAY(av) = NULL;
1013     AvMAX(av) = AvFILLp(av) = -1; */
1014 }
1015
1016 HV *
1017 Perl_newHV(pTHX)
1018 {
1019     HV * const hv = MUTABLE_HV(newSV_type(SVt_PVHV));
1020     assert(!SvOK(hv));
1021
1022     return hv;
1023 }
1024
1025 void
1026 Perl_sv_insert(pTHX_ SV *const bigstr, const STRLEN offset, const STRLEN len,
1027               const char *const little, const STRLEN littlelen)
1028 {
1029     PERL_ARGS_ASSERT_SV_INSERT;
1030     sv_insert_flags(bigstr, offset, len, little, littlelen, SV_GMAGIC);
1031 }
1032
1033 void
1034 Perl_save_freesv(pTHX_ SV *sv)
1035 {
1036     dVAR;
1037     save_freesv(sv);
1038 }
1039
1040 void
1041 Perl_save_mortalizesv(pTHX_ SV *sv)
1042 {
1043     dVAR;
1044
1045     PERL_ARGS_ASSERT_SAVE_MORTALIZESV;
1046
1047     save_mortalizesv(sv);
1048 }
1049
1050 void
1051 Perl_save_freeop(pTHX_ OP *o)
1052 {
1053     dVAR;
1054     save_freeop(o);
1055 }
1056
1057 void
1058 Perl_save_freepv(pTHX_ char *pv)
1059 {
1060     dVAR;
1061     save_freepv(pv);
1062 }
1063
1064 void
1065 Perl_save_op(pTHX)
1066 {
1067     dVAR;
1068     save_op();
1069 }
1070
1071 #ifdef PERL_DONT_CREATE_GVSV
1072 GV *
1073 Perl_gv_SVadd(pTHX_ GV *gv)
1074 {
1075     return gv_SVadd(gv);
1076 }
1077 #endif
1078
1079 GV *
1080 Perl_gv_AVadd(pTHX_ GV *gv)
1081 {
1082     return gv_AVadd(gv);
1083 }
1084
1085 GV *
1086 Perl_gv_HVadd(pTHX_ GV *gv)
1087 {
1088     return gv_HVadd(gv);
1089 }
1090
1091 GV *
1092 Perl_gv_IOadd(pTHX_ GV *gv)
1093 {
1094     return gv_IOadd(gv);
1095 }
1096
1097 IO *
1098 Perl_newIO(pTHX)
1099 {
1100     return MUTABLE_IO(newSV_type(SVt_PVIO));
1101 }
1102
1103 I32
1104 Perl_my_stat(pTHX)
1105 {
1106     return my_stat_flags(SV_GMAGIC);
1107 }
1108
1109 I32
1110 Perl_my_lstat(pTHX)
1111 {
1112     return my_lstat_flags(SV_GMAGIC);
1113 }
1114
1115 I32
1116 Perl_sv_eq(pTHX_ SV *sv1, SV *sv2)
1117 {
1118     return sv_eq_flags(sv1, sv2, SV_GMAGIC);
1119 }
1120
1121 #ifdef USE_LOCALE_COLLATE
1122 char *
1123 Perl_sv_collxfrm(pTHX_ SV *const sv, STRLEN *const nxp)
1124 {
1125     return sv_collxfrm_flags(sv, nxp, SV_GMAGIC);
1126 }
1127 #endif
1128
1129 bool
1130 Perl_sv_2bool(pTHX_ SV *const sv)
1131 {
1132     return sv_2bool_flags(sv, SV_GMAGIC);
1133 }
1134
1135
1136 /*
1137 =for apidoc custom_op_name
1138 Return the name for a given custom op. This was once used by the OP_NAME
1139 macro, but is no longer: it has only been kept for compatibility, and
1140 should not be used.
1141
1142 =for apidoc custom_op_desc
1143 Return the description of a given custom op. This was once used by the
1144 OP_DESC macro, but is no longer: it has only been kept for
1145 compatibility, and should not be used.
1146
1147 =cut
1148 */
1149
1150 const char*
1151 Perl_custom_op_name(pTHX_ const OP* o)
1152 {
1153     PERL_ARGS_ASSERT_CUSTOM_OP_NAME;
1154     return XopENTRYCUSTOM(o, xop_name);
1155 }
1156
1157 const char*
1158 Perl_custom_op_desc(pTHX_ const OP* o)
1159 {
1160     PERL_ARGS_ASSERT_CUSTOM_OP_DESC;
1161     return XopENTRYCUSTOM(o, xop_desc);
1162 }
1163
1164 CV *
1165 Perl_newSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *block)
1166 {
1167     return Perl_newATTRSUB(aTHX_ floor, o, proto, NULL, block);
1168 }
1169
1170 UV
1171 Perl_to_utf8_fold(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1172 {
1173     PERL_ARGS_ASSERT_TO_UTF8_FOLD;
1174
1175     return _to_utf8_fold_flags(p, ustrp, lenp, FOLD_FLAGS_FULL, NULL);
1176 }
1177
1178 UV
1179 Perl_to_utf8_lower(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1180 {
1181     PERL_ARGS_ASSERT_TO_UTF8_LOWER;
1182
1183     return _to_utf8_lower_flags(p, ustrp, lenp, FALSE, NULL);
1184 }
1185
1186 UV
1187 Perl_to_utf8_title(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1188 {
1189     PERL_ARGS_ASSERT_TO_UTF8_TITLE;
1190
1191     return _to_utf8_title_flags(p, ustrp, lenp, FALSE, NULL);
1192 }
1193
1194 UV
1195 Perl_to_utf8_upper(pTHX_ const U8 *p, U8* ustrp, STRLEN *lenp)
1196 {
1197     PERL_ARGS_ASSERT_TO_UTF8_UPPER;
1198
1199     return _to_utf8_upper_flags(p, ustrp, lenp, FALSE, NULL);
1200 }
1201
1202 SV *
1203 Perl_sv_mortalcopy(pTHX_ SV *const oldstr)
1204 {
1205     return Perl_sv_mortalcopy_flags(aTHX_ oldstr, SV_GMAGIC);
1206 }
1207
1208 UV      /* Made into a function, so can be deprecated */
1209 NATIVE_TO_NEED(const UV enc, const UV ch)
1210 {
1211     PERL_UNUSED_ARG(enc);
1212     return ch;
1213 }
1214
1215 UV      /* Made into a function, so can be deprecated */
1216 ASCII_TO_NEED(const UV enc, const UV ch)
1217 {
1218     PERL_UNUSED_ARG(enc);
1219     return ch;
1220 }
1221
1222 END_EXTERN_C
1223
1224 #endif /* NO_MATHOMS */
1225
1226 /*
1227  * Local variables:
1228  * c-indentation-style: bsd
1229  * c-basic-offset: 4
1230  * indent-tabs-mode: nil
1231  * End:
1232  *
1233  * ex: set ts=8 sts=4 sw=4 et:
1234  */