| 1 | /* mathoms.c |
| 2 | * |
| 3 | * Copyright (C) 2005, by Larry Wall and others |
| 4 | * |
| 5 | * You may distribute under the terms of either the GNU General Public |
| 6 | * License or the Artistic License, as specified in the README file. |
| 7 | * |
| 8 | */ |
| 9 | |
| 10 | /* |
| 11 | * "Anything that Hobbits had no immediate use for, but were unwilling to |
| 12 | * throw away, they called a mathom. Their dwellings were apt to become |
| 13 | * rather crowded with mathoms, and many of the presents that passed from |
| 14 | * hand to hand were of that sort." |
| 15 | */ |
| 16 | |
| 17 | /* |
| 18 | * This file contains mathoms, various binary artifacts from previous |
| 19 | * versions of Perl. For binary or source compatibility reasons, though, |
| 20 | * we cannot completely remove them from the core code. |
| 21 | * |
| 22 | * SMP - Oct. 24, 2005 |
| 23 | * |
| 24 | */ |
| 25 | |
| 26 | #include "EXTERN.h" |
| 27 | #define PERL_IN_MATHOMS_C |
| 28 | #include "perl.h" |
| 29 | |
| 30 | /* ref() is now a macro using Perl_doref; |
| 31 | * this version provided for binary compatibility only. |
| 32 | */ |
| 33 | OP * |
| 34 | Perl_ref(pTHX_ OP *o, I32 type) |
| 35 | { |
| 36 | return doref(o, type, TRUE); |
| 37 | } |
| 38 | |
| 39 | /* |
| 40 | =for apidoc sv_unref |
| 41 | |
| 42 | Unsets the RV status of the SV, and decrements the reference count of |
| 43 | whatever was being referenced by the RV. This can almost be thought of |
| 44 | as a reversal of C<newSVrv>. This is C<sv_unref_flags> with the C<flag> |
| 45 | being zero. See C<SvROK_off>. |
| 46 | |
| 47 | =cut |
| 48 | */ |
| 49 | |
| 50 | void |
| 51 | Perl_sv_unref(pTHX_ SV *sv) |
| 52 | { |
| 53 | sv_unref_flags(sv, 0); |
| 54 | } |
| 55 | |
| 56 | /* |
| 57 | =for apidoc sv_taint |
| 58 | |
| 59 | Taint an SV. Use C<SvTAINTED_on> instead. |
| 60 | =cut |
| 61 | */ |
| 62 | |
| 63 | void |
| 64 | Perl_sv_taint(pTHX_ SV *sv) |
| 65 | { |
| 66 | sv_magic((sv), Nullsv, PERL_MAGIC_taint, Nullch, 0); |
| 67 | } |
| 68 | |
| 69 | /* sv_2iv() is now a macro using Perl_sv_2iv_flags(); |
| 70 | * this function provided for binary compatibility only |
| 71 | */ |
| 72 | |
| 73 | IV |
| 74 | Perl_sv_2iv(pTHX_ register SV *sv) |
| 75 | { |
| 76 | return sv_2iv_flags(sv, SV_GMAGIC); |
| 77 | } |
| 78 | |
| 79 | /* sv_2uv() is now a macro using Perl_sv_2uv_flags(); |
| 80 | * this function provided for binary compatibility only |
| 81 | */ |
| 82 | |
| 83 | UV |
| 84 | Perl_sv_2uv(pTHX_ register SV *sv) |
| 85 | { |
| 86 | return sv_2uv_flags(sv, SV_GMAGIC); |
| 87 | } |
| 88 | |
| 89 | /* sv_2pv() is now a macro using Perl_sv_2pv_flags(); |
| 90 | * this function provided for binary compatibility only |
| 91 | */ |
| 92 | |
| 93 | char * |
| 94 | Perl_sv_2pv(pTHX_ register SV *sv, STRLEN *lp) |
| 95 | { |
| 96 | return sv_2pv_flags(sv, lp, SV_GMAGIC); |
| 97 | } |
| 98 | |
| 99 | /* |
| 100 | =for apidoc sv_2pv_nolen |
| 101 | |
| 102 | Like C<sv_2pv()>, but doesn't return the length too. You should usually |
| 103 | use the macro wrapper C<SvPV_nolen(sv)> instead. |
| 104 | =cut |
| 105 | */ |
| 106 | |
| 107 | char * |
| 108 | Perl_sv_2pv_nolen(pTHX_ register SV *sv) |
| 109 | { |
| 110 | return sv_2pv(sv, 0); |
| 111 | } |
| 112 | |
| 113 | /* |
| 114 | =for apidoc sv_2pvbyte_nolen |
| 115 | |
| 116 | Return a pointer to the byte-encoded representation of the SV. |
| 117 | May cause the SV to be downgraded from UTF-8 as a side-effect. |
| 118 | |
| 119 | Usually accessed via the C<SvPVbyte_nolen> macro. |
| 120 | |
| 121 | =cut |
| 122 | */ |
| 123 | |
| 124 | char * |
| 125 | Perl_sv_2pvbyte_nolen(pTHX_ register SV *sv) |
| 126 | { |
| 127 | return sv_2pvbyte(sv, 0); |
| 128 | } |
| 129 | |
| 130 | /* |
| 131 | =for apidoc sv_2pvutf8_nolen |
| 132 | |
| 133 | Return a pointer to the UTF-8-encoded representation of the SV. |
| 134 | May cause the SV to be upgraded to UTF-8 as a side-effect. |
| 135 | |
| 136 | Usually accessed via the C<SvPVutf8_nolen> macro. |
| 137 | |
| 138 | =cut |
| 139 | */ |
| 140 | |
| 141 | char * |
| 142 | Perl_sv_2pvutf8_nolen(pTHX_ register SV *sv) |
| 143 | { |
| 144 | return sv_2pvutf8(sv, 0); |
| 145 | } |
| 146 | |
| 147 | /* |
| 148 | =for apidoc sv_force_normal |
| 149 | |
| 150 | Undo various types of fakery on an SV: if the PV is a shared string, make |
| 151 | a private copy; if we're a ref, stop refing; if we're a glob, downgrade to |
| 152 | an xpvmg. See also C<sv_force_normal_flags>. |
| 153 | |
| 154 | =cut |
| 155 | */ |
| 156 | |
| 157 | void |
| 158 | Perl_sv_force_normal(pTHX_ register SV *sv) |
| 159 | { |
| 160 | sv_force_normal_flags(sv, 0); |
| 161 | } |
| 162 | |
| 163 | /* sv_setsv() is now a macro using Perl_sv_setsv_flags(); |
| 164 | * this function provided for binary compatibility only |
| 165 | */ |
| 166 | |
| 167 | void |
| 168 | Perl_sv_setsv(pTHX_ SV *dstr, register SV *sstr) |
| 169 | { |
| 170 | sv_setsv_flags(dstr, sstr, SV_GMAGIC); |
| 171 | } |
| 172 | |
| 173 | /* sv_catpvn() is now a macro using Perl_sv_catpvn_flags(); |
| 174 | * this function provided for binary compatibility only |
| 175 | */ |
| 176 | |
| 177 | void |
| 178 | Perl_sv_catpvn(pTHX_ SV *dsv, const char* sstr, STRLEN slen) |
| 179 | { |
| 180 | sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC); |
| 181 | } |
| 182 | |
| 183 | /* |
| 184 | =for apidoc sv_catpvn_mg |
| 185 | |
| 186 | Like C<sv_catpvn>, but also handles 'set' magic. |
| 187 | |
| 188 | =cut |
| 189 | */ |
| 190 | |
| 191 | void |
| 192 | Perl_sv_catpvn_mg(pTHX_ register SV *sv, register const char *ptr, register STRLEN len) |
| 193 | { |
| 194 | sv_catpvn_flags(sv,ptr,len,SV_GMAGIC|SV_SMAGIC); |
| 195 | } |
| 196 | |
| 197 | /* sv_catsv() is now a macro using Perl_sv_catsv_flags(); |
| 198 | * this function provided for binary compatibility only |
| 199 | */ |
| 200 | |
| 201 | void |
| 202 | Perl_sv_catsv(pTHX_ SV *dstr, register SV *sstr) |
| 203 | { |
| 204 | sv_catsv_flags(dstr, sstr, SV_GMAGIC); |
| 205 | } |
| 206 | |
| 207 | /* |
| 208 | =for apidoc sv_catsv_mg |
| 209 | |
| 210 | Like C<sv_catsv>, but also handles 'set' magic. |
| 211 | |
| 212 | =cut |
| 213 | */ |
| 214 | |
| 215 | void |
| 216 | Perl_sv_catsv_mg(pTHX_ SV *dsv, register SV *ssv) |
| 217 | { |
| 218 | sv_catsv_flags(dsv,ssv,SV_GMAGIC|SV_SMAGIC); |
| 219 | } |
| 220 | |
| 221 | /* |
| 222 | =for apidoc sv_iv |
| 223 | |
| 224 | A private implementation of the C<SvIVx> macro for compilers which can't |
| 225 | cope with complex macro expressions. Always use the macro instead. |
| 226 | |
| 227 | =cut |
| 228 | */ |
| 229 | |
| 230 | IV |
| 231 | Perl_sv_iv(pTHX_ register SV *sv) |
| 232 | { |
| 233 | if (SvIOK(sv)) { |
| 234 | if (SvIsUV(sv)) |
| 235 | return (IV)SvUVX(sv); |
| 236 | return SvIVX(sv); |
| 237 | } |
| 238 | return sv_2iv(sv); |
| 239 | } |
| 240 | |
| 241 | /* |
| 242 | =for apidoc sv_uv |
| 243 | |
| 244 | A private implementation of the C<SvUVx> macro for compilers which can't |
| 245 | cope with complex macro expressions. Always use the macro instead. |
| 246 | |
| 247 | =cut |
| 248 | */ |
| 249 | |
| 250 | UV |
| 251 | Perl_sv_uv(pTHX_ register SV *sv) |
| 252 | { |
| 253 | if (SvIOK(sv)) { |
| 254 | if (SvIsUV(sv)) |
| 255 | return SvUVX(sv); |
| 256 | return (UV)SvIVX(sv); |
| 257 | } |
| 258 | return sv_2uv(sv); |
| 259 | } |
| 260 | |
| 261 | /* |
| 262 | =for apidoc sv_nv |
| 263 | |
| 264 | A private implementation of the C<SvNVx> macro for compilers which can't |
| 265 | cope with complex macro expressions. Always use the macro instead. |
| 266 | |
| 267 | =cut |
| 268 | */ |
| 269 | |
| 270 | NV |
| 271 | Perl_sv_nv(pTHX_ register SV *sv) |
| 272 | { |
| 273 | if (SvNOK(sv)) |
| 274 | return SvNVX(sv); |
| 275 | return sv_2nv(sv); |
| 276 | } |
| 277 | |
| 278 | /* |
| 279 | =for apidoc sv_pv |
| 280 | |
| 281 | Use the C<SvPV_nolen> macro instead |
| 282 | |
| 283 | =for apidoc sv_pvn |
| 284 | |
| 285 | A private implementation of the C<SvPV> macro for compilers which can't |
| 286 | cope with complex macro expressions. Always use the macro instead. |
| 287 | |
| 288 | =cut |
| 289 | */ |
| 290 | |
| 291 | char * |
| 292 | Perl_sv_pvn(pTHX_ SV *sv, STRLEN *lp) |
| 293 | { |
| 294 | if (SvPOK(sv)) { |
| 295 | *lp = SvCUR(sv); |
| 296 | return SvPVX(sv); |
| 297 | } |
| 298 | return sv_2pv(sv, lp); |
| 299 | } |
| 300 | |
| 301 | |
| 302 | char * |
| 303 | Perl_sv_pvn_nomg(pTHX_ register SV *sv, STRLEN *lp) |
| 304 | { |
| 305 | if (SvPOK(sv)) { |
| 306 | *lp = SvCUR(sv); |
| 307 | return SvPVX(sv); |
| 308 | } |
| 309 | return sv_2pv_flags(sv, lp, 0); |
| 310 | } |
| 311 | |
| 312 | /* sv_pv() is now a macro using SvPV_nolen(); |
| 313 | * this function provided for binary compatibility only |
| 314 | */ |
| 315 | |
| 316 | char * |
| 317 | Perl_sv_pv(pTHX_ SV *sv) |
| 318 | { |
| 319 | if (SvPOK(sv)) |
| 320 | return SvPVX(sv); |
| 321 | |
| 322 | return sv_2pv(sv, 0); |
| 323 | } |
| 324 | |
| 325 | /* sv_pvn_force() is now a macro using Perl_sv_pvn_force_flags(); |
| 326 | * this function provided for binary compatibility only |
| 327 | */ |
| 328 | |
| 329 | char * |
| 330 | Perl_sv_pvn_force(pTHX_ SV *sv, STRLEN *lp) |
| 331 | { |
| 332 | return sv_pvn_force_flags(sv, lp, SV_GMAGIC); |
| 333 | } |
| 334 | |
| 335 | /* sv_pvbyte () is now a macro using Perl_sv_2pv_flags(); |
| 336 | * this function provided for binary compatibility only |
| 337 | */ |
| 338 | |
| 339 | char * |
| 340 | Perl_sv_pvbyte(pTHX_ SV *sv) |
| 341 | { |
| 342 | sv_utf8_downgrade(sv,0); |
| 343 | return sv_pv(sv); |
| 344 | } |
| 345 | |
| 346 | /* |
| 347 | =for apidoc sv_pvbyte |
| 348 | |
| 349 | Use C<SvPVbyte_nolen> instead. |
| 350 | |
| 351 | =for apidoc sv_pvbyten |
| 352 | |
| 353 | A private implementation of the C<SvPVbyte> macro for compilers |
| 354 | which can't cope with complex macro expressions. Always use the macro |
| 355 | instead. |
| 356 | |
| 357 | =cut |
| 358 | */ |
| 359 | |
| 360 | char * |
| 361 | Perl_sv_pvbyten(pTHX_ SV *sv, STRLEN *lp) |
| 362 | { |
| 363 | sv_utf8_downgrade(sv,0); |
| 364 | return sv_pvn(sv,lp); |
| 365 | } |
| 366 | |
| 367 | /* sv_pvutf8 () is now a macro using Perl_sv_2pv_flags(); |
| 368 | * this function provided for binary compatibility only |
| 369 | */ |
| 370 | |
| 371 | char * |
| 372 | Perl_sv_pvutf8(pTHX_ SV *sv) |
| 373 | { |
| 374 | sv_utf8_upgrade(sv); |
| 375 | return sv_pv(sv); |
| 376 | } |
| 377 | |
| 378 | /* |
| 379 | =for apidoc sv_pvutf8 |
| 380 | |
| 381 | Use the C<SvPVutf8_nolen> macro instead |
| 382 | |
| 383 | =for apidoc sv_pvutf8n |
| 384 | |
| 385 | A private implementation of the C<SvPVutf8> macro for compilers |
| 386 | which can't cope with complex macro expressions. Always use the macro |
| 387 | instead. |
| 388 | |
| 389 | =cut |
| 390 | */ |
| 391 | |
| 392 | char * |
| 393 | Perl_sv_pvutf8n(pTHX_ SV *sv, STRLEN *lp) |
| 394 | { |
| 395 | sv_utf8_upgrade(sv); |
| 396 | return sv_pvn(sv,lp); |
| 397 | } |
| 398 | |
| 399 | /* sv_utf8_upgrade() is now a macro using sv_utf8_upgrade_flags(); |
| 400 | * this function provided for binary compatibility only |
| 401 | */ |
| 402 | |
| 403 | STRLEN |
| 404 | Perl_sv_utf8_upgrade(pTHX_ register SV *sv) |
| 405 | { |
| 406 | return sv_utf8_upgrade_flags(sv, SV_GMAGIC); |
| 407 | } |
| 408 | |
| 409 | /* |
| 410 | =for apidoc A|U8 *|uvchr_to_utf8|U8 *d|UV uv |
| 411 | |
| 412 | Adds the UTF-8 representation of the Native codepoint C<uv> to the end |
| 413 | of the string C<d>; C<d> should be have at least C<UTF8_MAXBYTES+1> free |
| 414 | bytes available. The return value is the pointer to the byte after the |
| 415 | end of the new character. In other words, |
| 416 | |
| 417 | d = uvchr_to_utf8(d, uv); |
| 418 | |
| 419 | is the recommended wide native character-aware way of saying |
| 420 | |
| 421 | *(d++) = uv; |
| 422 | |
| 423 | =cut |
| 424 | */ |
| 425 | |
| 426 | /* On ASCII machines this is normally a macro but we want a |
| 427 | real function in case XS code wants it |
| 428 | */ |
| 429 | #undef Perl_uvchr_to_utf8 |
| 430 | U8 * |
| 431 | Perl_uvchr_to_utf8(pTHX_ U8 *d, UV uv) |
| 432 | { |
| 433 | return Perl_uvuni_to_utf8_flags(aTHX_ d, NATIVE_TO_UNI(uv), 0); |
| 434 | } |
| 435 | |
| 436 | |
| 437 | /* |
| 438 | =for apidoc A|UV|utf8n_to_uvchr|U8 *s|STRLEN curlen|STRLEN *retlen|U32 |
| 439 | flags |
| 440 | |
| 441 | Returns the native character value of the first character in the string |
| 442 | C<s> |
| 443 | which is assumed to be in UTF-8 encoding; C<retlen> will be set to the |
| 444 | length, in bytes, of that character. |
| 445 | |
| 446 | Allows length and flags to be passed to low level routine. |
| 447 | |
| 448 | =cut |
| 449 | */ |
| 450 | /* On ASCII machines this is normally a macro but we want |
| 451 | a real function in case XS code wants it |
| 452 | */ |
| 453 | #undef Perl_utf8n_to_uvchr |
| 454 | UV |
| 455 | Perl_utf8n_to_uvchr(pTHX_ const U8 *s, STRLEN curlen, STRLEN *retlen, |
| 456 | U32 flags) |
| 457 | { |
| 458 | const UV uv = Perl_utf8n_to_uvuni(aTHX_ s, curlen, retlen, flags); |
| 459 | return UNI_TO_NATIVE(uv); |
| 460 | } |
| 461 | int |
| 462 | Perl_fprintf_nocontext(PerlIO *stream, const char *format, ...) |
| 463 | { |
| 464 | dTHXs; |
| 465 | va_list(arglist); |
| 466 | va_start(arglist, format); |
| 467 | return PerlIO_vprintf(stream, format, arglist); |
| 468 | } |
| 469 | |
| 470 | int |
| 471 | Perl_printf_nocontext(const char *format, ...) |
| 472 | { |
| 473 | dTHX; |
| 474 | va_list(arglist); |
| 475 | va_start(arglist, format); |
| 476 | return PerlIO_vprintf(PerlIO_stdout(), format, arglist); |
| 477 | } |
| 478 | |
| 479 | #if defined(HUGE_VAL) || (defined(USE_LONG_DOUBLE) && defined(HUGE_VALL)) |
| 480 | /* |
| 481 | * This hack is to force load of "huge" support from libm.a |
| 482 | * So it is in perl for (say) POSIX to use. |
| 483 | * Needed for SunOS with Sun's 'acc' for example. |
| 484 | */ |
| 485 | NV |
| 486 | Perl_huge(void) |
| 487 | { |
| 488 | # if defined(USE_LONG_DOUBLE) && defined(HUGE_VALL) |
| 489 | return HUGE_VALL; |
| 490 | # endif |
| 491 | return HUGE_VAL; |
| 492 | } |
| 493 | #endif |
| 494 | |
| 495 | #ifndef USE_SFIO |
| 496 | int |
| 497 | perlsio_binmode(FILE *fp, int iotype, int mode) |
| 498 | { |
| 499 | /* |
| 500 | * This used to be contents of do_binmode in doio.c |
| 501 | */ |
| 502 | #ifdef DOSISH |
| 503 | # if defined(atarist) || defined(__MINT__) |
| 504 | if (!fflush(fp)) { |
| 505 | if (mode & O_BINARY) |
| 506 | ((FILE *) fp)->_flag |= _IOBIN; |
| 507 | else |
| 508 | ((FILE *) fp)->_flag &= ~_IOBIN; |
| 509 | return 1; |
| 510 | } |
| 511 | return 0; |
| 512 | # else |
| 513 | dTHX; |
| 514 | #ifdef NETWARE |
| 515 | if (PerlLIO_setmode(fp, mode) != -1) { |
| 516 | #else |
| 517 | if (PerlLIO_setmode(fileno(fp), mode) != -1) { |
| 518 | #endif |
| 519 | # if defined(WIN32) && defined(__BORLANDC__) |
| 520 | /* |
| 521 | * The translation mode of the stream is maintained independent |
| 522 | of |
| 523 | * the translation mode of the fd in the Borland RTL (heavy |
| 524 | * digging through their runtime sources reveal). User has to |
| 525 | set |
| 526 | * the mode explicitly for the stream (though they don't |
| 527 | document |
| 528 | * this anywhere). GSAR 97-5-24 |
| 529 | */ |
| 530 | fseek(fp, 0L, 0); |
| 531 | if (mode & O_BINARY) |
| 532 | fp->flags |= _F_BIN; |
| 533 | else |
| 534 | fp->flags &= ~_F_BIN; |
| 535 | # endif |
| 536 | return 1; |
| 537 | } |
| 538 | else |
| 539 | return 0; |
| 540 | # endif |
| 541 | #else |
| 542 | # if defined(USEMYBINMODE) |
| 543 | dTHX; |
| 544 | if (my_binmode(fp, iotype, mode) != FALSE) |
| 545 | return 1; |
| 546 | else |
| 547 | return 0; |
| 548 | # else |
| 549 | PERL_UNUSED_ARG(fp); |
| 550 | PERL_UNUSED_ARG(iotype); |
| 551 | PERL_UNUSED_ARG(mode); |
| 552 | return 1; |
| 553 | # endif |
| 554 | #endif |
| 555 | } |
| 556 | #endif /* sfio */ |
| 557 | |
| 558 | /* compatibility with versions <= 5.003. */ |
| 559 | void |
| 560 | Perl_gv_fullname(pTHX_ SV *sv, const GV *gv) |
| 561 | { |
| 562 | gv_fullname3(sv, gv, sv == (const SV*)gv ? "*" : ""); |
| 563 | } |
| 564 | |
| 565 | /* compatibility with versions <= 5.003. */ |
| 566 | void |
| 567 | Perl_gv_efullname(pTHX_ SV *sv, const GV *gv) |
| 568 | { |
| 569 | gv_efullname3(sv, gv, sv == (const SV*)gv ? "*" : ""); |
| 570 | } |
| 571 | |
| 572 | void |
| 573 | Perl_gv_fullname3(pTHX_ SV *sv, const GV *gv, const char *prefix) |
| 574 | { |
| 575 | gv_fullname4(sv, gv, prefix, TRUE); |
| 576 | } |
| 577 | |
| 578 | void |
| 579 | Perl_gv_efullname3(pTHX_ SV *sv, const GV *gv, const char *prefix) |
| 580 | { |
| 581 | gv_efullname4(sv, gv, prefix, TRUE); |
| 582 | } |
| 583 | |
| 584 | AV * |
| 585 | Perl_av_fake(pTHX_ register I32 size, register SV **strp) |
| 586 | { |
| 587 | register SV** ary; |
| 588 | register AV * const av = (AV*)NEWSV(9,0); |
| 589 | |
| 590 | sv_upgrade((SV *)av, SVt_PVAV); |
| 591 | Newx(ary,size+1,SV*); |
| 592 | AvALLOC(av) = ary; |
| 593 | Copy(strp,ary,size,SV*); |
| 594 | AvREIFY_only(av); |
| 595 | SvPV_set(av, (char*)ary); |
| 596 | AvFILLp(av) = size - 1; |
| 597 | AvMAX(av) = size - 1; |
| 598 | while (size--) { |
| 599 | assert (*strp); |
| 600 | SvTEMP_off(*strp); |
| 601 | strp++; |
| 602 | } |
| 603 | return av; |
| 604 | } |
| 605 | |
| 606 | bool |
| 607 | Perl_do_open(pTHX_ GV *gv, register const char *name, I32 len, int as_raw, |
| 608 | int rawmode, int rawperm, PerlIO *supplied_fp) |
| 609 | { |
| 610 | return do_openn(gv, name, len, as_raw, rawmode, rawperm, |
| 611 | supplied_fp, (SV **) NULL, 0); |
| 612 | } |
| 613 | |
| 614 | bool |
| 615 | Perl_do_open9(pTHX_ GV *gv, register const char *name, I32 len, int |
| 616 | as_raw, |
| 617 | int rawmode, int rawperm, PerlIO *supplied_fp, SV *svs, |
| 618 | I32 num_svs) |
| 619 | { |
| 620 | PERL_UNUSED_ARG(num_svs); |
| 621 | return do_openn(gv, name, len, as_raw, rawmode, rawperm, |
| 622 | supplied_fp, &svs, 1); |
| 623 | } |
| 624 | |
| 625 | int |
| 626 | Perl_do_binmode(pTHX_ PerlIO *fp, int iotype, int mode) |
| 627 | { |
| 628 | /* The old body of this is now in non-LAYER part of perlio.c |
| 629 | * This is a stub for any XS code which might have been calling it. |
| 630 | */ |
| 631 | const char *name = ":raw"; |
| 632 | #ifdef PERLIO_USING_CRLF |
| 633 | if (!(mode & O_BINARY)) |
| 634 | name = ":crlf"; |
| 635 | #endif |
| 636 | return PerlIO_binmode(aTHX_ fp, iotype, mode, name); |
| 637 | } |
| 638 | |
| 639 | #ifndef OS2 |
| 640 | bool |
| 641 | Perl_do_aexec(pTHX_ SV *really, register SV **mark, register SV **sp) |
| 642 | { |
| 643 | return do_aexec5(really, mark, sp, 0, 0); |
| 644 | } |
| 645 | #endif |
| 646 | |
| 647 | #ifdef PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION |
| 648 | bool |
| 649 | Perl_do_exec(pTHX_ const char *cmd) |
| 650 | { |
| 651 | return do_exec3(cmd,0,0); |
| 652 | } |
| 653 | #endif |
| 654 | |
| 655 | /* |
| 656 | * Local variables: |
| 657 | * c-indentation-style: bsd |
| 658 | * c-basic-offset: 4 |
| 659 | * indent-tabs-mode: t |
| 660 | * End: |
| 661 | * |
| 662 | * ex: set ts=8 sts=4 sw=4 noet: |
| 663 | */ |