/*
		 * $Id: encoding.xs,v 0.3 2002/04/21 22:14:41 dankogai Exp $
		 */
		
		#define PERL_NO_GET_CONTEXT
		#include "EXTERN.h"
		#include "perl.h"
		#include "XSUB.h"
		#define U8 U8
		
		#define OUR_DEFAULT_FB	"Encode::PERLQQ"
		
		#if defined(USE_PERLIO) && !defined(USE_SFIO)
		
		/* Define an encoding "layer" in the perliol.h sense.
		
		   The layer defined here "inherits" in an object-oriented sense from
		   the "perlio" layer with its PerlIOBuf_* "methods".  The
		   implementation is particularly efficient as until Encode settles
		   down there is no point in tryint to tune it.
		
		   The layer works by overloading the "fill" and "flush" methods.
		
		   "fill" calls "SUPER::fill" in perl terms, then calls the encode OO
		   perl API to convert the encoded data to UTF-8 form, then copies it
		   back to the buffer. The "base class's" read methods then see the
		   UTF-8 data.
		
		   "flush" transforms the UTF-8 data deposited by the "base class's
		   write method in the buffer back into the encoded form using the
		   encode OO perl API, then copies data back into the buffer and calls
		   "SUPER::flush.
		
		   Note that "flush" is _also_ called for read mode - we still do the
		   (back)-translate so that the base class's "flush" sees the
		   correct number of encoded chars for positioning the seek
		   pointer. (This double translation is the worst performance issue -
		   particularly with all-perl encode engine.)
		
		*/
		
		#include "perliol.h"
		
		typedef struct {
		    PerlIOBuf base;		/* PerlIOBuf stuff */
		    SV *bufsv;			/* buffer seen by layers above */
		    SV *dataSV;			/* data we have read from layer below */
		    SV *enc;			/* the encoding object */
		    SV *chk;                    /* CHECK in Encode methods */
		    int flags;			/* Flags currently just needs lines */
		} PerlIOEncode;
		
		#define NEEDS_LINES	1
		
		SV *
		PerlIOEncode_getarg(pTHX_ PerlIO * f, CLONE_PARAMS * param, int flags)
           5    {
           5        PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
           5        SV *sv = &PL_sv_undef;
           5        if (e->enc) {
           5    	dSP;
			/* Not 100% sure stack swap is right thing to do during dup ... */
           5    	PUSHSTACKi(PERLSI_MAGIC);
           5    	SPAGAIN;
           5    	ENTER;
           5    	SAVETMPS;
           5    	PUSHMARK(sp);
           5    	XPUSHs(e->enc);
           5    	PUTBACK;
           5    	if (call_method("name", G_SCALAR) == 1) {
           5    	    SPAGAIN;
           5    	    sv = newSVsv(POPs);
           5    	    PUTBACK;
			}
           5    	FREETMPS;
           5    	LEAVE;
           5    	POPSTACK;
		    }
           5        return sv;
		}
		
		IV
		PerlIOEncode_pushed(pTHX_ PerlIO * f, const char *mode, SV * arg, PerlIO_funcs *tab)
         106    {
         106        PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
         106        dSP;
         106        IV  code = PerlIOBuf_pushed(aTHX_ f, mode, Nullsv,tab);
         106        SV *result = Nullsv;
		
         106        PUSHSTACKi(PERLSI_MAGIC);
         106        SPAGAIN;
		
         106        ENTER;
         106        SAVETMPS;
		
         106        PUSHMARK(sp);
         106        XPUSHs(arg);
         106        PUTBACK;
         106        if (call_pv("Encode::find_encoding", G_SCALAR) != 1) {
			/* should never happen */
      ######    	Perl_die(aTHX_ "Encode::find_encoding did not return a value");
      ######    	return -1;
		    }
         106        SPAGAIN;
         106        result = POPs;
         106        PUTBACK;
		
         106        if (!SvROK(result) || !SvOBJECT(SvRV(result))) {
           2    	e->enc = Nullsv;
           2    	Perl_warner(aTHX_ packWARN(WARN_IO), "Cannot find encoding \"%" SVf "\"",
				    arg);
           2    	errno = EINVAL;
           2    	code = -1;
		    }
		    else {
		
		       /* $enc->renew */
         104    	PUSHMARK(sp);
         104    	XPUSHs(result);
         104    	PUTBACK;
         104    	if (call_method("renew",G_SCALAR|G_EVAL) != 1 || SvTRUE(ERRSV)) {
      ######    	    Perl_warner(aTHX_ packWARN(WARN_IO), "\"%" SVf "\" does not support renew method",
					arg);
			}
			else {
         104    	    SPAGAIN;
         104    	    result = POPs;
         104    	    PUTBACK;
			}
         104    	e->enc = newSVsv(result);
         104    	PUSHMARK(sp);
         104    	XPUSHs(e->enc);
         104    	PUTBACK;
         104    	if (call_method("needs_lines",G_SCALAR|G_EVAL) != 1 || SvTRUE(ERRSV)) {
      ######    	    Perl_warner(aTHX_ packWARN(WARN_IO), "\"%" SVf "\" does not support needs_lines",
					arg);
			}
			else {
         104    	    SPAGAIN;
         104    	    result = POPs;
         104    	    PUTBACK;
         104    	    if (SvTRUE(result)) {
          19    		e->flags |= NEEDS_LINES;
			    }
			}
         104    	PerlIOBase(f)->flags |= PERLIO_F_UTF8;
		    }
		
         106        e->chk = newSVsv(get_sv("PerlIO::encoding::fallback", 0));
		
         106        FREETMPS;
         106        LEAVE;
         106        POPSTACK;
         106        return code;
		}
		
		IV
		PerlIOEncode_popped(pTHX_ PerlIO * f)
         106    {
         106        PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
         106        if (e->enc) {
         104    	SvREFCNT_dec(e->enc);
         104    	e->enc = Nullsv;
		    }
         106        if (e->bufsv) {
           7    	SvREFCNT_dec(e->bufsv);
           7    	e->bufsv = Nullsv;
		    }
         106        if (e->dataSV) {
          30    	SvREFCNT_dec(e->dataSV);
          30    	e->dataSV = Nullsv;
		    }
         106        if (e->chk) {
         106    	SvREFCNT_dec(e->chk);
         106    	e->chk = Nullsv;
		    }
         106        return 0;
		}
		
		STDCHAR *
		PerlIOEncode_get_base(pTHX_ PerlIO * f)
         462    {
         462        PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
         462        if (!e->base.bufsiz)
          72    	e->base.bufsiz = 1024;
         462        if (!e->bufsv) {
          72    	e->bufsv = newSV(e->base.bufsiz);
          72    	sv_setpvn(e->bufsv, "", 0);
		    }
         462        e->base.buf = (STDCHAR *) SvPVX(e->bufsv);
         462        if (!e->base.ptr)
         444    	e->base.ptr = e->base.buf;
         462        if (!e->base.end)
         444    	e->base.end = e->base.buf;
         462        if (e->base.ptr < e->base.buf
			|| e->base.ptr > e->base.buf + SvLEN(e->bufsv)) {
      ######    	Perl_warn(aTHX_ " ptr %p(%p)%p", e->base.buf, e->base.ptr,
				  e->base.buf + SvLEN(e->bufsv));
      ######    	abort();
		    }
         462        if (SvLEN(e->bufsv) < e->base.bufsiz) {
           8    	SSize_t poff = e->base.ptr - e->base.buf;
           8    	SSize_t eoff = e->base.end - e->base.buf;
           8    	e->base.buf = (STDCHAR *) SvGROW(e->bufsv, e->base.bufsiz);
           8    	e->base.ptr = e->base.buf + poff;
           8    	e->base.end = e->base.buf + eoff;
		    }
         462        if (e->base.ptr < e->base.buf
			|| e->base.ptr > e->base.buf + SvLEN(e->bufsv)) {
      ######    	Perl_warn(aTHX_ " ptr %p(%p)%p", e->base.buf, e->base.ptr,
				  e->base.buf + SvLEN(e->bufsv));
      ######    	abort();
		    }
         462        return e->base.buf;
		}
		
		IV
		PerlIOEncode_fill(pTHX_ PerlIO * f)
         347    {
         347        PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
         347        dSP;
         347        IV code = 0;
         347        PerlIO *n;
         347        SSize_t avail;
		
         347        if (PerlIO_flush(f) != 0)
      ######    	return -1;
         347        n  = PerlIONext(f);
         347        if (!PerlIO_fast_gets(n)) {
			/* Things get too messy if we don't have a buffer layer
			   push a :perlio to do the job */
      ######    	char mode[8];
      ######    	n  = PerlIO_push(aTHX_ n, &PerlIO_perlio, PerlIO_modestr(f,mode), Nullsv);
      ######    	if (!n) {
      ######    	    Perl_die(aTHX_ "panic: cannot push :perlio for %p",f);
			}
		    }
         347        PUSHSTACKi(PERLSI_MAGIC);
         347        SPAGAIN;
         347        ENTER;
         347        SAVETMPS;
		  retry:
         392        avail = PerlIO_get_cnt(n);
         392        if (avail <= 0) {
         143    	avail = PerlIO_fill(n);
         143    	if (avail == 0) {
         115    	    avail = PerlIO_get_cnt(n);
			}
			else {
          28    	    if (!PerlIO_error(n) && PerlIO_eof(n))
          28    		avail = 0;
			}
		    }
         392        if (avail > 0 || (e->flags & NEEDS_LINES)) {
         372    	STDCHAR *ptr = PerlIO_get_ptr(n);
         372    	SSize_t use  = (avail >= 0) ? avail : 0;
         372    	SV *uni;
         372    	char *s;
         372    	STRLEN len = 0;
         372    	e->base.ptr = e->base.end = (STDCHAR *) Nullch;
         372    	(void) PerlIOEncode_get_base(aTHX_ f);
         372    	if (!e->dataSV)
          30    	    e->dataSV = newSV(0);
         372    	if (SvTYPE(e->dataSV) < SVt_PV) {
          30    	    sv_upgrade(e->dataSV,SVt_PV);
			}
         372    	if (e->flags & NEEDS_LINES) {
			    /* Encoding needs whole lines (e.g. iso-2022-*)
			       search back from end of available data for
			       and line marker
			     */
          80    	    STDCHAR *nl = ptr+use-1;
        3336    	    while (nl >= ptr) {
        3296    		if (*nl == '\n') {
          40    		    break;
				}
        3256    		nl--;
			    }
          80    	    if (nl >= ptr && *nl == '\n') {
				/* found a line - take up to and including that */
          40    		use = (nl+1)-ptr;
			    }
          40    	    else if (avail > 0) {
				/* No line, but not EOF - append avail to the pending data */
          32    		sv_catpvn(e->dataSV, (char*)ptr, use);
          32    		PerlIO_set_ptrcnt(n, ptr+use, 0);
          32    		goto retry;
			    }
           8    	    else if (!SvCUR(e->dataSV)) {
           8    		goto end_of_file;
			    }
			}
         332    	if (SvCUR(e->dataSV)) {
			    /* something left over from last time - create a normal
			       SV with new data appended
			     */
          45    	    if (use + SvCUR(e->dataSV) > e->base.bufsiz) {
          23    		if (e->flags & NEEDS_LINES) {
				    /* Have to grow buffer */
          10    		    e->base.bufsiz = use + SvCUR(e->dataSV);
          10    		    PerlIOEncode_get_base(aTHX_ f);
				}
				else {
          13    	       use = e->base.bufsiz - SvCUR(e->dataSV);
			    }
			    }
          45    	    sv_catpvn(e->dataSV,(char*)ptr,use);
			}
			else {
			    /* Create a "dummy" SV to represent the available data from layer below */
         287    	    if (SvLEN(e->dataSV) && SvPVX_const(e->dataSV)) {
          47    		Safefree(SvPVX_mutable(e->dataSV));
			    }
         287    	    if (use > (SSize_t)e->base.bufsiz) {
         209    		if (e->flags & NEEDS_LINES) {
				    /* Have to grow buffer */
           8    		    e->base.bufsiz = use;
           8    		    PerlIOEncode_get_base(aTHX_ f);
				}
				else {
         201    	       use = e->base.bufsiz;
			    }
			    }
         287    	    SvPV_set(e->dataSV, (char *) ptr);
         287    	    SvLEN_set(e->dataSV, 0);  /* Hands off sv.c - it isn't yours */
         287    	    SvCUR_set(e->dataSV,use);
         287    	    SvPOK_only(e->dataSV);
			}
         332    	SvUTF8_off(e->dataSV);
         332    	PUSHMARK(sp);
         332    	XPUSHs(e->enc);
         332    	XPUSHs(e->dataSV);
         332    	XPUSHs(e->chk);
         332    	PUTBACK;
         332    	if (call_method("decode", G_SCALAR) != 1) {
      ######    	    Perl_die(aTHX_ "panic: decode did not return a value");
			}
         332    	SPAGAIN;
         332    	uni = POPs;
         332    	PUTBACK;
			/* Now get translated string (forced to UTF-8) and use as buffer */
         332    	if (SvPOK(uni)) {
         332    	    s = SvPVutf8(uni, len);
		#ifdef PARANOID_ENCODE_CHECKS
			    if (len && !is_utf8_string((U8*)s,len)) {
				Perl_warn(aTHX_ "panic: decode did not return UTF-8 '%.*s'",(int) len,s);
			    }
		#endif
			}
         332    	if (len > 0) {
			    /* Got _something */
			    /* if decode gave us back dataSV then data may vanish when
			       we do ptrcnt adjust - so take our copy now.
			       (The copy is a pain - need a put-it-here option for decode.)
			     */
         319    	    sv_setpvn(e->bufsv,s,len);
         319    	    e->base.ptr = e->base.buf = (STDCHAR*)SvPVX(e->bufsv);
         319    	    e->base.end = e->base.ptr + SvCUR(e->bufsv);
         319    	    PerlIOBase(f)->flags |= PERLIO_F_RDBUF;
         319    	    SvUTF8_on(e->bufsv);
		
			    /* Adjust ptr/cnt not taking anything which
			       did not translate - not clear this is a win */
			    /* compute amount we took */
         319    	    use -= SvCUR(e->dataSV);
         319    	    PerlIO_set_ptrcnt(n, ptr+use, (avail-use));
			    /* and as we did not take it it isn't pending */
         319    	    SvCUR_set(e->dataSV,0);
			} else {
			    /* Got nothing - assume partial character so we need some more */
			    /* Make sure e->dataSV is a normal SV before re-filling as
			       buffer alias will change under us
			     */
          13    	    s = SvPV(e->dataSV,len);
          13    	    sv_setpvn(e->dataSV,s,len);
          13    	    PerlIO_set_ptrcnt(n, ptr+use, (avail-use));
          13    	    goto retry;
			}
		    }
		    else {
		    end_of_file:
          28    	code = -1;
          28    	if (avail == 0)
          28    	    PerlIOBase(f)->flags |= PERLIO_F_EOF;
			else
      ######    	    PerlIOBase(f)->flags |= PERLIO_F_ERROR;
		    }
         347        FREETMPS;
         347        LEAVE;
         347        POPSTACK;
         347        return code;
		}
		
		IV
		PerlIOEncode_flush(pTHX_ PerlIO * f)
        4364    {
        4364        PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
        4364        IV code = 0;
		
        4364        if (e->bufsv) {
        4297    	dSP;
        4297    	SV *str;
        4297    	char *s;
        4297    	STRLEN len;
        4297    	SSize_t count = 0;
        4297    	if ((PerlIOBase(f)->flags & PERLIO_F_WRBUF) && (e->base.ptr > e->base.buf)) {
			    /* Write case - encode the buffer and write() to layer below */
        2977    	    PUSHSTACKi(PERLSI_MAGIC);
        2977    	    SPAGAIN;
        2977    	    ENTER;
        2977    	    SAVETMPS;
        2977    	    PUSHMARK(sp);
        2977    	    XPUSHs(e->enc);
        2977    	    SvCUR_set(e->bufsv, e->base.ptr - e->base.buf);
        2977    	    SvUTF8_on(e->bufsv);
        2977    	    XPUSHs(e->bufsv);
        2977    	    XPUSHs(e->chk);
        2977    	    PUTBACK;
        2977    	    if (call_method("encode", G_SCALAR) != 1) {
      ######    		Perl_die(aTHX_ "panic: encode did not return a value");
			    }
        2977    	    SPAGAIN;
        2977    	    str = POPs;
        2977    	    PUTBACK;
        2977    	    s = SvPV(str, len);
        2977    	    count = PerlIO_write(PerlIONext(f),s,len);
        2977    	    if ((STRLEN)count != len) {
      ######    		code = -1;
			    }
        2977    	    FREETMPS;
        2977    	    LEAVE;
        2977    	    POPSTACK;
        2977    	    if (PerlIO_flush(PerlIONext(f)) != 0) {
      ######    		code = -1;
			    }
        2977    	    if (SvCUR(e->bufsv)) {
				/* Did not all translate */
         105    		e->base.ptr = e->base.buf+SvCUR(e->bufsv);
         105    		return code;
			    }
			}
        1320    	else if ((PerlIOBase(f)->flags & PERLIO_F_RDBUF)) {
			    /* read case */
			    /* if we have any untranslated stuff then unread that first */
			    /* FIXME - unread is fragile is there a better way ? */
         376    	    if (e->dataSV && SvCUR(e->dataSV)) {
      ######    		s = SvPV(e->dataSV, len);
      ######    		count = PerlIO_unread(PerlIONext(f),s,len);
      ######    		if ((STRLEN)count != len) {
      ######    		    code = -1;
				}
      ######    		SvCUR_set(e->dataSV,0);
			    }
			    /* See if there is anything left in the buffer */
         376    	    if (e->base.ptr < e->base.end) {
				/* Bother - have unread data.
				   re-encode and unread() to layer below
				 */
           1    		PUSHSTACKi(PERLSI_MAGIC);
           1    		SPAGAIN;
           1    		ENTER;
           1    		SAVETMPS;
           1    		str = sv_newmortal();
           1    		sv_upgrade(str, SVt_PV);
           1    		SvPV_set(str, (char*)e->base.ptr);
           1    		SvLEN_set(str, 0);
           1    		SvCUR_set(str, e->base.end - e->base.ptr);
           1    		SvPOK_only(str);
           1    		SvUTF8_on(str);
           1    		PUSHMARK(sp);
           1    		XPUSHs(e->enc);
           1    		XPUSHs(str);
           1    		XPUSHs(e->chk);
           1    		PUTBACK;
           1    		if (call_method("encode", G_SCALAR) != 1) {
      ######    		     Perl_die(aTHX_ "panic: encode did not return a value");
				}
           1    		SPAGAIN;
           1    		str = POPs;
           1    		PUTBACK;
           1    		s = SvPV(str, len);
           1    		count = PerlIO_unread(PerlIONext(f),s,len);
           1    		if ((STRLEN)count != len) {
      ######    		    code = -1;
				}
           1    		FREETMPS;
           1    		LEAVE;
           1    		POPSTACK;
			    }
			}
        4192    	e->base.ptr = e->base.end = e->base.buf;
        4192    	PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
		    }
        4259        return code;
		}
		
		IV
		PerlIOEncode_close(pTHX_ PerlIO * f)
          66    {
          66        PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
          66        IV code;
          66        if (PerlIOBase(f)->flags & PERLIO_F_RDBUF) {
			/* Discard partial character */
          27    	if (e->dataSV) {
          27    	    SvCUR_set(e->dataSV,0);
			}
			/* Don't back decode and unread any pending data */
          27    	e->base.ptr = e->base.end = e->base.buf;
		    }
          66        code = PerlIOBase_close(aTHX_ f);
          66        if (e->bufsv) {
			/* This should only fire for write case */
          65    	if (e->base.buf && e->base.ptr > e->base.buf) {
      ######    	    Perl_croak(aTHX_ "Close with partial character");
			}
          65    	SvREFCNT_dec(e->bufsv);
          65    	e->bufsv = Nullsv;
		    }
          66        e->base.buf = NULL;
          66        e->base.ptr = NULL;
          66        e->base.end = NULL;
          66        PerlIOBase(f)->flags &= ~(PERLIO_F_RDBUF | PERLIO_F_WRBUF);
          66        return code;
		}
		
		Off_t
		PerlIOEncode_tell(pTHX_ PerlIO * f)
           1    {
           1        PerlIOBuf *b = PerlIOSelf(f, PerlIOBuf);
		    /* Unfortunately the only way to get a postion is to (re-)translate,
		       the UTF8 we have in bufefr and then ask layer below
		     */
           1        PerlIO_flush(f);
           1        if (b->buf && b->ptr > b->buf) {
      ######    	Perl_croak(aTHX_ "Cannot tell at partial character");
		    }
           1        return PerlIO_tell(PerlIONext(f));
		}
		
		PerlIO *
		PerlIOEncode_dup(pTHX_ PerlIO * f, PerlIO * o,
				 CLONE_PARAMS * params, int flags)
           2    {
           2        if ((f = PerlIOBase_dup(aTHX_ f, o, params, flags))) {
           2    	PerlIOEncode *fe = PerlIOSelf(f, PerlIOEncode);
           2    	PerlIOEncode *oe = PerlIOSelf(o, PerlIOEncode);
           2    	if (oe->enc) {
           2    	    fe->enc = PerlIO_sv_dup(aTHX_ oe->enc, params);
			}
		    }
           2        return f;
		}
		
		SSize_t
		PerlIOEncode_write(pTHX_ PerlIO *f, const void *vbuf, Size_t count)
        1977    {
        1977        PerlIOEncode *e = PerlIOSelf(f, PerlIOEncode);
        1977        if (e->flags & NEEDS_LINES) {
         924    	SSize_t done = 0;
         924    	const char *ptr = (const char *) vbuf;
         924    	const char *end = ptr+count;
        2764    	while (ptr < end) {
        1840    	    const char *nl = ptr;
      186720    	    while (nl < end && *nl++ != '\n') /* empty body */;
        1840    	    done = PerlIOBuf_write(aTHX_ f, ptr, nl-ptr);
        1840    	    if (done != nl-ptr) {
      ######    		if (done > 0) {
      ######    		    ptr += done;
				}
      ######    		break;
			    }
        1840    	    ptr += done;
        1840    	    if (ptr[-1] == '\n') {
        1840    		if (PerlIOEncode_flush(aTHX_ f) != 0) {
         924    		    break;
				}
			    }
			}
         924    	return (SSize_t) (ptr - (const char *) vbuf);
		    }
		    else {
        1053    	return PerlIOBuf_write(aTHX_ f, vbuf, count);
		    }
		}
		
		PerlIO_funcs PerlIO_encode = {
		    sizeof(PerlIO_funcs),
		    "encoding",
		    sizeof(PerlIOEncode),
		    PERLIO_K_BUFFERED|PERLIO_K_DESTRUCT,
		    PerlIOEncode_pushed,
		    PerlIOEncode_popped,
		    PerlIOBuf_open,
		    NULL, /* binmode - always pop */
		    PerlIOEncode_getarg,
		    PerlIOBase_fileno,
		    PerlIOEncode_dup,
		    PerlIOBuf_read,
		    PerlIOBuf_unread,
		    PerlIOEncode_write,
		    PerlIOBuf_seek,
		    PerlIOEncode_tell,
		    PerlIOEncode_close,
		    PerlIOEncode_flush,
		    PerlIOEncode_fill,
		    PerlIOBase_eof,
		    PerlIOBase_error,
		    PerlIOBase_clearerr,
		    PerlIOBase_setlinebuf,
		    PerlIOEncode_get_base,
		    PerlIOBuf_bufsiz,
		    PerlIOBuf_get_ptr,
		    PerlIOBuf_get_cnt,
		    PerlIOBuf_set_ptrcnt,
		};
		#endif				/* encode layer */
		
		MODULE = PerlIO::encoding PACKAGE = PerlIO::encoding
		
		PROTOTYPES: ENABLE
		
		BOOT:
		{
          17        SV *chk = get_sv("PerlIO::encoding::fallback", GV_ADD|GV_ADDMULTI);
		    /*
		     * we now "use Encode ()" here instead of
		     * PerlIO/encoding.pm.  This avoids SEGV when ":encoding()"
		     * is invoked without prior "use Encode". -- dankogai
		     */
          17        PUSHSTACKi(PERLSI_MAGIC);
          17        SPAGAIN;
          17        if (!get_cv(OUR_DEFAULT_FB, 0)) {
		#if 0
			/* This would just be an irritant now loading works */
			Perl_warner(aTHX_ packWARN(WARN_IO), ":encoding without 'use Encode'");
		#endif
           2    	ENTER;
			/* Encode needs a lot of stack - it is likely to move ... */
           2    	PUTBACK;
			/* The SV is magically freed by load_module */
           2    	load_module(PERL_LOADMOD_NOIMPORT, newSVpvn("Encode", 6), Nullsv, Nullsv);
           2    	SPAGAIN;
           2    	LEAVE;
		    }
          17        PUSHMARK(sp);
          17        PUTBACK;
          17        if (call_pv(OUR_DEFAULT_FB, G_SCALAR) != 1) {
			    /* should never happen */
      ######    	    Perl_die(aTHX_ "%s did not return a value",OUR_DEFAULT_FB);
		    }
          17        SPAGAIN;
          17        sv_setsv(chk, POPs);
          17        PUTBACK;
		#ifdef PERLIO_LAYERS
          17        PerlIO_define_layer(aTHX_ &PerlIO_encode);
		#endif
          17        POPSTACK;
		}
		}