1 /* 2 * $Id: encoding.xs,v 0.3 2002/04/21 22:14:41 dankogai Exp $ 3 */ 4 5 #define PERL_NO_GET_CONTEXT 6 #include "EXTERN.h" 7 #include "perl.h" 8 #include "XSUB.h" 9 #define U8 U8 10 11 #define OUR_DEFAULT_FB "Encode::PERLQQ" 12 13 #if defined(USE_PERLIO) && !defined(USE_SFIO) 14 15 /* Define an encoding "layer" in the perliol.h sense. 16 17 The layer defined here "inherits" in an object-oriented sense from 18 the "perlio" layer with its PerlIOBuf_* "methods". The 19 implementation is particularly efficient as until Encode settles 20 down there is no point in tryint to tune it. 21 22 The layer works by overloading the "fill" and "flush" methods. 23 24 "fill" calls "SUPER::fill" in perl terms, then calls the encode OO 25 perl API to convert the encoded data to UTF-8 form, then copies it 26 back to the buffer. The "base class's" read methods then see the 27 UTF-8 data. 28 29 "flush" transforms the UTF-8 data deposited by the "base class's 30 write method in the buffer back into the encoded form using the 31 encode OO perl API, then copies data back into the buffer and calls 32 "SUPER::flush. 33 34 Note that "flush" is _also_ called for read mode - we still do the 35 (back)-translate so that the base class's "flush" sees the 36 correct number of encoded chars for positioning the seek 37 pointer. (This double translation is the worst performance issue - 38 particularly with all-perl encode engine.) 39 40 */ 41 42 #include "perliol.h" 43 44 typedef struct { 45 PerlIOBuf base; /* PerlIOBuf stuff */ 46 SV *bufsv; /* buffer seen by layers above */ 47 SV *dataSV; /* data we have read from layer below */ 48 SV *enc; /* the encoding object */ 49 SV *chk; /* CHECK in Encode methods */ 50 int flags; /* Flags currently just needs lines */ 51 int inEncodeCall; /* trap recursive encode calls */ 52 } PerlIOEncode; 53 54 #define NEEDS_LINES 1 55 56 SV * 57 PerlIOEncode_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags) 58 { 59 PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode); 60 SV *sv = &PL_sv_undef; 61 if (e->enc) { 62 dSP; 63 /* Not 100% sure stack swap is right thing to do during dup ... */ 64 PUSHSTACKi(PERLSI_MAGIC); 65 SPAGAIN; 66 ENTER; 67 SAVETMPS; 68 PUSHMARK(sp); 69 XPUSHs(e->enc); 70 PUTBACK; 71 if (call_method("name", G_SCALAR) == 1) { 72 SPAGAIN; 73 sv = newSVsv(POPs); 74 PUTBACK; 75 } 76 FREETMPS; 77 LEAVE; 78 POPSTACK; 79 } 80 return sv; 81 } 82 83 IV 84 PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs *tab) 85 { 86 PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode); 87 dSP; 88 IV code = PerlIOBuf_pushed(aTHX_ f, mode, Nullsv,tab); 89 SV *result = Nullsv; 90 91 PUSHSTACKi(PERLSI_MAGIC); 92 SPAGAIN; 93 94 ENTER; 95 SAVETMPS; 96 97 PUSHMARK(sp); 98 XPUSHs(arg); 99 PUTBACK; 100 if (call_pv("Encode::find_encoding", G_SCALAR) != 1) { 101 /* should never happen */ 102 Perl_die(aTHX_ "Encode::find_encoding did not return a value"); 103 return -1; 104 } 105 SPAGAIN; 106 result = POPs; 107 PUTBACK; 108 109 if (!SvROK(result) || !SvOBJECT(SvRV(result))) { 110 e->enc = Nullsv; 111 Perl_warner(aTHX_ packWARN(WARN_IO), "Cannot find encoding \"%" SVf "\"", 112 arg); 113 errno = EINVAL; 114 code = -1; 115 } 116 else { 117 118 /* $enc->renew */ 119 PUSHMARK(sp); 120 XPUSHs(result); 121 PUTBACK; 122 if (call_method("renew",G_SCALAR|G_EVAL) != 1 || SvTRUE(ERRSV)) { 123 Perl_warner(aTHX_ packWARN(WARN_IO), "\"%" SVf "\" does not support renew method", 124 arg); 125 } 126 else { 127 SPAGAIN; 128 result = POPs; 129 PUTBACK; 130 } 131 e->enc = newSVsv(result); 132 PUSHMARK(sp); 133 XPUSHs(e->enc); 134 PUTBACK; 135 if (call_method("needs_lines",G_SCALAR|G_EVAL) != 1 || SvTRUE(ERRSV)) { 136 Perl_warner(aTHX_ packWARN(WARN_IO), "\"%" SVf "\" does not support needs_lines", 137 arg); 138 } 139 else { 140 SPAGAIN; 141 result = POPs; 142 PUTBACK; 143 if (SvTRUE(result)) { 144 e->flags |= NEEDS_LINES; 145 } 146 } 147 PerlIOBase(f)->flags |= PERLIO_F_UTF8; 148 } 149 150 e->chk = newSVsv(get_sv("PerlIO::encoding::fallback", 0)); 151 e->inEncodeCall = 0; 152 153 FREETMPS; 154 LEAVE; 155 POPSTACK; 156 return code; 157 } 158 159 IV 160 PerlIOEncode_popped(pTHX_ PerlIO * f) 161 { 162 PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode); 163 if (e->enc) { 164 SvREFCNT_dec(e->enc); 165 e->enc = Nullsv; 166 } 167 if (e->bufsv) { 168 SvREFCNT_dec(e->bufsv); 169 e->bufsv = Nullsv; 170 } 171 if (e->dataSV) { 172 SvREFCNT_dec(e->dataSV); 173 e->dataSV = Nullsv; 174 } 175 if (e->chk) { 176 SvREFCNT_dec(e->chk); 177 e->chk = Nullsv; 178 } 179 return 0; 180 } 181 182 STDCHAR * 183 PerlIOEncode_get_base(pTHX_ PerlIO * f) 184 { 185 PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode); 186 if (!e->base.bufsiz) 187 e->base.bufsiz = 1024; 188 if (!e->bufsv) { 189 e->bufsv = newSV(e->base.bufsiz); 190 sv_setpvn(e->bufsv, "", 0); 191 } 192 e->base.buf = (STDCHAR *) SvPVX(e->bufsv); 193 if (!e->base.ptr) 194 e->base.ptr = e->base.buf; 195 if (!e->base.end) 196 e->base.end = e->base.buf; 197 if (e->base.ptr < e->base.buf 198 || e->base.ptr > e->base.buf + SvLEN(e->bufsv)) { 199 Perl_warn(aTHX_ " ptr %p(%p)%p", e->base.buf, e->base.ptr, 200 e->base.buf + SvLEN(e->bufsv)); 201 abort(); 202 } 203 if (SvLEN(e->bufsv) < e->base.bufsiz) { 204 SSize_t poff = e->base.ptr - e->base.buf; 205 SSize_t eoff = e->base.end - e->base.buf; 206 e->base.buf = (STDCHAR *) SvGROW(e->bufsv, e->base.bufsiz); 207 e->base.ptr = e->base.buf + poff; 208 e->base.end = e->base.buf + eoff; 209 } 210 if (e->base.ptr < e->base.buf 211 || e->base.ptr > e->base.buf + SvLEN(e->bufsv)) { 212 Perl_warn(aTHX_ " ptr %p(%p)%p", e->base.buf, e->base.ptr, 213 e->base.buf + SvLEN(e->bufsv)); 214 abort(); 215 } 216 return e->base.buf; 217 } 218 219 IV 220 PerlIOEncode_fill(pTHX_ PerlIO * f) 221 { 222 PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode); 223 dSP; 224 IV code = 0; 225 PerlIO *n; 226 SSize_t avail; 227 228 if (PerlIO_flush(f) != 0) 229 return -1; 230 n = PerlIONext(f); 231 if (!PerlIO_fast_gets(n)) { 232 /* Things get too messy if we don't have a buffer layer 233 push a :perlio to do the job */ 234 char mode[8]; 235 n = PerlIO_push(aTHX_ n, &PerlIO_perlio, PerlIO_modestr(f,mode), Nullsv); 236 if (!n) { 237 Perl_die(aTHX_ "panic: cannot push :perlio for %p",f); 238 } 239 } 240 PUSHSTACKi(PERLSI_MAGIC); 241 SPAGAIN; 242 ENTER; 243 SAVETMPS; 244 retry: 245 avail = PerlIO_get_cnt(n); 246 if (avail <= 0) { 247 avail = PerlIO_fill(n); 248 if (avail == 0) { 249 avail = PerlIO_get_cnt(n); 250 } 251 else { 252 if (!PerlIO_error(n) && PerlIO_eof(n)) 253 avail = 0; 254 } 255 } 256 if (avail > 0 || (e->flags & NEEDS_LINES)) { 257 STDCHAR *ptr = PerlIO_get_ptr(n); 258 SSize_t use = (avail >= 0) ? avail : 0; 259 SV *uni; 260 char *s = NULL; 261 STRLEN len = 0; 262 e->base.ptr = e->base.end = (STDCHAR *) NULL; 263 (void) PerlIOEncode_get_base(aTHX_ f); 264 if (!e->dataSV) 265 e->dataSV = newSV(0); 266 if (SvTYPE(e->dataSV) < SVt_PV) { 267 sv_upgrade(e->dataSV,SVt_PV); 268 } 269 if (e->flags & NEEDS_LINES) { 270 /* Encoding needs whole lines (e.g. iso-2022-*) 271 search back from end of available data for 272 and line marker 273 */ 274 STDCHAR *nl = ptr+use-1; 275 while (nl >= ptr) { 276 if (*nl == '\n') { 277 break; 278 } 279 nl--; 280 } 281 if (nl >= ptr && *nl == '\n') { 282 /* found a line - take up to and including that */ 283 use = (nl+1)-ptr; 284 } 285 else if (avail > 0) { 286 /* No line, but not EOF - append avail to the pending data */ 287 sv_catpvn(e->dataSV, (char*)ptr, use); 288 PerlIO_set_ptrcnt(n, ptr+use, 0); 289 goto retry; 290 } 291 else if (!SvCUR(e->dataSV)) { 292 goto end_of_file; 293 } 294 } 295 if (SvCUR(e->dataSV)) { 296 /* something left over from last time - create a normal 297 SV with new data appended 298 */ 299 if (use + SvCUR(e->dataSV) > e->base.bufsiz) { 300 if (e->flags & NEEDS_LINES) { 301 /* Have to grow buffer */ 302 e->base.bufsiz = use + SvCUR(e->dataSV); 303 PerlIOEncode_get_base(aTHX_ f); 304 } 305 else { 306 use = e->base.bufsiz - SvCUR(e->dataSV); 307 } 308 } 309 sv_catpvn(e->dataSV,(char*)ptr,use); 310 } 311 else { 312 /* Create a "dummy" SV to represent the available data from layer below */ 313 if (SvLEN(e->dataSV) && SvPVX_const(e->dataSV)) { 314 Safefree(SvPVX_mutable(e->dataSV)); 315 } 316 if (use > (SSize_t)e->base.bufsiz) { 317 if (e->flags & NEEDS_LINES) { 318 /* Have to grow buffer */ 319 e->base.bufsiz = use; 320 PerlIOEncode_get_base(aTHX_ f); 321 } 322 else { 323 use = e->base.bufsiz; 324 } 325 } 326 SvPV_set(e->dataSV, (char *) ptr); 327 SvLEN_set(e->dataSV, 0); /* Hands off sv.c - it isn't yours */ 328 SvCUR_set(e->dataSV,use); 329 SvPOK_only(e->dataSV); 330 } 331 SvUTF8_off(e->dataSV); 332 PUSHMARK(sp); 333 XPUSHs(e->enc); 334 XPUSHs(e->dataSV); 335 XPUSHs(e->chk); 336 PUTBACK; 337 if (call_method("decode", G_SCALAR) != 1) { 338 Perl_die(aTHX_ "panic: decode did not return a value"); 339 } 340 SPAGAIN; 341 uni = POPs; 342 PUTBACK; 343 /* Now get translated string (forced to UTF-8) and use as buffer */ 344 if (SvPOK(uni)) { 345 s = SvPVutf8(uni, len); 346 #ifdef PARANOID_ENCODE_CHECKS 347 if (len && !is_utf8_string((U8*)s,len)) { 348 Perl_warn(aTHX_ "panic: decode did not return UTF-8 '%.*s'",(int) len,s); 349 } 350 #endif 351 } 352 if (len > 0) { 353 /* Got _something */ 354 /* if decode gave us back dataSV then data may vanish when 355 we do ptrcnt adjust - so take our copy now. 356 (The copy is a pain - need a put-it-here option for decode.) 357 */ 358 sv_setpvn(e->bufsv,s,len); 359 e->base.ptr = e->base.buf = (STDCHAR*)SvPVX(e->bufsv); 360 e->base.end = e->base.ptr + SvCUR(e->bufsv); 361 PerlIOBase(f)->flags |= PERLIO_F_RDBUF; 362 SvUTF8_on(e->bufsv); 363 364 /* Adjust ptr/cnt not taking anything which 365 did not translate - not clear this is a win */ 366 /* compute amount we took */ 367 use -= SvCUR(e->dataSV); 368 PerlIO_set_ptrcnt(n, ptr+use, (avail-use)); 369 /* and as we did not take it it isn't pending */ 370 SvCUR_set(e->dataSV,0); 371 } else { 372 /* Got nothing - assume partial character so we need some more */ 373 /* Make sure e->dataSV is a normal SV before re-filling as 374 buffer alias will change under us 375 */ 376 s = SvPV(e->dataSV,len); 377 sv_setpvn(e->dataSV,s,len); 378 PerlIO_set_ptrcnt(n, ptr+use, (avail-use)); 379 goto retry; 380 } 381 } 382 else { 383 end_of_file: 384 code = -1; 385 if (avail == 0) 386 PerlIOBase(f)->flags |= PERLIO_F_EOF; 387 else 388 PerlIOBase(f)->flags |= PERLIO_F_ERROR; 389 } 390 FREETMPS; 391 LEAVE; 392 POPSTACK; 393 return code; 394 } 395 396 IV 397 PerlIOEncode_flush(pTHX_ PerlIO * f) 398 { 399 PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode); 400 IV code = 0; 401 402 if (e->bufsv) { 403 dSP; 404 SV *str; 405 char *s; 406 STRLEN len; 407 SSize_t count = 0; 408 if ((PerlIOBase(f)->flags & PERLIO_F_WRBUF) && (e->base.ptr > e->base.buf)) { 409 if (e->inEncodeCall) return 0; 410 /* Write case - encode the buffer and write() to layer below */ 411 PUSHSTACKi(PERLSI_MAGIC); 412 SPAGAIN; 413 ENTER; 414 SAVETMPS; 415 PUSHMARK(sp); 416 XPUSHs(e->enc); 417 SvCUR_set(e->bufsv, e->base.ptr - e->base.buf); 418 SvUTF8_on(e->bufsv); 419 XPUSHs(e->bufsv); 420 XPUSHs(e->chk); 421 PUTBACK; 422 e->inEncodeCall = 1; 423 if (call_method("encode", G_SCALAR) != 1) { 424 e->inEncodeCall = 0; 425 Perl_die(aTHX_ "panic: encode did not return a value"); 426 } 427 e->inEncodeCall = 0; 428 SPAGAIN; 429 str = POPs; 430 PUTBACK; 431 s = SvPV(str, len); 432 count = PerlIO_write(PerlIONext(f),s,len); 433 if ((STRLEN)count != len) { 434 code = -1; 435 } 436 FREETMPS; 437 LEAVE; 438 POPSTACK; 439 if (PerlIO_flush(PerlIONext(f)) != 0) { 440 code = -1; 441 } 442 if (SvCUR(e->bufsv)) { 443 /* Did not all translate */ 444 e->base.ptr = e->base.buf+SvCUR(e->bufsv); 445 return code; 446 } 447 } 448 else if ((PerlIOBase(f)->flags & PERLIO_F_RDBUF)) { 449 /* read case */ 450 /* if we have any untranslated stuff then unread that first */ 451 /* FIXME - unread is fragile is there a better way ? */ 452 if (e->dataSV && SvCUR(e->dataSV)) { 453 s = SvPV(e->dataSV, len); 454 count = PerlIO_unread(PerlIONext(f),s,len); 455 if ((STRLEN)count != len) { 456 code = -1; 457 } 458 SvCUR_set(e->dataSV,0); 459 } 460 /* See if there is anything left in the buffer */ 461 if (e->base.ptr < e->base.end) { 462 if (e->inEncodeCall) return 0; 463 /* Bother - have unread data. 464 re-encode and unread() to layer below 465 */ 466 PUSHSTACKi(PERLSI_MAGIC); 467 SPAGAIN; 468 ENTER; 469 SAVETMPS; 470 str = sv_newmortal(); 471 sv_upgrade(str, SVt_PV); 472 SvPV_set(str, (char*)e->base.ptr); 473 SvLEN_set(str, 0); 474 SvCUR_set(str, e->base.end - e->base.ptr); 475 SvPOK_only(str); 476 SvUTF8_on(str); 477 PUSHMARK(sp); 478 XPUSHs(e->enc); 479 XPUSHs(str); 480 XPUSHs(e->chk); 481 PUTBACK; 482 e->inEncodeCall = 1; 483 if (call_method("encode", G_SCALAR) != 1) { 484 e->inEncodeCall = 0; 485 Perl_die(aTHX_ "panic: encode did not return a value"); 486 } 487 e->inEncodeCall = 0; 488 SPAGAIN; 489 str = POPs; 490 PUTBACK; 491 s = SvPV(str, len); 492 count = PerlIO_unread(PerlIONext(f),s,len); 493 if ((STRLEN)count != len) { 494 code = -1; 495 } 496 FREETMPS; 497 LEAVE; 498 POPSTACK; 499 } 500 } 501 e->base.ptr = e->base.end = e->base.buf; 502 PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF); 503 } 504 return code; 505 } 506 507 IV 508 PerlIOEncode_close(pTHX_ PerlIO * f) 509 { 510 PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode); 511 IV code; 512 if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) { 513 /* Discard partial character */ 514 if (e->dataSV) { 515 SvCUR_set(e->dataSV,0); 516 } 517 /* Don't back decode and unread any pending data */ 518 e->base.ptr = e->base.end = e->base.buf; 519 } 520 code = PerlIOBase_close(aTHX_ f); 521 if (e->bufsv) { 522 /* This should only fire for write case */ 523 if (e->base.buf && e->base.ptr > e->base.buf) { 524 Perl_croak(aTHX_ "Close with partial character"); 525 } 526 SvREFCNT_dec(e->bufsv); 527 e->bufsv = Nullsv; 528 } 529 e->base.buf = NULL; 530 e->base.ptr = NULL; 531 e->base.end = NULL; 532 PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF); 533 return code; 534 } 535 536 Off_t 537 PerlIOEncode_tell(pTHX_ PerlIO * f) 538 { 539 PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf); 540 /* Unfortunately the only way to get a postion is to (re-)translate, 541 the UTF8 we have in bufefr and then ask layer below 542 */ 543 PerlIO_flush(f); 544 if (b->buf && b->ptr > b->buf) { 545 Perl_croak(aTHX_ "Cannot tell at partial character"); 546 } 547 return PerlIO_tell(PerlIONext(f)); 548 } 549 550 PerlIO * 551 PerlIOEncode_dup(pTHX_ PerlIO * f, PerlIO * o, 552 CLONE_PARAMS * params, int flags) 553 { 554 if ((f = PerlIOBase_dup(aTHX_ f, o, params, flags))) { 555 PerlIOEncode *fe = PerlIOSelf(f, PerlIOEncode); 556 PerlIOEncode *oe = PerlIOSelf(o, PerlIOEncode); 557 if (oe->enc) { 558 fe->enc = PerlIO_sv_dup(aTHX_ oe->enc, params); 559 } 560 } 561 return f; 562 } 563 564 SSize_t 565 PerlIOEncode_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count) 566 { 567 PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode); 568 if (e->flags & NEEDS_LINES) { 569 SSize_t done = 0; 570 const char *ptr = (const char *) vbuf; 571 const char *end = ptr+count; 572 while (ptr < end) { 573 const char *nl = ptr; 574 while (nl < end && *nl++ != '\n') /* empty body */; 575 done = PerlIOBuf_write(aTHX_ f, ptr, nl-ptr); 576 if (done != nl-ptr) { 577 if (done > 0) { 578 ptr += done; 579 } 580 break; 581 } 582 ptr += done; 583 if (ptr[-1] == '\n') { 584 if (PerlIOEncode_flush(aTHX_ f) != 0) { 585 break; 586 } 587 } 588 } 589 return (SSize_t) (ptr - (const char *) vbuf); 590 } 591 else { 592 return PerlIOBuf_write(aTHX_ f, vbuf, count); 593 } 594 } 595 596 PerlIO_funcs PerlIO_encode = { 597 sizeof(PerlIO_funcs), 598 "encoding", 599 sizeof(PerlIOEncode), 600 PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT, 601 PerlIOEncode_pushed, 602 PerlIOEncode_popped, 603 PerlIOBuf_open, 604 NULL, /* binmode - always pop */ 605 PerlIOEncode_getarg, 606 PerlIOBase_fileno, 607 PerlIOEncode_dup, 608 PerlIOBuf_read, 609 PerlIOBuf_unread, 610 PerlIOEncode_write, 611 PerlIOBuf_seek, 612 PerlIOEncode_tell, 613 PerlIOEncode_close, 614 PerlIOEncode_flush, 615 PerlIOEncode_fill, 616 PerlIOBase_eof, 617 PerlIOBase_error, 618 PerlIOBase_clearerr, 619 PerlIOBase_setlinebuf, 620 PerlIOEncode_get_base, 621 PerlIOBuf_bufsiz, 622 PerlIOBuf_get_ptr, 623 PerlIOBuf_get_cnt, 624 PerlIOBuf_set_ptrcnt, 625 }; 626 #endif /* encode layer */ 627 628 MODULE = PerlIO::encoding PACKAGE = PerlIO::encoding 629 630 PROTOTYPES: ENABLE 631 632 BOOT: 633 { 634 SV *chk = get_sv("PerlIO::encoding::fallback", GV_ADD|GV_ADDMULTI); 635 /* 636 * we now "use Encode ()" here instead of 637 * PerlIO/encoding.pm. This avoids SEGV when ":encoding()" 638 * is invoked without prior "use Encode". -- dankogai 639 */ 640 PUSHSTACKi(PERLSI_MAGIC); 641 SPAGAIN; 642 if (!get_cv(OUR_DEFAULT_FB, 0)) { 643 #if 0 644 /* This would just be an irritant now loading works */ 645 Perl_warner(aTHX_ packWARN(WARN_IO), ":encoding without 'use Encode'"); 646 #endif 647 ENTER; 648 /* Encode needs a lot of stack - it is likely to move ... */ 649 PUTBACK; 650 /* The SV is magically freed by load_module */ 651 load_module(PERL_LOADMOD_NOIMPORT, newSVpvn("Encode", 6), Nullsv, Nullsv); 652 SPAGAIN; 653 LEAVE; 654 } 655 PUSHMARK(sp); 656 PUTBACK; 657 if (call_pv(OUR_DEFAULT_FB, G_SCALAR) != 1) { 658 /* should never happen */ 659 Perl_die(aTHX_ "%s did not return a value",OUR_DEFAULT_FB); 660 } 661 SPAGAIN; 662 sv_setsv(chk, POPs); 663 PUTBACK; 664 #ifdef PERLIO_LAYERS 665 PerlIO_define_layer(aTHX_ &PerlIO_encode); 666 #endif 667 POPSTACK; 668 } 669