ext/PerlIO/encoding/encoding.xs

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