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