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