Bug Summary

File:obj/gnu/usr.bin/perl/cpan/Encode/Encode.c
Warning:line 439, column 9
Null pointer passed as 2nd argument to memory copy function

Annotated Source Code

Press '?' to see keyboard shortcuts

clang -cc1 -cc1 -triple amd64-unknown-openbsd7.0 -analyze -disable-free -disable-llvm-verifier -discard-value-names -main-file-name Encode.c -analyzer-store=region -analyzer-opt-analyze-nested-blocks -analyzer-checker=core -analyzer-checker=apiModeling -analyzer-checker=unix -analyzer-checker=deadcode -analyzer-checker=security.insecureAPI.UncheckedReturn -analyzer-checker=security.insecureAPI.getpw -analyzer-checker=security.insecureAPI.gets -analyzer-checker=security.insecureAPI.mktemp -analyzer-checker=security.insecureAPI.mkstemp -analyzer-checker=security.insecureAPI.vfork -analyzer-checker=nullability.NullPassedToNonnull -analyzer-checker=nullability.NullReturnedFromNonnull -analyzer-output plist -w -setup-static-analyzer -mrelocation-model pic -pic-level 1 -fhalf-no-semantic-interposition -fno-delete-null-pointer-checks -mframe-pointer=all -relaxed-aliasing -fno-rounding-math -mconstructor-aliases -munwind-tables -target-cpu x86-64 -target-feature +retpoline-indirect-calls -target-feature +retpoline-indirect-branches -tune-cpu generic -debugger-tuning=gdb -fcoverage-compilation-dir=/usr/obj/gnu/usr.bin/perl/cpan/Encode -resource-dir /usr/local/lib/clang/13.0.0 -I ./Encode -D NO_LOCALE_NUMERIC -D NO_LOCALE_COLLATE -D VERSION="3.06_01" -D XS_VERSION="3.06_01" -D PIC -I ../.. -internal-isystem /usr/local/lib/clang/13.0.0/include -internal-externc-isystem /usr/include -O2 -Wwrite-strings -fconst-strings -fdebug-compilation-dir=/usr/obj/gnu/usr.bin/perl/cpan/Encode -ferror-limit 19 -fwrapv -D_RET_PROTECTOR -ret-protector -fgnuc-version=4.2.1 -vectorize-loops -vectorize-slp -fno-builtin-malloc -fno-builtin-calloc -fno-builtin-realloc -fno-builtin-valloc -fno-builtin-free -fno-builtin-strdup -fno-builtin-strndup -analyzer-output=html -faddrsig -D__GCC_HAVE_DWARF2_CFI_ASM=1 -o /home/ben/Projects/vmm/scan-build/2022-01-12-194120-40624-1 -x c Encode.c
1/*
2 * This file was generated automatically by ExtUtils::ParseXS version 3.40 from the
3 * contents of Encode.xs. Do not edit this file, edit Encode.xs instead.
4 *
5 * ANY CHANGES MADE HERE WILL BE LOST!
6 *
7 */
8
9#line 1 "Encode.xs"
10/*
11 $Id: Encode.xs,v 2.48 2020/03/02 04:34:34 dankogai Exp $
12 */
13
14#define PERL_NO_GET_CONTEXT
15#define IN_ENCODE_XS
16#include "EXTERN.h"
17#include "perl.h"
18#include "XSUB.h"
19#include "encode.h"
20#include "def_t.h"
21
22# define PERLIO_MODNAME"PerlIO::encoding" "PerlIO::encoding"
23# define PERLIO_FILENAME"PerlIO/encoding.pm" "PerlIO/encoding.pm"
24
25/* set 1 or more to profile. t/encoding.t dumps core because of
26 Perl_warner and PerlIO don't work well */
27#define ENCODE_XS_PROFILE0 0
28
29/* set 0 to disable floating point to calculate buffer size for
30 encode_method(). 1 is recommended. 2 restores NI-S original */
31#define ENCODE_XS_USEFP1 1
32
33#ifndef SvIV_nomg
34#define SvIV_nomg SvIV
35#endif
36
37#ifndef SvTRUE_nomg
38#define SvTRUE_nomg SvTRUE
39#endif
40
41#ifndef SVfARG
42#define SVfARG(p)((void*)(p)) ((void*)(p))
43#endif
44
45static void
46Encode_XSEncoding(pTHX_ encode_t * enc)
47{
48 dSPSV **sp = PL_stack_sp;
49 HV *stash = gv_stashpv("Encode::XS", TRUE)Perl_gv_stashpv( "Encode::XS",(1));
50 SV *iv = newSViv(PTR2IV(enc))Perl_newSViv( (IV)(enc));
51 SV *sv = sv_bless(newRV_noinc(iv),stash)Perl_sv_bless( Perl_newRV_noinc( iv),stash);
52 int i = 0;
53 /* with the SvLEN() == 0 hack, PVX won't be freed. We cast away name's
54 constness, in the hope that perl won't mess with it. */
55 assert(SvTYPE(iv) >= SVt_PV)((void)0); assert(SvLEN(iv) == 0)((void)0);
56 SvFLAGS(iv)(iv)->sv_flags |= SVp_POK0x00004000;
57 SvPVX(iv)((iv)->sv_u.svu_pv) = (char*) enc->name[0];
58 PUSHMARK(sp)do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry
= ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool
)0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry
= (I32)((sp) - PL_stack_base); ; } while (0);
59 XPUSHs(sv)do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (sv); } while (0);
60 while (enc->name[i]) {
61 const char *name = enc->name[i++];
62 XPUSHs(sv_2mortal(newSVpvn(name, strlen(name))))do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (Perl_sv_2mortal( Perl_newSVpvn( name,strlen(name))));
} while (0);
63 }
64 PUTBACKPL_stack_sp = sp;
65 call_pv("Encode::define_encoding", G_DISCARD)Perl_call_pv( "Encode::define_encoding",0x4);
66 SvREFCNT_dec(sv)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (sv); _p; })));
67}
68
69static void
70utf8_safe_downgrade(pTHX_ SV ** src, U8 ** s, STRLEN * slen, bool_Bool modify)
71{
72 if (!modify) {
73 SV *tmp = sv_2mortal(newSVpvn((char *)*s, *slen))Perl_sv_2mortal( Perl_newSVpvn( (char *)*s,*slen));
74 SvUTF8_on(tmp)((tmp)->sv_flags |= (0x20000000));
75 if (SvTAINTED(*src)(((*src)->sv_flags & (0x00200000|0x00400000|0x00800000
)) && Perl_sv_tainted( *src)))
76 SvTAINTED_on(tmp)do{ if(__builtin_expect((((((__builtin_expect(((PL_tainting) ?
(_Bool)1 : (_Bool)0),(0))) ? (_Bool)1 : (_Bool)0))) ? (_Bool
)1 : (_Bool)0),(0))){Perl_sv_magic( (tmp),((void*)0),'t',((void
*)0),0);} }while (0);
77 *src = tmp;
78 *s = (U8 *)SvPVX(*src)((*src)->sv_u.svu_pv);
79 }
80 if (*slen) {
81 if (!utf8_to_bytes(*s, slen)Perl_utf8_to_bytes( *s,slen))
82 croakPerl_croak("Wide character");
83 SvCUR_set(*src, *slen)do { ((void)0); ((void)0); ((void)0); (((XPV*) (*src)->sv_any
)->xpv_cur = (*slen)); } while (0);
84 }
85 SvUTF8_off(*src)((*src)->sv_flags &= ~(0x20000000));
86}
87
88static void
89utf8_safe_upgrade(pTHX_ SV ** src, U8 ** s, STRLEN * slen, bool_Bool modify)
90{
91 if (!modify) {
92 SV *tmp = sv_2mortal(newSVpvn((char *)*s, *slen))Perl_sv_2mortal( Perl_newSVpvn( (char *)*s,*slen));
93 if (SvTAINTED(*src)(((*src)->sv_flags & (0x00200000|0x00400000|0x00800000
)) && Perl_sv_tainted( *src)))
94 SvTAINTED_on(tmp)do{ if(__builtin_expect((((((__builtin_expect(((PL_tainting) ?
(_Bool)1 : (_Bool)0),(0))) ? (_Bool)1 : (_Bool)0))) ? (_Bool
)1 : (_Bool)0),(0))){Perl_sv_magic( (tmp),((void*)0),'t',((void
*)0),0);} }while (0);
95 *src = tmp;
96 }
97 sv_utf8_upgrade_nomg(*src)Perl_sv_utf8_upgrade_flags_grow( *src,0,0);
98 *s = (U8 *)SvPV_nomg(*src, *slen)((((*src)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((*slen = ((XPV*) (*src)->sv_any)->xpv_cur), ((*src
)->sv_u.svu_pv)) : Perl_sv_2pv_flags( *src,&*slen,0));
99}
100
101#define ERR_ENCODE_NOMAP"\"\\x{%04" "lx" "}\" does not map to %s" "\"\\x{%04" UVxf"lx" "}\" does not map to %s"
102#define ERR_DECODE_NOMAP"%s \"\\x%02" "lX" "\" does not map to Unicode" "%s \"\\x%02" UVXf"lX" "\" does not map to Unicode"
103#define ERR_DECODE_STR_NOMAP"%s \"%s\" does not map to Unicode" "%s \"%s\" does not map to Unicode"
104
105static SV *
106do_fallback_cb(pTHX_ UV ch, SV *fallback_cb)
107{
108 dSPSV **sp = PL_stack_sp;
109 int argc;
110 SV *retval;
111 ENTERPerl_push_scope();
112 SAVETMPSPerl_savetmps();
113 PUSHMARK(sp)do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry
= ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool
)0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry
= (I32)((sp) - PL_stack_base); ; } while (0);
114 XPUSHs(sv_2mortal(newSVuv(ch)))do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (Perl_sv_2mortal( Perl_newSVuv( ch))); } while (0);
115 PUTBACKPL_stack_sp = sp;
116 argc = call_sv(fallback_cb, G_SCALAR)Perl_call_sv( fallback_cb,2);
117 SPAGAINsp = PL_stack_sp;
118 if (argc != 1){
119 croakPerl_croak("fallback sub must return scalar!");
120 }
121 retval = POPs(*sp--);
122 SvREFCNT_inc(retval)Perl_SvREFCNT_inc(((SV *)({ void *_p = (retval); _p; })));
123 PUTBACKPL_stack_sp = sp;
124 FREETMPSif (PL_tmps_ix > PL_tmps_floor) Perl_free_tmps();
125 LEAVEPerl_pop_scope();
126 return retval;
127}
128
129static SV *
130do_bytes_fallback_cb(pTHX_ U8 *s, STRLEN slen, SV *fallback_cb)
131{
132 dSPSV **sp = PL_stack_sp;
133 int argc;
134 STRLEN i;
135 SV *retval;
136 ENTERPerl_push_scope();
137 SAVETMPSPerl_savetmps();
138 PUSHMARK(sp)do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry
= ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool
)0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry
= (I32)((sp) - PL_stack_base); ; } while (0);
139 for (i=0; i<slen; ++i)
140 XPUSHs(sv_2mortal(newSVuv(s[i])))do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (Perl_sv_2mortal( Perl_newSVuv( s[i]))); } while (0);
141 PUTBACKPL_stack_sp = sp;
142 argc = call_sv(fallback_cb, G_SCALAR)Perl_call_sv( fallback_cb,2);
143 SPAGAINsp = PL_stack_sp;
144 if (argc != 1){
145 croakPerl_croak("fallback sub must return scalar!");
146 }
147 retval = POPs(*sp--);
148 SvREFCNT_inc(retval)Perl_SvREFCNT_inc(((SV *)({ void *_p = (retval); _p; })));
149 PUTBACKPL_stack_sp = sp;
150 FREETMPSif (PL_tmps_ix > PL_tmps_floor) Perl_free_tmps();
151 LEAVEPerl_pop_scope();
152 return retval;
153}
154
155static SV *
156encode_method(pTHX_ const encode_t * enc, const encpage_t * dir, SV * src, U8 * s, STRLEN slen,
157 IV check, STRLEN * offset, SV * term, int * retcode,
158 SV *fallback_cb)
159{
160 U8 *sorig = s;
161 STRLEN tlen = slen;
162 STRLEN ddone = 0;
163 STRLEN sdone = 0;
164 /* We allocate slen+1.
165 PerlIO dumps core if this value is smaller than this. */
166 SV *dst = newSV(slen+1)Perl_newSV( slen+1);
167 U8 *d = (U8 *)SvPVX(dst)((dst)->sv_u.svu_pv);
168 STRLEN dlen = SvLEN(dst)((XPV*) (dst)->sv_any)->xpv_len_u.xpvlenu_len-1;
169 int code = 0;
170 STRLEN trmlen = 0;
171 U8 *trm = term ? (U8*) SvPV(term, trmlen)((((term)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((trmlen = ((XPV*) (term)->sv_any)->xpv_cur), ((term
)->sv_u.svu_pv)) : Perl_sv_2pv_flags( term,&trmlen,2)) : NULL((void*)0);
172
173 if (SvTAINTED(src)(((src)->sv_flags & (0x00200000|0x00400000|0x00800000)
) && Perl_sv_tainted( src))) SvTAINTED_on(dst)do{ if(__builtin_expect((((((__builtin_expect(((PL_tainting) ?
(_Bool)1 : (_Bool)0),(0))) ? (_Bool)1 : (_Bool)0))) ? (_Bool
)1 : (_Bool)0),(0))){Perl_sv_magic( (dst),((void*)0),'t',((void
*)0),0);} }while (0); /* propagate taintedness */
174
175 if (offset) {
176 s += *offset;
177 if (slen > *offset){ /* safeguard against slen overflow */
178 slen -= *offset;
179 }else{
180 slen = 0;
181 }
182 tlen = slen;
183 }
184
185 if (slen == 0){
186 SvCUR_set(dst, 0)do { ((void)0); ((void)0); ((void)0); (((XPV*) (dst)->sv_any
)->xpv_cur = (0)); } while (0);
187 SvPOK_only(dst)( (dst)->sv_flags &= ~((0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)| 0x80000000
|0x20000000), (dst)->sv_flags |= (0x00000400|0x00004000));
188 goto ENCODE_END;
189 }
190
191 while( (code = do_encode(dir, s, &slen, d, dlen, &dlen, !check,
192 trm, trmlen)) )
193 {
194 SvCUR_set(dst, dlen+ddone)do { ((void)0); ((void)0); ((void)0); (((XPV*) (dst)->sv_any
)->xpv_cur = (dlen+ddone)); } while (0);
195 SvPOK_only(dst)( (dst)->sv_flags &= ~((0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)| 0x80000000
|0x20000000), (dst)->sv_flags |= (0x00000400|0x00004000));
196
197 if (code == ENCODE_FALLBACK4 || code == ENCODE_PARTIAL2 ||
198 code == ENCODE_FOUND_TERM5) {
199 break;
200 }
201 switch (code) {
202 case ENCODE_NOSPACE1:
203 {
204 STRLEN more = 0; /* make sure you initialize! */
205 STRLEN sleft;
206 sdone += slen;
207 ddone += dlen;
208 sleft = tlen - sdone;
209#if ENCODE_XS_PROFILE0 >= 2
210 Perl_warn(aTHX_
211 "more=%d, sdone=%d, sleft=%d, SvLEN(dst)=%d\n",
212 more, sdone, sleft, SvLEN(dst)((XPV*) (dst)->sv_any)->xpv_len_u.xpvlenu_len);
213#endif
214 if (sdone != 0) { /* has src ever been processed ? */
215#if ENCODE_XS_USEFP1 == 2
216 more = (1.0*tlen*SvLEN(dst)((XPV*) (dst)->sv_any)->xpv_len_u.xpvlenu_len+sdone-1)/sdone
217 - SvLEN(dst)((XPV*) (dst)->sv_any)->xpv_len_u.xpvlenu_len;
218#elif ENCODE_XS_USEFP1
219 more = (STRLEN)((1.0*SvLEN(dst)((XPV*) (dst)->sv_any)->xpv_len_u.xpvlenu_len+1)/sdone * sleft);
220#else
221 /* safe until SvLEN(dst) == MAX_INT/16 */
222 more = (16*SvLEN(dst)((XPV*) (dst)->sv_any)->xpv_len_u.xpvlenu_len+1)/sdone/16 * sleft;
223#endif
224 }
225 more += UTF8_MAXLEN13; /* insurance policy */
226 d = (U8 *) SvGROW(dst, SvLEN(dst) + more)(((dst)->sv_flags & 0x10000000) || ((XPV*) (dst)->sv_any
)->xpv_len_u.xpvlenu_len < (((XPV*) (dst)->sv_any)->
xpv_len_u.xpvlenu_len + more) ? Perl_sv_grow( dst,((XPV*) (dst
)->sv_any)->xpv_len_u.xpvlenu_len + more) : ((dst)->
sv_u.svu_pv));
227 /* dst need to grow need MORE bytes! */
228 if (ddone >= SvLEN(dst)((XPV*) (dst)->sv_any)->xpv_len_u.xpvlenu_len) {
229 Perl_croak(aTHX_ "Destination couldn't be grown.");
230 }
231 dlen = SvLEN(dst)((XPV*) (dst)->sv_any)->xpv_len_u.xpvlenu_len-ddone-1;
232 d += ddone;
233 s += slen;
234 slen = tlen-sdone;
235 continue;
236 }
237
238 case ENCODE_NOREP3:
239 /* encoding */
240 if (dir == enc->f_utf8) {
241 STRLEN clen;
242 UV ch =
243 utf8n_to_uvchr(s+slen, (tlen-sdone-slen),Perl_utf8n_to_uvchr_msgs(s+slen, (tlen-sdone-slen), &clen
, ( 0x0002 |0x0004 |0x0008 |0x0010 |0x0080)|0x10000, 0, 0)
244 &clen, UTF8_ALLOW_ANY|UTF8_CHECK_ONLY)Perl_utf8n_to_uvchr_msgs(s+slen, (tlen-sdone-slen), &clen
, ( 0x0002 |0x0004 |0x0008 |0x0010 |0x0080)|0x10000, 0, 0);
245 /* if non-representable multibyte prefix at end of current buffer - break*/
246 if (clen > tlen - sdone - slen) break;
247 if (check & ENCODE_DIE_ON_ERR0x0001) {
248 Perl_croak(aTHX_ ERR_ENCODE_NOMAP"\"\\x{%04" "lx" "}\" does not map to %s",
249 (UV)ch, enc->name[0]);
250 return &PL_sv_undef(PL_sv_immortals[1]); /* never reaches but be safe */
251 }
252 if (encode_ckWARN(check, WARN_UTF8)((check & 0x0002) && (!(check & 0x0010) || Perl_ckwarn
( (44 ))))) {
253 Perl_warner(aTHX_ packWARN(WARN_UTF8)(44 ),
254 ERR_ENCODE_NOMAP"\"\\x{%04" "lx" "}\" does not map to %s", (UV)ch, enc->name[0]);
255 }
256 if (check & ENCODE_RETURN_ON_ERR0x0004){
257 goto ENCODE_SET_SRC;
258 }
259 if (check & (ENCODE_PERLQQ0x0100|ENCODE_HTMLCREF0x0200|ENCODE_XMLCREF0x0400)){
260 STRLEN sublen;
261 char *substr;
262 SV* subchar =
263 (fallback_cb != &PL_sv_undef(PL_sv_immortals[1]))
264 ? do_fallback_cb(aTHX_ ch, fallback_cb)
265 : newSVpvfPerl_newSVpvf(check & ENCODE_PERLQQ0x0100 ? "\\x{%04" UVxf"lx" "}" :
266 check & ENCODE_HTMLCREF0x0200 ? "&#%" UVuf"lu" ";" :
267 "&#x%" UVxf"lx" ";", (UV)ch);
268 substr = SvPV(subchar, sublen)((((subchar)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((sublen = ((XPV*) (subchar)->sv_any)->xpv_cur), ((
subchar)->sv_u.svu_pv)) : Perl_sv_2pv_flags( subchar,&
sublen,2));
269 if (SvUTF8(subchar)((subchar)->sv_flags & 0x20000000) && sublen && !utf8_to_bytes((U8 *)substr, &sublen)Perl_utf8_to_bytes( (U8 *)substr,&sublen)) { /* make sure no decoded string gets in */
270 SvREFCNT_dec(subchar)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (subchar); _p; })));
271 croakPerl_croak("Wide character");
272 }
273 sdone += slen + clen;
274 ddone += dlen + sublen;
275 sv_catpvn(dst, substr, sublen)Perl_sv_catpvn_flags( dst,substr,sublen,2);
276 SvREFCNT_dec(subchar)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (subchar); _p; })));
277 } else {
278 /* fallback char */
279 sdone += slen + clen;
280 ddone += dlen + enc->replen;
281 sv_catpvn(dst, (char*)enc->rep, enc->replen)Perl_sv_catpvn_flags( dst,(char*)enc->rep,enc->replen,2
);
282 }
283 }
284 /* decoding */
285 else {
286 if (check & ENCODE_DIE_ON_ERR0x0001){
287 Perl_croak(aTHX_ ERR_DECODE_NOMAP"%s \"\\x%02" "lX" "\" does not map to Unicode",
288 enc->name[0], (UV)s[slen]);
289 return &PL_sv_undef(PL_sv_immortals[1]); /* never reaches but be safe */
290 }
291 if (encode_ckWARN(check, WARN_UTF8)((check & 0x0002) && (!(check & 0x0010) || Perl_ckwarn
( (44 ))))) {
292 Perl_warner(
293 aTHX_ packWARN(WARN_UTF8)(44 ),
294 ERR_DECODE_NOMAP"%s \"\\x%02" "lX" "\" does not map to Unicode",
295 enc->name[0], (UV)s[slen]);
296 }
297 if (check & ENCODE_RETURN_ON_ERR0x0004){
298 goto ENCODE_SET_SRC;
299 }
300 if (check &
301 (ENCODE_PERLQQ0x0100|ENCODE_HTMLCREF0x0200|ENCODE_XMLCREF0x0400)){
302 STRLEN sublen;
303 char *substr;
304 SV* subchar =
305 (fallback_cb != &PL_sv_undef(PL_sv_immortals[1]))
306 ? do_fallback_cb(aTHX_ (UV)s[slen], fallback_cb)
307 : newSVpvfPerl_newSVpvf("\\x%02" UVXf"lX", (UV)s[slen]);
308 substr = SvPVutf8(subchar, sublen)((((subchar)->sv_flags & (0x00000400|0x20000000|0x00200000
)) == (0x00000400|0x20000000)) ? ((sublen = ((XPV*) (subchar)
->sv_any)->xpv_cur), ((subchar)->sv_u.svu_pv)) : Perl_sv_2pvutf8_flags
( subchar,&sublen,2));
309 sdone += slen + 1;
310 ddone += dlen + sublen;
311 sv_catpvn(dst, substr, sublen)Perl_sv_catpvn_flags( dst,substr,sublen,2);
312 SvREFCNT_dec(subchar)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (subchar); _p; })));
313 } else {
314 sdone += slen + 1;
315 ddone += dlen + strlen(FBCHAR_UTF8"\xEF\xBF\xBD");
316 sv_catpvn(dst, FBCHAR_UTF8, strlen(FBCHAR_UTF8))Perl_sv_catpvn_flags( dst,"\xEF\xBF\xBD",strlen("\xEF\xBF\xBD"
),2);
317 }
318 }
319 /* settle variables when fallback */
320 d = (U8 *)SvEND(dst)((dst)->sv_u.svu_pv + ((XPV*)(dst)->sv_any)->xpv_cur
);
321 dlen = SvLEN(dst)((XPV*) (dst)->sv_any)->xpv_len_u.xpvlenu_len - ddone - 1;
322 s = sorig + sdone;
323 slen = tlen - sdone;
324 break;
325
326 default:
327 Perl_croak(aTHX_ "Unexpected code %d converting %s %s",
328 code, (dir == enc->f_utf8) ? "to" : "from",
329 enc->name[0]);
330 return &PL_sv_undef(PL_sv_immortals[1]);
331 }
332 } /* End of looping through the string */
333 ENCODE_SET_SRC:
334 if (check && !(check & ENCODE_LEAVE_SRC0x0008)){
335 sdone = tlen - (slen+sdone);
336 sv_setpvn(src, (char*)s+slen, sdone)Perl_sv_setpvn( src,(char*)s+slen,sdone);
337 SvSETMAGIC(src)do { if (__builtin_expect(((((src)->sv_flags & 0x00400000
)) ? (_Bool)1 : (_Bool)0),(0))) Perl_mg_set( src); } while (0
);
338 }
339 /* warn("check = 0x%X, code = 0x%d\n", check, code); */
340
341 SvCUR_set(dst, dlen+ddone)do { ((void)0); ((void)0); ((void)0); (((XPV*) (dst)->sv_any
)->xpv_cur = (dlen+ddone)); } while (0);
342 SvPOK_only(dst)( (dst)->sv_flags &= ~((0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)| 0x80000000
|0x20000000), (dst)->sv_flags |= (0x00000400|0x00004000));
343
344#if ENCODE_XS_PROFILE0
345 if (SvCUR(dst)((XPV*) (dst)->sv_any)->xpv_cur > tlen){
346 Perl_warn(aTHX_
347 "SvLEN(dst)=%d, SvCUR(dst)=%d. %d bytes unused(%f %%)\n",
348 SvLEN(dst)((XPV*) (dst)->sv_any)->xpv_len_u.xpvlenu_len, SvCUR(dst)((XPV*) (dst)->sv_any)->xpv_cur, SvLEN(dst)((XPV*) (dst)->sv_any)->xpv_len_u.xpvlenu_len - SvCUR(dst)((XPV*) (dst)->sv_any)->xpv_cur,
349 (SvLEN(dst)((XPV*) (dst)->sv_any)->xpv_len_u.xpvlenu_len - SvCUR(dst)((XPV*) (dst)->sv_any)->xpv_cur)*1.0/SvLEN(dst)((XPV*) (dst)->sv_any)->xpv_len_u.xpvlenu_len*100.0);
350 }
351#endif
352
353 if (offset)
354 *offset += sdone + slen;
355
356 ENCODE_END:
357 *SvEND(dst)((dst)->sv_u.svu_pv + ((XPV*)(dst)->sv_any)->xpv_cur
) = '\0';
358 if (retcode) *retcode = code;
359 return dst;
360}
361
362static bool_Bool
363strict_utf8(pTHX_ SV* sv)
364{
365 HV* hv;
366 SV** svp;
367 sv = SvRV(sv)((sv)->sv_u.svu_rv);
368 if (!sv || SvTYPE(sv)((svtype)((sv)->sv_flags & 0xff)) != SVt_PVHV)
369 return 0;
370 hv = (HV*)sv;
371 svp = hv_fetch(hv, "strict_utf8", 11, 0)((SV**) Perl_hv_common_key_len( (hv),("strict_utf8"),(11),(0)
? (0x20 | 0x10) : 0x20,((void*)0),0));
372 if (!svp)
373 return 0;
374 return SvTRUE(*svp)Perl_SvTRUE( *svp);
375}
376
377static U8*
378process_utf8(pTHX_ SV* dst, U8* s, U8* e, SV *check_sv,
379 bool_Bool encode, bool_Bool strict, bool_Bool stop_at_partial)
380{
381 /* Copies the purportedly UTF-8 encoded string starting at 's' and ending
382 * at 'e' - 1 to 'dst', checking as it goes along that the string actually
383 * is valid UTF-8. There are two levels of strictness checking. If
384 * 'strict' is FALSE, the string is checked for being well-formed UTF-8, as
385 * extended by Perl. Additionally, if 'strict' is TRUE, above-Unicode code
386 * points, surrogates, and non-character code points are checked for. When
387 * invalid input is encountered, some action is taken, exactly what depends
388 * on the flags in 'check_sv'. 'encode' gives if this is from an encode
389 * operation (if TRUE), or a decode one. This function returns the
390 * position in 's' of the start of the next character beyond where it got
391 * to. If there were no problems, that will be 'e'. If 'stop_at_partial'
392 * is TRUE, if the final character before 'e' is incomplete, but valid as
393 * far as is available, no action will be taken on that partial character,
394 * and the return value will point to its first byte */
395
396 UV uv;
397 STRLEN ulen;
398 SV *fallback_cb;
399 IV check;
400 U8 *d;
401 STRLEN dlen;
402 char esc[UTF8_MAXLEN13 * 6 + 1];
403 STRLEN i;
404 const U32 flags = (strict)
1
Assuming 'strict' is false
→
2
←
'?' condition is false
→
405 ? UTF8_DISALLOW_ILLEGAL_INTERCHANGE((0x1000|0x0100)|0x0400)
406 : 0;
407
408 if (!SvOK(check_sv)((check_sv)->sv_flags & (0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000))) {
3
←
Assuming the condition is true
→
4
←
Taking true branch
→
409 fallback_cb = &PL_sv_undef(PL_sv_immortals[1]);
410 check = 0;
411 }
412 else if (SvROK(check_sv)((check_sv)->sv_flags & 0x00000800)) {
413 /* croak("UTF-8 decoder doesn't support callback CHECK"); */
414 fallback_cb = check_sv;
415 check = ENCODE_PERLQQ0x0100|ENCODE_LEAVE_SRC0x0008; /* same as perlqq */
416 }
417 else {
418 fallback_cb = &PL_sv_undef(PL_sv_immortals[1]);
419 check = SvIV_nomg(check_sv)(((check_sv)->sv_flags & 0x00000100) ? ((XPVIV*) (check_sv
)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags( check_sv
,0));
420 }
421
422 SvPOK_only(dst)( (dst)->sv_flags &= ~((0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)| 0x80000000
|0x20000000), (dst)->sv_flags |= (0x00000400|0x00004000));
423 SvCUR_set(dst,0)do { ((void)0); ((void)0); ((void)0); (((XPV*) (dst)->sv_any
)->xpv_cur = (0)); } while (0);
5
←
Loop condition is false. Exiting loop
→
424
425 dlen = (s && e && s < e) ? e-s+1 : 1;
6
←
Assuming 's' is null
→
426 d = (U8 *) SvGROW(dst, dlen)(((dst)->sv_flags & 0x10000000) || ((XPV*) (dst)->sv_any
)->xpv_len_u.xpvlenu_len < (dlen) ? Perl_sv_grow( dst,dlen
) : ((dst)->sv_u.svu_pv));
7
←
Assuming the condition is true
→
427
428 stop_at_partial = stop_at_partial || (check & ENCODE_STOP_AT_PARTIAL0x0800);
8
←
Assuming 'stop_at_partial' is true
→
429
430 while (s < e) {
9
←
Assuming 's' is < 'e'
→
10
←
Loop condition is true. Entering loop body
→
431
432 /* If there were no errors, this will be 'e'; otherwise it will point
433 * to the first byte of the erroneous input */
434 const U8* e_or_where_failed;
435 bool_Bool valid = is_utf8_string_loc_flags(s, e - s, &e_or_where_failed, flags)Perl_is_utf8_string_loclen_flags(s, e - s, &e_or_where_failed
, 0, flags);
436 STRLEN len = e_or_where_failed - s;
437
438 /* Copy as far as was successful */
439 Move(s, d, len, U8)((void)(__builtin_expect(((((( sizeof(size_t) < sizeof(len
) || sizeof(U8) > ((size_t)1 << 8*(sizeof(size_t) - sizeof
(len)))) ? (size_t)(len) : ((size_t)-1)/sizeof(U8)) > ((size_t
)-1)/sizeof(U8))) ? (_Bool)1 : (_Bool)0),(0)) && (Perl_croak_memory_wrap
(),0)), ((void)0), ((void)0), (void)memmove((char*)(d),(const
char*)(s), (len) * sizeof(U8)));
11
←
'?' condition is false
→
12
←
'?' condition is false
→
13
←
Null pointer passed as 2nd argument to memory copy function
440 d += len;
441 s = (U8 *) e_or_where_failed;
442
443 /* Are done if it was valid, or we are accepting partial characters and
444 * the only error is that the final bytes form a partial character */
445 if ( LIKELY(valid)__builtin_expect(((valid) ? (_Bool)1 : (_Bool)0),(1))
446 || ( stop_at_partial
447 && is_utf8_valid_partial_char_flagsPerl_is_utf8_valid_partial_char_flags(s, e, flags)))
448 {
449 break;
450 }
451
452 /* Here, was not valid. If is 'strict', and is legal extended UTF-8,
453 * we know it is a code point whose value we can calculate, just not
454 * one accepted under strict. Otherwise, it is malformed in some way.
455 * In either case, the system function can calculate either the code
456 * point, or the best substitution for it */
457 uv = utf8n_to_uvchr(s, e - s, &ulen, UTF8_ALLOW_ANY)Perl_utf8n_to_uvchr_msgs(s, e - s, &ulen, ( 0x0002 |0x0004
|0x0008 |0x0010 |0x0080), 0, 0);
458
459 /*
460 * Here, we are looping through the input and found an error.
461 * 'uv' is the code point in error if calculable, or the REPLACEMENT
462 * CHARACTER if not.
463 * 'ulen' is how many bytes of input this iteration of the loop
464 * consumes */
465
466 if (!encode && (check & (ENCODE_DIE_ON_ERR0x0001|ENCODE_WARN_ON_ERR0x0002|ENCODE_PERLQQ0x0100)))
467 for (i=0; i<ulen; ++i) sprintf(esc+4*i, "\\x%02X", s[i]);
468 if (check & ENCODE_DIE_ON_ERR0x0001){
469 if (encode)
470 Perl_croak(aTHX_ ERR_ENCODE_NOMAP"\"\\x{%04" "lx" "}\" does not map to %s", uv, (strict ? "UTF-8" : "utf8"));
471 else
472 Perl_croak(aTHX_ ERR_DECODE_STR_NOMAP"%s \"%s\" does not map to Unicode", (strict ? "UTF-8" : "utf8"), esc);
473 }
474 if (encode_ckWARN(check, WARN_UTF8)((check & 0x0002) && (!(check & 0x0010) || Perl_ckwarn
( (44 ))))) {
475 if (encode)
476 Perl_warner(aTHX_ packWARN(WARN_UTF8)(44 ),
477 ERR_ENCODE_NOMAP"\"\\x{%04" "lx" "}\" does not map to %s", uv, (strict ? "UTF-8" : "utf8"));
478 else
479 Perl_warner(aTHX_ packWARN(WARN_UTF8)(44 ),
480 ERR_DECODE_STR_NOMAP"%s \"%s\" does not map to Unicode", (strict ? "UTF-8" : "utf8"), esc);
481 }
482 if (check & ENCODE_RETURN_ON_ERR0x0004) {
483 break;
484 }
485 if (check & (ENCODE_PERLQQ0x0100|ENCODE_HTMLCREF0x0200|ENCODE_XMLCREF0x0400)){
486 STRLEN sublen;
487 char *substr;
488 SV* subchar;
489 if (encode) {
490 subchar =
491 (fallback_cb != &PL_sv_undef(PL_sv_immortals[1]))
492 ? do_fallback_cb(aTHX_ uv, fallback_cb)
493 : newSVpvfPerl_newSVpvf(check & ENCODE_PERLQQ0x0100
494 ? (ulen == 1 ? "\\x%02" UVXf"lX" : "\\x{%04" UVXf"lX" "}")
495 : check & ENCODE_HTMLCREF0x0200 ? "&#%" UVuf"lu" ";"
496 : "&#x%" UVxf"lx" ";", uv);
497 substr = SvPV(subchar, sublen)((((subchar)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((sublen = ((XPV*) (subchar)->sv_any)->xpv_cur), ((
subchar)->sv_u.svu_pv)) : Perl_sv_2pv_flags( subchar,&
sublen,2));
498 if (SvUTF8(subchar)((subchar)->sv_flags & 0x20000000) && sublen && !utf8_to_bytes((U8 *)substr, &sublen)Perl_utf8_to_bytes( (U8 *)substr,&sublen)) { /* make sure no decoded string gets in */
499 SvREFCNT_dec(subchar)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (subchar); _p; })));
500 croakPerl_croak("Wide character");
501 }
502 } else {
503 if (fallback_cb != &PL_sv_undef(PL_sv_immortals[1])) {
504 /* in decode mode we have sequence of wrong bytes */
505 subchar = do_bytes_fallback_cb(aTHX_ s, ulen, fallback_cb);
506 } else {
507 char *ptr = esc;
508 /* ENCODE_PERLQQ is already stored in esc */
509 if (check & (ENCODE_HTMLCREF0x0200|ENCODE_XMLCREF0x0400))
510 for (i=0; i<ulen; ++i) ptr += sprintf(ptr, ((check & ENCODE_HTMLCREF0x0200) ? "&#%u;" : "&#x%02X;"), s[i]);
511 subchar = newSVpvn(esc, strlen(esc))Perl_newSVpvn( esc,strlen(esc));
512 }
513 substr = SvPVutf8(subchar, sublen)((((subchar)->sv_flags & (0x00000400|0x20000000|0x00200000
)) == (0x00000400|0x20000000)) ? ((sublen = ((XPV*) (subchar)
->sv_any)->xpv_cur), ((subchar)->sv_u.svu_pv)) : Perl_sv_2pvutf8_flags
( subchar,&sublen,2));
514 }
515 dlen += sublen - ulen;
516 SvCUR_set(dst, d-(U8 *)SvPVX(dst))do { ((void)0); ((void)0); ((void)0); (((XPV*) (dst)->sv_any
)->xpv_cur = (d-(U8 *)((dst)->sv_u.svu_pv))); } while (
0);
517 *SvEND(dst)((dst)->sv_u.svu_pv + ((XPV*)(dst)->sv_any)->xpv_cur
) = '\0';
518 sv_catpvn(dst, substr, sublen)Perl_sv_catpvn_flags( dst,substr,sublen,2);
519 SvREFCNT_dec(subchar)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (subchar); _p; })));
520 d = (U8 *) SvGROW(dst, dlen)(((dst)->sv_flags & 0x10000000) || ((XPV*) (dst)->sv_any
)->xpv_len_u.xpvlenu_len < (dlen) ? Perl_sv_grow( dst,dlen
) : ((dst)->sv_u.svu_pv)) + SvCUR(dst)((XPV*) (dst)->sv_any)->xpv_cur;
521 } else {
522 STRLEN fbcharlen = strlen(FBCHAR_UTF8"\xEF\xBF\xBD");
523 dlen += fbcharlen - ulen;
524 if (SvLEN(dst)((XPV*) (dst)->sv_any)->xpv_len_u.xpvlenu_len < dlen) {
525 SvCUR_set(dst, d-(U8 *)SvPVX(dst))do { ((void)0); ((void)0); ((void)0); (((XPV*) (dst)->sv_any
)->xpv_cur = (d-(U8 *)((dst)->sv_u.svu_pv))); } while (
0);
526 d = (U8 *) sv_grow(dst, dlen)Perl_sv_grow( dst,dlen) + SvCUR(dst)((XPV*) (dst)->sv_any)->xpv_cur;
527 }
528 memcpy(d, FBCHAR_UTF8"\xEF\xBF\xBD", fbcharlen);
529 d += fbcharlen;
530 }
531 s += ulen;
532 }
533 SvCUR_set(dst, d-(U8 *)SvPVX(dst))do { ((void)0); ((void)0); ((void)0); (((XPV*) (dst)->sv_any
)->xpv_cur = (d-(U8 *)((dst)->sv_u.svu_pv))); } while (
0);
534 *SvEND(dst)((dst)->sv_u.svu_pv + ((XPV*)(dst)->sv_any)->xpv_cur
) = '\0';
535
536 return s;
537}
538
539static SV *
540find_encoding(pTHX_ SV *enc)
541{
542 dSPSV **sp = PL_stack_sp;
543 I32 count;
544 SV *m_enc;
545 SV *obj = &PL_sv_undef(PL_sv_immortals[1]);
546#ifndef SV_NOSTEAL16
547 U32 tmp;
548#endif
549
550 ENTERPerl_push_scope();
551 SAVETMPSPerl_savetmps();
552 PUSHMARK(sp)do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry
= ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool
)0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry
= (I32)((sp) - PL_stack_base); ; } while (0);
553
554 m_enc = sv_newmortal()Perl_sv_newmortal();
555#ifndef SV_NOSTEAL16
556 tmp = SvFLAGS(enc)(enc)->sv_flags & SVs_TEMP0x00080000;
557 SvTEMP_off(enc)((enc)->sv_flags &= ~0x00080000);
558 sv_setsv_flags(m_enc, enc, 0)Perl_sv_setsv_flags( m_enc,enc,0);
559 SvFLAGS(enc)(enc)->sv_flags |= tmp;
560#else
561#if SV_NOSTEAL16 == 0
562 #error You have broken SV_NOSTEAL16 which cause memory corruption in sv_setsv_flags()
563 #error Most probably broken SV_NOSTEAL16 was defined by buggy version of ppport.h
564#else
565 sv_setsv_flags(m_enc, enc, SV_NOSTEAL)Perl_sv_setsv_flags( m_enc,enc,16);
566#endif
567#endif
568 XPUSHs(m_enc)do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (m_enc); } while (0);
569
570 PUTBACKPL_stack_sp = sp;
571
572 count = call_pv("Encode::find_encoding", G_SCALAR)Perl_call_pv( "Encode::find_encoding",2);
573
574 SPAGAINsp = PL_stack_sp;
575
576 if (count > 0) {
577 obj = POPs(*sp--);
578 SvREFCNT_inc(obj)Perl_SvREFCNT_inc(((SV *)({ void *_p = (obj); _p; })));
579 }
580
581 PUTBACKPL_stack_sp = sp;
582 FREETMPSif (PL_tmps_ix > PL_tmps_floor) Perl_free_tmps();
583 LEAVEPerl_pop_scope();
584 return sv_2mortal(obj)Perl_sv_2mortal( obj);
585}
586
587static SV *
588call_encoding(pTHX_ const char *method, SV *obj, SV *src, SV *check)
589{
590 dSPSV **sp = PL_stack_sp;
591 I32 count;
592 SV *dst = &PL_sv_undef(PL_sv_immortals[1]);
593
594 PUSHMARK(sp)do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry
= ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool
)0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry
= (I32)((sp) - PL_stack_base); ; } while (0);
595
596 if (check)
597 check = sv_2mortal(newSVsv(check))Perl_sv_2mortal( Perl_newSVsv_flags( (check),2|16));
598
599 if (!check || SvROK(check)((check)->sv_flags & 0x00000800) || !SvTRUE_nomg(check)(__builtin_expect(((check) ? (_Bool)1 : (_Bool)0),(1)) &&
(( ((size_t)((check) - &(PL_sv_immortals[0])) < 4) ? (
(check) == &(PL_sv_immortals[0])) : !((check)->sv_flags
& (0x00000100|0x00000200|0x00000400|0x00000800| 0x00001000
|0x00002000|0x00004000|0x00008000)) ? 0 : ((check)->sv_flags
& 0x00000400) ? ( ((XPV*)((check))->sv_any) &&
( ((XPV*)((check))->sv_any)->xpv_cur > 1 || ( ((XPV
*)((check))->sv_any)->xpv_cur && *(check)->sv_u
.svu_pv != '0' ) ) ) : ((check)->sv_flags & 0x00000100
) ? (((XPVIV*) (check)->sv_any)->xiv_u.xivu_iv != 0 ) :
(((check)->sv_flags & 0x00000800) && !( ((((check
)->sv_u.svu_rv))->sv_flags & 0x00100000) &&
((((XPVMG*) (((check)->sv_u.svu_rv))->sv_any)->xmg_stash
)->sv_flags & 0x10000000))) ? (1) : (Perl_sv_2bool_flags
( check,0))))) || (SvIV_nomg(check)(((check)->sv_flags & 0x00000100) ? ((XPVIV*) (check)->
sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags( check,0)) & ENCODE_LEAVE_SRC0x0008))
600 src = sv_2mortal(newSVsv(src))Perl_sv_2mortal( Perl_newSVsv_flags( (src),2|16));
601
602 XPUSHs(obj)do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (obj); } while (0);
603 XPUSHs(src)do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (src); } while (0);
604 XPUSHs(check ? check : &PL_sv_no)do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (check ? check : &(PL_sv_immortals[2])); } while (
0);
605
606 PUTBACKPL_stack_sp = sp;
607
608 count = call_method(method, G_SCALAR)Perl_call_method( method,2);
609
610 SPAGAINsp = PL_stack_sp;
611
612 if (count > 0) {
613 dst = POPs(*sp--);
614 SvREFCNT_inc(dst)Perl_SvREFCNT_inc(((SV *)({ void *_p = (dst); _p; })));
615 }
616
617 PUTBACKPL_stack_sp = sp;
618 return dst;
619}
620
621
622#line 623 "Encode.c"
623#ifndef PERL_UNUSED_VAR
624# define PERL_UNUSED_VAR(var)((void)sizeof(var)) if (0) var = var
625#endif
626
627#ifndef dVARstruct Perl___notused_struct
628# define dVARstruct Perl___notused_struct dNOOPstruct Perl___notused_struct
629#endif
630
631
632/* This stuff is not part of the API! You have been warned. */
633#ifndef PERL_VERSION_DECIMAL
634# define PERL_VERSION_DECIMAL(r,v,s)(r*1000000 + v*1000 + s) (r*1000000 + v*1000 + s)
635#endif
636#ifndef PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1)
637# define PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) \
638 PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)(5*1000000 + 32*1000 + 1)
639#endif
640#ifndef PERL_VERSION_GE
641# define PERL_VERSION_GE(r,v,s)((5*1000000 + 32*1000 + 1) >= (r*1000000 + v*1000 + s)) \
642 (PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) >= PERL_VERSION_DECIMAL(r,v,s)(r*1000000 + v*1000 + s))
643#endif
644#ifndef PERL_VERSION_LE
645# define PERL_VERSION_LE(r,v,s)((5*1000000 + 32*1000 + 1) <= (r*1000000 + v*1000 + s)) \
646 (PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) <= PERL_VERSION_DECIMAL(r,v,s)(r*1000000 + v*1000 + s))
647#endif
648
649/* XS_INTERNAL is the explicit static-linkage variant of the default
650 * XS macro.
651 *
652 * XS_EXTERNAL is the same as XS_INTERNAL except it does not include
653 * "STATIC", ie. it exports XSUB symbols. You probably don't want that
654 * for anything but the BOOT XSUB.
655 *
656 * See XSUB.h in core!
657 */
658
659
660/* TODO: This might be compatible further back than 5.10.0. */
661#if PERL_VERSION_GE(5, 10, 0)((5*1000000 + 32*1000 + 1) >= (5*1000000 + 10*1000 + 0)) && PERL_VERSION_LE(5, 15, 1)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 15*1000 + 1))
662# undef XS_EXTERNAL
663# undef XS_INTERNAL
664# if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING)
665# define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) __declspec(dllexport) XSPROTO(name)void name( CV* cv __attribute__((unused)))
666# define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) STATICstatic XSPROTO(name)void name( CV* cv __attribute__((unused)))
667# endif
668# if defined(__SYMBIAN32__)
669# define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) EXPORT_C XSPROTO(name)void name( CV* cv __attribute__((unused)))
670# define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) EXPORT_C STATICstatic XSPROTO(name)void name( CV* cv __attribute__((unused)))
671# endif
672# ifndef XS_EXTERNAL
673# if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus)
674# define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) void name(pTHX_ CV* cv __attribute__unused____attribute__((unused)))
675# define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) STATICstatic void name(pTHX_ CV* cv __attribute__unused____attribute__((unused)))
676# else
677# ifdef __cplusplus
678# define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) extern "C" XSPROTO(name)void name( CV* cv __attribute__((unused)))
679# define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) static XSPROTO(name)void name( CV* cv __attribute__((unused)))
680# else
681# define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) XSPROTO(name)void name( CV* cv __attribute__((unused)))
682# define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) STATICstatic XSPROTO(name)void name( CV* cv __attribute__((unused)))
683# endif
684# endif
685# endif
686#endif
687
688/* perl >= 5.10.0 && perl <= 5.15.1 */
689
690
691/* The XS_EXTERNAL macro is used for functions that must not be static
692 * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL
693 * macro defined, the best we can do is assume XS is the same.
694 * Dito for XS_INTERNAL.
695 */
696#ifndef XS_EXTERNAL
697# define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) XS(name)void name( CV* cv __attribute__((unused)))
698#endif
699#ifndef XS_INTERNAL
700# define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) XS(name)void name( CV* cv __attribute__((unused)))
701#endif
702
703/* Now, finally, after all this mess, we want an ExtUtils::ParseXS
704 * internal macro that we're free to redefine for varying linkage due
705 * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use
706 * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to!
707 */
708
709#undef XS_EUPXS
710#if defined(PERL_EUPXS_ALWAYS_EXPORT)
711# define XS_EUPXS(name)static void name( CV* cv __attribute__((unused))) XS_EXTERNAL(name)void name( CV* cv __attribute__((unused)))
712#else
713 /* default to internal */
714# define XS_EUPXS(name)static void name( CV* cv __attribute__((unused))) XS_INTERNAL(name)static void name( CV* cv __attribute__((unused)))
715#endif
716
717#ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0)
718#define PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0) assert(cv)((void)0); assert(params)((void)0)
719
720/* prototype to pass -Wmissing-prototypes */
721STATICstatic void
722S_croak_xs_usage(const CV *const cv, const char *const params);
723
724STATICstatic void
725S_croak_xs_usage(const CV *const cv, const char *const params)
726{
727 const GV *const gv = CvGV(cv)Perl_CvGV( (CV *)(cv));
728
729 PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0);
730
731 if (gv) {
732 const char *const gvname = GvNAME(gv)((((XPVGV*)(gv)->sv_any)->xiv_u.xivu_namehek))->hek_key;
733 const HV *const stash = GvSTASH(gv)(((XPVGV*)(gv)->sv_any)->xnv_u.xgv_stash);
734 const char *const hvname = stash ? HvNAME(stash)((((stash)->sv_flags & 0x02000000) && ((struct
xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV*) (stash
)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_name &&
( ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV
*) (stash)->sv_any)->xhv_max+1]))->xhv_name_count ? *
((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV
*) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_names
: ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV
*) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_name
)) ? (( ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash
)[((XPVHV*) (stash)->sv_any)->xhv_max+1]))->xhv_name_count
? *((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV
*) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_names
: ((struct xpvhv_aux*)&(((stash)->sv_u.svu_hash)[((XPVHV
*) (stash)->sv_any)->xhv_max+1]))->xhv_name_u.xhvnameu_name
))->hek_key : ((void*)0)) : NULL((void*)0);
735
736 if (hvname)
737 Perl_croak_nocontextPerl_croak("Usage: %s::%s(%s)", hvname, gvname, params);
738 else
739 Perl_croak_nocontextPerl_croak("Usage: %s(%s)", gvname, params);
740 } else {
741 /* Pants. I don't think that it should be possible to get here. */
742 Perl_croak_nocontextPerl_croak("Usage: CODE(0x%" UVxf"lx" ")(%s)", PTR2UV(cv)(UV)(cv), params);
743 }
744}
745#undef PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0)
746
747#define croak_xs_usagePerl_croak_xs_usage S_croak_xs_usage
748
749#endif
750
751/* NOTE: the prototype of newXSproto() is different in versions of perls,
752 * so we define a portable version of newXSproto()
753 */
754#ifdef newXS_flags
755#define newXSproto_portable(name, c_impl, file, proto)Perl_newXS_flags( name,c_impl,file,proto,0) newXS_flags(name, c_impl, file, proto, 0)Perl_newXS_flags( name,c_impl,file,proto,0)
756#else
757#define newXSproto_portable(name, c_impl, file, proto)Perl_newXS_flags( name,c_impl,file,proto,0) (PL_Sv=(SV*)newXS(name, c_impl, file)Perl_newXS( name,c_impl,file), sv_setpv(PL_Sv, proto)Perl_sv_setpv( PL_Sv,proto), (CV*)PL_Sv)
758#endif /* !defined(newXS_flags) */
759
760#if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5))
761# define newXS_deffile(a,b)Perl_newXS_deffile( a,b) Perl_newXS(aTHX_ a,b,file)
762#else
763# define newXS_deffile(a,b)Perl_newXS_deffile( a,b) Perl_newXS_deffile(aTHX_ a,b)
764#endif
765
766#line 767 "Encode.c"
767
768XS_EUPXS(XS_Encode__utf8_decode)static void XS_Encode__utf8_decode( CV* cv __attribute__((unused
))); /* prototype to pass -Wmissing-prototypes */
769XS_EUPXS(XS_Encode__utf8_decode)static void XS_Encode__utf8_decode( CV* cv __attribute__((unused
)))
770{
771 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
772 if (items < 2 || items > 3)
773 croak_xs_usagePerl_croak_xs_usage(cv, "obj, src, check_sv = &PL_sv_no");
774 PERL_UNUSED_VAR(ax)((void)sizeof(ax)); /* -Wall */
775 SPsp -= items;
776 {
777 SV * obj = ST(0)PL_stack_base[ax + (0)]
778;
779 SV * src = ST(1)PL_stack_base[ax + (1)]
780;
781 SV * check_sv;
782#line 623 "Encode.xs"
783 STRLEN slen;
784 U8 *s;
785 U8 *e;
786 SV *dst;
787 bool_Bool renewed = 0;
788 IV check;
789 bool_Bool modify;
790 dSPSV **sp = PL_stack_sp;
791#line 792 "Encode.c"
792
793 if (items < 3)
794 check_sv = &PL_sv_no(PL_sv_immortals[2]);
795 else {
796 check_sv = ST(2)PL_stack_base[ax + (2)]
797;
798 }
799#line 632 "Encode.xs"
800 SvGETMAGIC(src)((void)(__builtin_expect(((((src)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( src)));
801 SvGETMAGIC(check_sv)((void)(__builtin_expect(((((check_sv)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( check_sv
)));
802 check = SvROK(check_sv)((check_sv)->sv_flags & 0x00000800) ? ENCODE_PERLQQ0x0100|ENCODE_LEAVE_SRC0x0008 : SvOK(check_sv)((check_sv)->sv_flags & (0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)) ? SvIV_nomg(check_sv)(((check_sv)->sv_flags & 0x00000100) ? ((XPVIV*) (check_sv
)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags( check_sv
,0)) : 0;
803 modify = (check && !(check & ENCODE_LEAVE_SRC0x0008));
804#line 805 "Encode.c"
805#line 637 "Encode.xs"
806 if (!SvOK(src)((src)->sv_flags & (0x00000100|0x00000200|0x00000400|0x00000800
| 0x00001000|0x00002000|0x00004000|0x00008000)))
807 XSRETURN_UNDEFdo { (PL_stack_base[ax + (0)] = &(PL_sv_immortals[1])); do
{ const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0); } while (0);
808 s = modify ? (U8 *)SvPV_force_nomg(src, slen)((((src)->sv_flags & (0x00000400|0x00000100|0x00000200
|0x00000800|0x00008000|(0x08000000|0x00010000|0x00000800|0x01000000
|0x00800000|0x10000000)|0x00200000)) == 0x00000400) ? ((slen
= ((XPV*) (src)->sv_any)->xpv_cur), ((src)->sv_u.svu_pv
)) : Perl_sv_pvn_force_flags( src,&slen,0)) : (U8 *)SvPV_nomg(src, slen)((((src)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((slen = ((XPV*) (src)->sv_any)->xpv_cur), ((src)->
sv_u.svu_pv)) : Perl_sv_2pv_flags( src,&slen,0));
809 if (SvUTF8(src)((src)->sv_flags & 0x20000000))
810 utf8_safe_downgrade(aTHX_ &src, &s, &slen, modify);
811 e = s+slen;
812
813 /*
814 * PerlIO check -- we assume the object is of PerlIO if renewed
815 */
816 ENTERPerl_push_scope(); SAVETMPSPerl_savetmps();
817 PUSHMARK(sp)do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry
= ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool
)0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry
= (I32)((sp) - PL_stack_base); ; } while (0);
818 XPUSHs(obj)do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (obj); } while (0);
819 PUTBACKPL_stack_sp = sp;
820 if (call_method("renewed",G_SCALAR)Perl_call_method( "renewed",2) == 1) {
821 SPAGAINsp = PL_stack_sp;
822 renewed = (bool_Bool)POPi((IV)({SV *_sv = ((SV *)({ void *_p = ((*sp--)); _p; })); (((
(_sv)->sv_flags & (0x00000100|0x00200000)) == 0x00000100
) ? ((XPVIV*) (_sv)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags
( _sv,2)); }));
823 PUTBACKPL_stack_sp = sp;
824#if 0
825 fprintf(stderr(&__sF[2]), "renewed == %d\n", renewed);
826#endif
827 }
828 FREETMPSif (PL_tmps_ix > PL_tmps_floor) Perl_free_tmps(); LEAVEPerl_pop_scope();
829 /* end PerlIO check */
830
831 dst = sv_2mortal(newSV(slen>0?slen:1))Perl_sv_2mortal( Perl_newSV( slen>0?slen:1)); /* newSV() abhors 0 -- inaba */
832 s = process_utf8(aTHX_ dst, s, e, check_sv, 0, strict_utf8(aTHX_ obj), renewed);
833
834 /* Clear out translated part of source unless asked not to */
835 if (modify) {
836 slen = e-s;
837 sv_setpvn(src, (char*)s, slen)Perl_sv_setpvn( src,(char*)s,slen);
838 SvSETMAGIC(src)do { if (__builtin_expect(((((src)->sv_flags & 0x00400000
)) ? (_Bool)1 : (_Bool)0),(0))) Perl_mg_set( src); } while (0
);
839 }
840 SvUTF8_on(dst)((dst)->sv_flags |= (0x20000000));
841 if (SvTAINTED(src)(((src)->sv_flags & (0x00200000|0x00400000|0x00800000)
) && Perl_sv_tainted( src))) SvTAINTED_on(dst)do{ if(__builtin_expect((((((__builtin_expect(((PL_tainting) ?
(_Bool)1 : (_Bool)0),(0))) ? (_Bool)1 : (_Bool)0))) ? (_Bool
)1 : (_Bool)0),(0))){Perl_sv_magic( (dst),((void*)0),'t',((void
*)0),0);} }while (0); /* propagate taintedness */
842 ST(0)PL_stack_base[ax + (0)] = dst;
843 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
844#line 845 "Encode.c"
845 PUTBACKPL_stack_sp = sp;
846 return;
847 }
848}
849
850
851XS_EUPXS(XS_Encode__utf8_encode)static void XS_Encode__utf8_encode( CV* cv __attribute__((unused
))); /* prototype to pass -Wmissing-prototypes */
852XS_EUPXS(XS_Encode__utf8_encode)static void XS_Encode__utf8_encode( CV* cv __attribute__((unused
)))
853{
854 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
855 if (items < 2 || items > 3)
856 croak_xs_usagePerl_croak_xs_usage(cv, "obj, src, check_sv = &PL_sv_no");
857 PERL_UNUSED_VAR(ax)((void)sizeof(ax)); /* -Wall */
858 SPsp -= items;
859 {
860 SV * obj = ST(0)PL_stack_base[ax + (0)]
861;
862 SV * src = ST(1)PL_stack_base[ax + (1)]
863;
864 SV * check_sv;
865#line 682 "Encode.xs"
866 STRLEN slen;
867 U8 *s;
868 U8 *e;
869 SV *dst;
870 IV check;
871 bool_Bool modify;
872#line 873 "Encode.c"
873
874 if (items < 3)
875 check_sv = &PL_sv_no(PL_sv_immortals[2]);
876 else {
877 check_sv = ST(2)PL_stack_base[ax + (2)]
878;
879 }
880#line 689 "Encode.xs"
881 SvGETMAGIC(src)((void)(__builtin_expect(((((src)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( src)));
882 SvGETMAGIC(check_sv)((void)(__builtin_expect(((((check_sv)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( check_sv
)));
883 check = SvROK(check_sv)((check_sv)->sv_flags & 0x00000800) ? ENCODE_PERLQQ0x0100|ENCODE_LEAVE_SRC0x0008 : SvOK(check_sv)((check_sv)->sv_flags & (0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)) ? SvIV_nomg(check_sv)(((check_sv)->sv_flags & 0x00000100) ? ((XPVIV*) (check_sv
)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags( check_sv
,0)) : 0;
884 modify = (check && !(check & ENCODE_LEAVE_SRC0x0008));
885#line 886 "Encode.c"
886#line 694 "Encode.xs"
887 if (!SvOK(src)((src)->sv_flags & (0x00000100|0x00000200|0x00000400|0x00000800
| 0x00001000|0x00002000|0x00004000|0x00008000)))
888 XSRETURN_UNDEFdo { (PL_stack_base[ax + (0)] = &(PL_sv_immortals[1])); do
{ const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0); } while (0);
889 s = modify ? (U8 *)SvPV_force_nomg(src, slen)((((src)->sv_flags & (0x00000400|0x00000100|0x00000200
|0x00000800|0x00008000|(0x08000000|0x00010000|0x00000800|0x01000000
|0x00800000|0x10000000)|0x00200000)) == 0x00000400) ? ((slen
= ((XPV*) (src)->sv_any)->xpv_cur), ((src)->sv_u.svu_pv
)) : Perl_sv_pvn_force_flags( src,&slen,0)) : (U8 *)SvPV_nomg(src, slen)((((src)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((slen = ((XPV*) (src)->sv_any)->xpv_cur), ((src)->
sv_u.svu_pv)) : Perl_sv_2pv_flags( src,&slen,0));
890 e = s+slen;
891 dst = sv_2mortal(newSV(slen>0?slen:1))Perl_sv_2mortal( Perl_newSV( slen>0?slen:1)); /* newSV() abhors 0 -- inaba */
892 if (SvUTF8(src)((src)->sv_flags & 0x20000000)) {
893 /* Already encoded */
894 if (strict_utf8(aTHX_ obj)) {
895 s = process_utf8(aTHX_ dst, s, e, check_sv, 1, 1, 0);
896 }
897 else {
898 /* trust it and just copy the octets */
899 sv_setpvn(dst,(char *)s,(e-s))Perl_sv_setpvn( dst,(char *)s,(e-s));
900 s = e;
901 }
902 }
903 else {
904 /* Native bytes - can always encode */
905 U8 *d = (U8 *) SvGROW(dst, 2*slen+1)(((dst)->sv_flags & 0x10000000) || ((XPV*) (dst)->sv_any
)->xpv_len_u.xpvlenu_len < (2*slen+1) ? Perl_sv_grow( dst
,2*slen+1) : ((dst)->sv_u.svu_pv)); /* +1 or assertion will botch */
906 while (s < e) {
907#ifdef append_utf8_from_native_byte
908 append_utf8_from_native_byte(*s, &d);
909 s++;
910#else
911 UV uv = NATIVE_TO_UNI((UV) *s)((UV) (((UV) *s) | 0));
912 s++; /* Above expansion of NATIVE_TO_UNI() is safer this way. */
913 if (UNI_IS_INVARIANT(uv)((((U64)(((UV) ((uv) | 0)))) < (((U8) (0xFF << 6)) &
0xB0))))
914 *d++ = (U8)UTF_TO_NATIVE(uv)( ((U8) ((uv) | 0)));
915 else {
916 *d++ = (U8)UTF8_EIGHT_BIT_HI(uv)( ( ( ( ((U8) (((( ((U8) ((uv) | 0))) >> 6) | (((2) >
7) ? 0xFF : ((U8) (0xFE << (7-(2)))))) | 0))))));
917 *d++ = (U8)UTF8_EIGHT_BIT_LO(uv)( (( ( ((U8) (((( ((U8) ((uv) | 0))) & ((U8) ((1U <<
6) - 1))) | (((U8) (0xFF << 6)) & 0xB0)) | 0))))));
918 }
919#endif
920 }
921 SvCUR_set(dst, d- (U8 *)SvPVX(dst))do { ((void)0); ((void)0); ((void)0); (((XPV*) (dst)->sv_any
)->xpv_cur = (d- (U8 *)((dst)->sv_u.svu_pv))); } while (
0);
922 *SvEND(dst)((dst)->sv_u.svu_pv + ((XPV*)(dst)->sv_any)->xpv_cur
) = '\0';
923 }
924
925 /* Clear out translated part of source unless asked not to */
926 if (modify) {
927 slen = e-s;
928 sv_setpvn(src, (char*)s, slen)Perl_sv_setpvn( src,(char*)s,slen);
929 SvSETMAGIC(src)do { if (__builtin_expect(((((src)->sv_flags & 0x00400000
)) ? (_Bool)1 : (_Bool)0),(0))) Perl_mg_set( src); } while (0
);
930 }
931 SvPOK_only(dst)( (dst)->sv_flags &= ~((0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)| 0x80000000
|0x20000000), (dst)->sv_flags |= (0x00000400|0x00004000));
932 SvUTF8_off(dst)((dst)->sv_flags &= ~(0x20000000));
933 if (SvTAINTED(src)(((src)->sv_flags & (0x00200000|0x00400000|0x00800000)
) && Perl_sv_tainted( src))) SvTAINTED_on(dst)do{ if(__builtin_expect((((((__builtin_expect(((PL_tainting) ?
(_Bool)1 : (_Bool)0),(0))) ? (_Bool)1 : (_Bool)0))) ? (_Bool
)1 : (_Bool)0),(0))){Perl_sv_magic( (dst),((void*)0),'t',((void
*)0),0);} }while (0); /* propagate taintedness */
934 ST(0)PL_stack_base[ax + (0)] = dst;
935 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
936#line 937 "Encode.c"
937 PUTBACKPL_stack_sp = sp;
938 return;
939 }
940}
941
942
943XS_EUPXS(XS_Encode__XS_renew)static void XS_Encode__XS_renew( CV* cv __attribute__((unused
))); /* prototype to pass -Wmissing-prototypes */
944XS_EUPXS(XS_Encode__XS_renew)static void XS_Encode__XS_renew( CV* cv __attribute__((unused
)))
945{
946 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
947 if (items != 1)
948 croak_xs_usagePerl_croak_xs_usage(cv, "obj");
949 {
950 SV * obj = ST(0)PL_stack_base[ax + (0)]
951;
952 SV * RETVAL;
953#line 752 "Encode.xs"
954 PERL_UNUSED_VAR(obj)((void)sizeof(obj));
955 RETVAL = newSVsv(obj)Perl_newSVsv_flags( (obj),2|16);
956#line 957 "Encode.c"
957 RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL);
958 ST(0)PL_stack_base[ax + (0)] = RETVAL;
959 }
960 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
961}
962
963
964XS_EUPXS(XS_Encode__XS_renewed)static void XS_Encode__XS_renewed( CV* cv __attribute__((unused
))); /* prototype to pass -Wmissing-prototypes */
965XS_EUPXS(XS_Encode__XS_renewed)static void XS_Encode__XS_renewed( CV* cv __attribute__((unused
)))
966{
967 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
968 if (items != 1)
969 croak_xs_usagePerl_croak_xs_usage(cv, "obj");
970 {
971 SV * obj = ST(0)PL_stack_base[ax + (0)]
972;
973 int RETVAL;
974 dXSTARGSV * const targ = ((PL_op->op_private & 0x04) ? (PL_curpad
[PL_op->op_targ]) : Perl_sv_newmortal());
975#line 761 "Encode.xs"
976 RETVAL = 0;
977 PERL_UNUSED_VAR(obj)((void)sizeof(obj));
978#line 979 "Encode.c"
979 XSprePUSH(sp = PL_stack_base + ax - 1); PUSHi((IV)RETVAL)do { do { IV TARGi_iv = (IV)RETVAL; if (__builtin_expect(((((
(targ)->sv_flags & (0xff|(0x08000000|0x00010000|0x00000800
|0x01000000 |0x00800000|0x10000000)|0x80000000)) == SVt_IV) &
(1 ? !(((__builtin_expect(((PL_tainted) ? (_Bool)1 : (_Bool)
0),(0))) ? (_Bool)1 : (_Bool)0)) : 1)) ? (_Bool)1 : (_Bool)0)
,(1))) { ((void)0); (targ)->sv_flags |= (0x00000100|0x00001000
); targ->sv_u.svu_iv = TARGi_iv; } else Perl_sv_setiv_mg( targ
,TARGi_iv); } while (0); (*++sp = (targ)); } while (0);
980 }
981 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
982}
983
984
985XS_EUPXS(XS_Encode__XS_name)static void XS_Encode__XS_name( CV* cv __attribute__((unused)
)); /* prototype to pass -Wmissing-prototypes */
986XS_EUPXS(XS_Encode__XS_name)static void XS_Encode__XS_name( CV* cv __attribute__((unused)
))
987{
988 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
989 if (items != 1)
990 croak_xs_usagePerl_croak_xs_usage(cv, "obj");
991 {
992 SV * obj = ST(0)PL_stack_base[ax + (0)]
993;
994#line 770 "Encode.xs"
995 encode_t *enc;
996#line 997 "Encode.c"
997 SV * RETVAL;
998#line 772 "Encode.xs"
999 enc = INT2PTR(encode_t *, SvIV(SvRV(obj)))(encode_t *)(((((((obj)->sv_u.svu_rv))->sv_flags & (
0x00000100|0x00200000)) == 0x00000100) ? ((XPVIV*) (((obj)->
sv_u.svu_rv))->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags
( ((obj)->sv_u.svu_rv),2)));
1000#line 1001 "Encode.c"
1001#line 774 "Encode.xs"
1002 RETVAL = newSVpvn(enc->name[0], strlen(enc->name[0]))Perl_newSVpvn( enc->name[0],strlen(enc->name[0]));
1003#line 1004 "Encode.c"
1004 RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL);
1005 ST(0)PL_stack_base[ax + (0)] = RETVAL;
1006 }
1007 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
1008}
1009
1010
1011XS_EUPXS(XS_Encode__XS_cat_decode)static void XS_Encode__XS_cat_decode( CV* cv __attribute__((unused
))); /* prototype to pass -Wmissing-prototypes */
1012XS_EUPXS(XS_Encode__XS_cat_decode)static void XS_Encode__XS_cat_decode( CV* cv __attribute__((unused
)))
1013{
1014 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1015 if (items < 5 || items > 6)
1016 croak_xs_usagePerl_croak_xs_usage(cv, "obj, dst, src, off, term, check_sv = &PL_sv_no");
1017 {
1018 SV * obj = ST(0)PL_stack_base[ax + (0)]
1019;
1020 SV * dst = ST(1)PL_stack_base[ax + (1)]
1021;
1022 SV * src = ST(2)PL_stack_base[ax + (2)]
1023;
1024 SV * off = ST(3)PL_stack_base[ax + (3)]
1025;
1026 SV * term = ST(4)PL_stack_base[ax + (4)]
1027;
1028 SV * check_sv;
1029#line 787 "Encode.xs"
1030 IV check;
1031 SV *fallback_cb;
1032 bool_Bool modify;
1033 encode_t *enc;
1034 STRLEN offset;
1035 int code = 0;
1036 U8 *s;
1037 STRLEN slen;
1038 SV *tmp;
1039#line 1040 "Encode.c"
1040 bool_Bool RETVAL;
1041
1042 if (items < 6)
1043 check_sv = &PL_sv_no(PL_sv_immortals[2]);
1044 else {
1045 check_sv = ST(5)PL_stack_base[ax + (5)]
1046;
1047 }
1048#line 797 "Encode.xs"
1049 SvGETMAGIC(src)((void)(__builtin_expect(((((src)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( src)));
1050 SvGETMAGIC(check_sv)((void)(__builtin_expect(((((check_sv)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( check_sv
)));
1051 check = SvROK(check_sv)((check_sv)->sv_flags & 0x00000800) ? ENCODE_PERLQQ0x0100|ENCODE_LEAVE_SRC0x0008 : SvOK(check_sv)((check_sv)->sv_flags & (0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)) ? SvIV_nomg(check_sv)(((check_sv)->sv_flags & 0x00000100) ? ((XPVIV*) (check_sv
)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags( check_sv
,0)) : 0;
1052 fallback_cb = SvROK(check_sv)((check_sv)->sv_flags & 0x00000800) ? check_sv : &PL_sv_undef(PL_sv_immortals[1]);
1053 modify = (check && !(check & ENCODE_LEAVE_SRC0x0008));
1054 enc = INT2PTR(encode_t *, SvIV(SvRV(obj)))(encode_t *)(((((((obj)->sv_u.svu_rv))->sv_flags & (
0x00000100|0x00200000)) == 0x00000100) ? ((XPVIV*) (((obj)->
sv_u.svu_rv))->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags
( ((obj)->sv_u.svu_rv),2)));
1055 offset = (STRLEN)SvIV(off)((((off)->sv_flags & (0x00000100|0x00200000)) == 0x00000100
) ? ((XPVIV*) (off)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags
( off,2));
1056#line 1057 "Encode.c"
1057#line 805 "Encode.xs"
1058 if (!SvOK(src)((src)->sv_flags & (0x00000100|0x00000200|0x00000400|0x00000800
| 0x00001000|0x00002000|0x00004000|0x00008000)))
1059 XSRETURN_NOdo { (PL_stack_base[ax + (0)] = &(PL_sv_immortals[2]) ); do
{ const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0); } while (0);
1060 s = modify ? (U8 *)SvPV_force_nomg(src, slen)((((src)->sv_flags & (0x00000400|0x00000100|0x00000200
|0x00000800|0x00008000|(0x08000000|0x00010000|0x00000800|0x01000000
|0x00800000|0x10000000)|0x00200000)) == 0x00000400) ? ((slen
= ((XPV*) (src)->sv_any)->xpv_cur), ((src)->sv_u.svu_pv
)) : Perl_sv_pvn_force_flags( src,&slen,0)) : (U8 *)SvPV_nomg(src, slen)((((src)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((slen = ((XPV*) (src)->sv_any)->xpv_cur), ((src)->
sv_u.svu_pv)) : Perl_sv_2pv_flags( src,&slen,0));
1061 if (SvUTF8(src)((src)->sv_flags & 0x20000000))
1062 utf8_safe_downgrade(aTHX_ &src, &s, &slen, modify);
1063 tmp = encode_method(aTHX_ enc, enc->t_utf8, src, s, slen, check,
1064 &offset, term, &code, fallback_cb);
1065 sv_catsv(dst, tmp)Perl_sv_catsv_flags( dst,tmp,2);
1066 SvREFCNT_dec(tmp)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (tmp); _p; })));
1067 SvIV_set(off, (IV)offset)do { ((void)0); ((void)0); (((XPVIV*) (off)->sv_any)->xiv_u
.xivu_iv = ((IV)offset)); } while (0);
1068 RETVAL = (code == ENCODE_FOUND_TERM5);
1069#line 1070 "Encode.c"
1070 ST(0)PL_stack_base[ax + (0)] = boolSV(RETVAL)((RETVAL) ? &(PL_sv_immortals[0]) : &(PL_sv_immortals
[2]));
1071 }
1072 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
1073}
1074
1075
1076XS_EUPXS(XS_Encode__XS_decode)static void XS_Encode__XS_decode( CV* cv __attribute__((unused
))); /* prototype to pass -Wmissing-prototypes */
1077XS_EUPXS(XS_Encode__XS_decode)static void XS_Encode__XS_decode( CV* cv __attribute__((unused
)))
1078{
1079 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1080 if (items < 2 || items > 3)
1081 croak_xs_usagePerl_croak_xs_usage(cv, "obj, src, check_sv = &PL_sv_no");
1082 {
1083 SV * obj = ST(0)PL_stack_base[ax + (0)]
1084;
1085 SV * src = ST(1)PL_stack_base[ax + (1)]
1086;
1087 SV * check_sv;
1088#line 825 "Encode.xs"
1089 IV check;
1090 SV *fallback_cb;
1091 bool_Bool modify;
1092 encode_t *enc;
1093 U8 *s;
1094 STRLEN slen;
1095#line 1096 "Encode.c"
1096 SV * RETVAL;
1097
1098 if (items < 3)
1099 check_sv = &PL_sv_no(PL_sv_immortals[2]);
1100 else {
1101 check_sv = ST(2)PL_stack_base[ax + (2)]
1102;
1103 }
1104#line 832 "Encode.xs"
1105 SvGETMAGIC(src)((void)(__builtin_expect(((((src)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( src)));
1106 SvGETMAGIC(check_sv)((void)(__builtin_expect(((((check_sv)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( check_sv
)));
1107 check = SvROK(check_sv)((check_sv)->sv_flags & 0x00000800) ? ENCODE_PERLQQ0x0100|ENCODE_LEAVE_SRC0x0008 : SvOK(check_sv)((check_sv)->sv_flags & (0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)) ? SvIV_nomg(check_sv)(((check_sv)->sv_flags & 0x00000100) ? ((XPVIV*) (check_sv
)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags( check_sv
,0)) : 0;
1108 fallback_cb = SvROK(check_sv)((check_sv)->sv_flags & 0x00000800) ? check_sv : &PL_sv_undef(PL_sv_immortals[1]);
1109 modify = (check && !(check & ENCODE_LEAVE_SRC0x0008));
1110 enc = INT2PTR(encode_t *, SvIV(SvRV(obj)))(encode_t *)(((((((obj)->sv_u.svu_rv))->sv_flags & (
0x00000100|0x00200000)) == 0x00000100) ? ((XPVIV*) (((obj)->
sv_u.svu_rv))->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags
( ((obj)->sv_u.svu_rv),2)));
1111#line 1112 "Encode.c"
1112#line 839 "Encode.xs"
1113 if (!SvOK(src)((src)->sv_flags & (0x00000100|0x00000200|0x00000400|0x00000800
| 0x00001000|0x00002000|0x00004000|0x00008000)))
1114 XSRETURN_UNDEFdo { (PL_stack_base[ax + (0)] = &(PL_sv_immortals[1])); do
{ const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0); } while (0);
1115 s = modify ? (U8 *)SvPV_force_nomg(src, slen)((((src)->sv_flags & (0x00000400|0x00000100|0x00000200
|0x00000800|0x00008000|(0x08000000|0x00010000|0x00000800|0x01000000
|0x00800000|0x10000000)|0x00200000)) == 0x00000400) ? ((slen
= ((XPV*) (src)->sv_any)->xpv_cur), ((src)->sv_u.svu_pv
)) : Perl_sv_pvn_force_flags( src,&slen,0)) : (U8 *)SvPV_nomg(src, slen)((((src)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((slen = ((XPV*) (src)->sv_any)->xpv_cur), ((src)->
sv_u.svu_pv)) : Perl_sv_2pv_flags( src,&slen,0));
1116 if (SvUTF8(src)((src)->sv_flags & 0x20000000))
1117 utf8_safe_downgrade(aTHX_ &src, &s, &slen, modify);
1118 RETVAL = encode_method(aTHX_ enc, enc->t_utf8, src, s, slen, check,
1119 NULL((void*)0), Nullsv((SV*)((void*)0)), NULL((void*)0), fallback_cb);
1120 SvUTF8_on(RETVAL)((RETVAL)->sv_flags |= (0x20000000));
1121#line 1122 "Encode.c"
1122 RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL);
1123 ST(0)PL_stack_base[ax + (0)] = RETVAL;
1124 }
1125 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
1126}
1127
1128
1129XS_EUPXS(XS_Encode__XS_encode)static void XS_Encode__XS_encode( CV* cv __attribute__((unused
))); /* prototype to pass -Wmissing-prototypes */
1130XS_EUPXS(XS_Encode__XS_encode)static void XS_Encode__XS_encode( CV* cv __attribute__((unused
)))
1131{
1132 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1133 if (items < 2 || items > 3)
1134 croak_xs_usagePerl_croak_xs_usage(cv, "obj, src, check_sv = &PL_sv_no");
1135 {
1136 SV * obj = ST(0)PL_stack_base[ax + (0)]
1137;
1138 SV * src = ST(1)PL_stack_base[ax + (1)]
1139;
1140 SV * check_sv;
1141#line 856 "Encode.xs"
1142 IV check;
1143 SV *fallback_cb;
1144 bool_Bool modify;
1145 encode_t *enc;
1146 U8 *s;
1147 STRLEN slen;
1148#line 1149 "Encode.c"
1149 SV * RETVAL;
1150
1151 if (items < 3)
1152 check_sv = &PL_sv_no(PL_sv_immortals[2]);
1153 else {
1154 check_sv = ST(2)PL_stack_base[ax + (2)]
1155;
1156 }
1157#line 863 "Encode.xs"
1158 SvGETMAGIC(src)((void)(__builtin_expect(((((src)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( src)));
1159 SvGETMAGIC(check_sv)((void)(__builtin_expect(((((check_sv)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( check_sv
)));
1160 check = SvROK(check_sv)((check_sv)->sv_flags & 0x00000800) ? ENCODE_PERLQQ0x0100|ENCODE_LEAVE_SRC0x0008 : SvOK(check_sv)((check_sv)->sv_flags & (0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)) ? SvIV_nomg(check_sv)(((check_sv)->sv_flags & 0x00000100) ? ((XPVIV*) (check_sv
)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags( check_sv
,0)) : 0;
1161 fallback_cb = SvROK(check_sv)((check_sv)->sv_flags & 0x00000800) ? check_sv : &PL_sv_undef(PL_sv_immortals[1]);
1162 modify = (check && !(check & ENCODE_LEAVE_SRC0x0008));
1163 enc = INT2PTR(encode_t *, SvIV(SvRV(obj)))(encode_t *)(((((((obj)->sv_u.svu_rv))->sv_flags & (
0x00000100|0x00200000)) == 0x00000100) ? ((XPVIV*) (((obj)->
sv_u.svu_rv))->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags
( ((obj)->sv_u.svu_rv),2)));
1164#line 1165 "Encode.c"
1165#line 870 "Encode.xs"
1166 if (!SvOK(src)((src)->sv_flags & (0x00000100|0x00000200|0x00000400|0x00000800
| 0x00001000|0x00002000|0x00004000|0x00008000)))
1167 XSRETURN_UNDEFdo { (PL_stack_base[ax + (0)] = &(PL_sv_immortals[1])); do
{ const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0); } while (0);
1168 s = modify ? (U8 *)SvPV_force_nomg(src, slen)((((src)->sv_flags & (0x00000400|0x00000100|0x00000200
|0x00000800|0x00008000|(0x08000000|0x00010000|0x00000800|0x01000000
|0x00800000|0x10000000)|0x00200000)) == 0x00000400) ? ((slen
= ((XPV*) (src)->sv_any)->xpv_cur), ((src)->sv_u.svu_pv
)) : Perl_sv_pvn_force_flags( src,&slen,0)) : (U8 *)SvPV_nomg(src, slen)((((src)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((slen = ((XPV*) (src)->sv_any)->xpv_cur), ((src)->
sv_u.svu_pv)) : Perl_sv_2pv_flags( src,&slen,0));
1169 if (!SvUTF8(src)((src)->sv_flags & 0x20000000))
1170 utf8_safe_upgrade(aTHX_ &src, &s, &slen, modify);
1171 RETVAL = encode_method(aTHX_ enc, enc->f_utf8, src, s, slen, check,
1172 NULL((void*)0), Nullsv((SV*)((void*)0)), NULL((void*)0), fallback_cb);
1173#line 1174 "Encode.c"
1174 RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL);
1175 ST(0)PL_stack_base[ax + (0)] = RETVAL;
1176 }
1177 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
1178}
1179
1180
1181XS_EUPXS(XS_Encode__XS_needs_lines)static void XS_Encode__XS_needs_lines( CV* cv __attribute__((
unused))); /* prototype to pass -Wmissing-prototypes */
1182XS_EUPXS(XS_Encode__XS_needs_lines)static void XS_Encode__XS_needs_lines( CV* cv __attribute__((
unused)))
1183{
1184 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1185 if (items != 1)
1186 croak_xs_usagePerl_croak_xs_usage(cv, "obj");
1187 {
1188 SV * obj = ST(0)PL_stack_base[ax + (0)]
1189;
1190 bool_Bool RETVAL;
1191#line 884 "Encode.xs"
1192 PERL_UNUSED_VAR(obj)((void)sizeof(obj));
1193 RETVAL = FALSE(0);
1194#line 1195 "Encode.c"
1195 ST(0)PL_stack_base[ax + (0)] = boolSV(RETVAL)((RETVAL) ? &(PL_sv_immortals[0]) : &(PL_sv_immortals
[2]));
1196 }
1197 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
1198}
1199
1200
1201XS_EUPXS(XS_Encode__XS_perlio_ok)static void XS_Encode__XS_perlio_ok( CV* cv __attribute__((unused
))); /* prototype to pass -Wmissing-prototypes */
1202XS_EUPXS(XS_Encode__XS_perlio_ok)static void XS_Encode__XS_perlio_ok( CV* cv __attribute__((unused
)))
1203{
1204 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1205 if (items != 1)
1206 croak_xs_usagePerl_croak_xs_usage(cv, "obj");
1207 {
1208 SV * obj = ST(0)PL_stack_base[ax + (0)]
1209;
1210#line 893 "Encode.xs"
1211 SV *sv;
1212#line 1213 "Encode.c"
1213 bool_Bool RETVAL;
1214#line 895 "Encode.xs"
1215 PERL_UNUSED_VAR(obj)((void)sizeof(obj));
1216 sv = eval_pv("require PerlIO::encoding", 0)Perl_eval_pv( "require PerlIO::encoding",0);
1217 RETVAL = SvTRUE(sv)Perl_SvTRUE( sv);
1218#line 1219 "Encode.c"
1219 ST(0)PL_stack_base[ax + (0)] = boolSV(RETVAL)((RETVAL) ? &(PL_sv_immortals[0]) : &(PL_sv_immortals
[2]));
1220 }
1221 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
1222}
1223
1224
1225XS_EUPXS(XS_Encode__XS_mime_name)static void XS_Encode__XS_mime_name( CV* cv __attribute__((unused
))); /* prototype to pass -Wmissing-prototypes */
1226XS_EUPXS(XS_Encode__XS_mime_name)static void XS_Encode__XS_mime_name( CV* cv __attribute__((unused
)))
1227{
1228 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1229 if (items != 1)
1230 croak_xs_usagePerl_croak_xs_usage(cv, "obj");
1231 {
1232 SV * obj = ST(0)PL_stack_base[ax + (0)]
1233;
1234#line 905 "Encode.xs"
1235 encode_t *enc;
1236#line 1237 "Encode.c"
1237 SV * RETVAL;
1238#line 907 "Encode.xs"
1239 enc = INT2PTR(encode_t *, SvIV(SvRV(obj)))(encode_t *)(((((((obj)->sv_u.svu_rv))->sv_flags & (
0x00000100|0x00200000)) == 0x00000100) ? ((XPVIV*) (((obj)->
sv_u.svu_rv))->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags
( ((obj)->sv_u.svu_rv),2)));
1240#line 1241 "Encode.c"
1241#line 909 "Encode.xs"
1242 ENTERPerl_push_scope();
1243 SAVETMPSPerl_savetmps();
1244 PUSHMARK(sp)do { I32 * mark_stack_entry; if (__builtin_expect((((mark_stack_entry
= ++PL_markstack_ptr) == PL_markstack_max) ? (_Bool)1 : (_Bool
)0),(0))) mark_stack_entry = Perl_markstack_grow(); *mark_stack_entry
= (I32)((sp) - PL_stack_base); ; } while (0);
1245 XPUSHs(sv_2mortal(newSVpvn(enc->name[0], strlen(enc->name[0]))))do { do { (void)0; if (__builtin_expect(((((1) < 0 || PL_stack_max
- (sp) < (1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow
( sp,sp,(sizeof(1) > sizeof(ssize_t) && ((ssize_t)
(1) != (1)) ? -1 : (1))); ((void)sizeof(sp)); } } while (0); *
++sp = (Perl_sv_2mortal( Perl_newSVpvn( enc->name[0],strlen
(enc->name[0])))); } while (0);
1246 PUTBACKPL_stack_sp = sp;
1247 call_pv("Encode::MIME::Name::get_mime_name", G_SCALAR)Perl_call_pv( "Encode::MIME::Name::get_mime_name",2);
1248 SPAGAINsp = PL_stack_sp;
1249 RETVAL = newSVsv(POPs)Perl_newSVsv_flags( ((*sp--)),2|16);
1250 PUTBACKPL_stack_sp = sp;
1251 FREETMPSif (PL_tmps_ix > PL_tmps_floor) Perl_free_tmps();
1252 LEAVEPerl_pop_scope();
1253#line 1254 "Encode.c"
1254 RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL);
1255 ST(0)PL_stack_base[ax + (0)] = RETVAL;
1256 }
1257 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
1258}
1259
1260
1261XS_EUPXS(XS_Encode_is_utf8)static void XS_Encode_is_utf8( CV* cv __attribute__((unused))
); /* prototype to pass -Wmissing-prototypes */
1262XS_EUPXS(XS_Encode_is_utf8)static void XS_Encode_is_utf8( CV* cv __attribute__((unused))
)
1263{
1264 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1265 if (items < 1 || items > 2)
1266 croak_xs_usagePerl_croak_xs_usage(cv, "sv, check = 0");
1267 {
1268 SV * sv = ST(0)PL_stack_base[ax + (0)]
1269;
1270 int check;
1271#line 932 "Encode.xs"
1272 char *str;
1273 STRLEN len;
1274#line 1275 "Encode.c"
1275 bool_Bool RETVAL;
1276
1277 if (items < 2)
1278 check = 0;
1279 else {
1280 check = (int)SvIV(ST(1))((((PL_stack_base[ax + (1)])->sv_flags & (0x00000100|0x00200000
)) == 0x00000100) ? ((XPVIV*) (PL_stack_base[ax + (1)])->sv_any
)->xiv_u.xivu_iv : Perl_sv_2iv_flags( PL_stack_base[ax + (
1)],2))
1281;
1282 }
1283#line 935 "Encode.xs"
1284 SvGETMAGIC(sv)((void)(__builtin_expect(((((sv)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( sv))); /* SvGETMAGIC() can modify SvOK flag */
1285 str = SvOK(sv)((sv)->sv_flags & (0x00000100|0x00000200|0x00000400|0x00000800
| 0x00001000|0x00002000|0x00004000|0x00008000)) ? SvPV_nomg(sv, len)((((sv)->sv_flags & (0x00000400|0x00200000)) == 0x00000400
) ? ((len = ((XPV*) (sv)->sv_any)->xpv_cur), ((sv)->
sv_u.svu_pv)) : Perl_sv_2pv_flags( sv,&len,0)) : NULL((void*)0); /* SvPV() can modify SvUTF8 flag */
1286 RETVAL = SvUTF8(sv)((sv)->sv_flags & 0x20000000) ? TRUE(1) : FALSE(0);
1287 if (RETVAL && check && (!str || !is_utf8_string((U8 *)str, len)Perl_is_utf8_string_loclen((U8 *)str, len, ((void*)0), ((void
*)0))))
1288 RETVAL = FALSE(0);
1289#line 1290 "Encode.c"
1290 ST(0)PL_stack_base[ax + (0)] = boolSV(RETVAL)((RETVAL) ? &(PL_sv_immortals[0]) : &(PL_sv_immortals
[2]));
1291 }
1292 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
1293}
1294
1295
1296XS_EUPXS(XS_Encode__utf8_on)static void XS_Encode__utf8_on( CV* cv __attribute__((unused)
)); /* prototype to pass -Wmissing-prototypes */
1297XS_EUPXS(XS_Encode__utf8_on)static void XS_Encode__utf8_on( CV* cv __attribute__((unused)
))
1298{
1299 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1300 if (items != 1)
1301 croak_xs_usagePerl_croak_xs_usage(cv, "sv");
1302 {
1303 SV * sv = ST(0)PL_stack_base[ax + (0)]
1304;
1305 SV * RETVAL;
1306#line 947 "Encode.xs"
1307 SvGETMAGIC(sv)((void)(__builtin_expect(((((sv)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( sv)));
1308 if (!SvTAINTED(sv)(((sv)->sv_flags & (0x00200000|0x00400000|0x00800000))
&& Perl_sv_tainted( sv)) && SvPOKp(sv)((sv)->sv_flags & 0x00004000)) {
1309 if (SvTHINKFIRST(sv)((sv)->sv_flags & (0x08000000|0x00010000|0x00000800|0x01000000
|0x00800000|0x10000000))) sv_force_normal(sv)Perl_sv_force_normal_flags( sv,0);
1310 RETVAL = boolSV(SvUTF8(sv))((((sv)->sv_flags & 0x20000000)) ? &(PL_sv_immortals
[0]) : &(PL_sv_immortals[2]));
1311 SvUTF8_on(sv)((sv)->sv_flags |= (0x20000000));
1312 SvSETMAGIC(sv)do { if (__builtin_expect(((((sv)->sv_flags & 0x00400000
)) ? (_Bool)1 : (_Bool)0),(0))) Perl_mg_set( sv); } while (0);
1313 } else {
1314 RETVAL = &PL_sv_undef(PL_sv_immortals[1]);
1315 }
1316#line 1317 "Encode.c"
1317 RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL);
1318 ST(0)PL_stack_base[ax + (0)] = RETVAL;
1319 }
1320 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
1321}
1322
1323
1324XS_EUPXS(XS_Encode__utf8_off)static void XS_Encode__utf8_off( CV* cv __attribute__((unused
))); /* prototype to pass -Wmissing-prototypes */
1325XS_EUPXS(XS_Encode__utf8_off)static void XS_Encode__utf8_off( CV* cv __attribute__((unused
)))
1326{
1327 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1328 if (items != 1)
1329 croak_xs_usagePerl_croak_xs_usage(cv, "sv");
1330 {
1331 SV * sv = ST(0)PL_stack_base[ax + (0)]
1332;
1333 SV * RETVAL;
1334#line 963 "Encode.xs"
1335 SvGETMAGIC(sv)((void)(__builtin_expect(((((sv)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( sv)));
1336 if (!SvTAINTED(sv)(((sv)->sv_flags & (0x00200000|0x00400000|0x00800000))
&& Perl_sv_tainted( sv)) && SvPOKp(sv)((sv)->sv_flags & 0x00004000)) {
1337 if (SvTHINKFIRST(sv)((sv)->sv_flags & (0x08000000|0x00010000|0x00000800|0x01000000
|0x00800000|0x10000000))) sv_force_normal(sv)Perl_sv_force_normal_flags( sv,0);
1338 RETVAL = boolSV(SvUTF8(sv))((((sv)->sv_flags & 0x20000000)) ? &(PL_sv_immortals
[0]) : &(PL_sv_immortals[2]));
1339 SvUTF8_off(sv)((sv)->sv_flags &= ~(0x20000000));
1340 SvSETMAGIC(sv)do { if (__builtin_expect(((((sv)->sv_flags & 0x00400000
)) ? (_Bool)1 : (_Bool)0),(0))) Perl_mg_set( sv); } while (0);
1341 } else {
1342 RETVAL = &PL_sv_undef(PL_sv_immortals[1]);
1343 }
1344#line 1345 "Encode.c"
1345 RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL);
1346 ST(0)PL_stack_base[ax + (0)] = RETVAL;
1347 }
1348 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
1349}
1350
1351
1352XS_EUPXS(XS_Encode_decode)static void XS_Encode_decode( CV* cv __attribute__((unused))); /* prototype to pass -Wmissing-prototypes */
1353XS_EUPXS(XS_Encode_decode)static void XS_Encode_decode( CV* cv __attribute__((unused)))
1354{
1355 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1356 dXSI32I32 ix = ((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))->
xcv_start_u.xcv_xsubany.any_i32;
1357 if (items < 2 || items > 3)
1358 croak_xs_usagePerl_croak_xs_usage(cv, "encoding, octets, check = NULL");
1359 {
1360 SV * encoding = ST(0)PL_stack_base[ax + (0)]
1361;
1362 SV * octets = ST(1)PL_stack_base[ax + (1)]
1363;
1364 SV * check;
1365#line 983 "Encode.xs"
1366 SV *obj;
1367#line 1368 "Encode.c"
1368 SV * RETVAL;
1369
1370 if (items < 3)
1371 check = NULL((void*)0);
1372 else {
1373 check = ST(2)PL_stack_base[ax + (2)]
1374;
1375 }
1376#line 985 "Encode.xs"
1377 PERL_UNUSED_VAR(ix)((void)sizeof(ix));
1378 SvGETMAGIC(encoding)((void)(__builtin_expect(((((encoding)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( encoding
)));
1379#line 1380 "Encode.c"
1380#line 988 "Encode.xs"
1381 if (!SvOK(encoding)((encoding)->sv_flags & (0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)))
1382 croakPerl_croak("Encoding name should not be undef");
1383 obj = find_encoding(aTHX_ encoding);
1384 if (!SvOK(obj)((obj)->sv_flags & (0x00000100|0x00000200|0x00000400|0x00000800
| 0x00001000|0x00002000|0x00004000|0x00008000)))
1385 croakPerl_croak("Unknown encoding '%" SVf"-p" "'", SVfARG(encoding)((void*)(encoding)));
1386 RETVAL = call_encoding(aTHX_ "decode", obj, octets, check);
1387#line 1388 "Encode.c"
1388 RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL);
1389 ST(0)PL_stack_base[ax + (0)] = RETVAL;
1390 }
1391 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
1392}
1393
1394
1395XS_EUPXS(XS_Encode_encode)static void XS_Encode_encode( CV* cv __attribute__((unused))); /* prototype to pass -Wmissing-prototypes */
1396XS_EUPXS(XS_Encode_encode)static void XS_Encode_encode( CV* cv __attribute__((unused)))
1397{
1398 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1399 dXSI32I32 ix = ((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))->
xcv_start_u.xcv_xsubany.any_i32;
1400 if (items < 2 || items > 3)
1401 croak_xs_usagePerl_croak_xs_usage(cv, "encoding, string, check = NULL");
1402 {
1403 SV * encoding = ST(0)PL_stack_base[ax + (0)]
1404;
1405 SV * string = ST(1)PL_stack_base[ax + (1)]
1406;
1407 SV * check;
1408#line 1005 "Encode.xs"
1409 SV *obj;
1410#line 1411 "Encode.c"
1411 SV * RETVAL;
1412
1413 if (items < 3)
1414 check = NULL((void*)0);
1415 else {
1416 check = ST(2)PL_stack_base[ax + (2)]
1417;
1418 }
1419#line 1007 "Encode.xs"
1420 PERL_UNUSED_VAR(ix)((void)sizeof(ix));
1421 SvGETMAGIC(encoding)((void)(__builtin_expect(((((encoding)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( encoding
)));
1422#line 1423 "Encode.c"
1423#line 1010 "Encode.xs"
1424 if (!SvOK(encoding)((encoding)->sv_flags & (0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)))
1425 croakPerl_croak("Encoding name should not be undef");
1426 obj = find_encoding(aTHX_ encoding);
1427 if (!SvOK(obj)((obj)->sv_flags & (0x00000100|0x00000200|0x00000400|0x00000800
| 0x00001000|0x00002000|0x00004000|0x00008000)))
1428 croakPerl_croak("Unknown encoding '%" SVf"-p" "'", SVfARG(encoding)((void*)(encoding)));
1429 RETVAL = call_encoding(aTHX_ "encode", obj, string, check);
1430#line 1431 "Encode.c"
1431 RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL);
1432 ST(0)PL_stack_base[ax + (0)] = RETVAL;
1433 }
1434 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
1435}
1436
1437
1438XS_EUPXS(XS_Encode_decode_utf8)static void XS_Encode_decode_utf8( CV* cv __attribute__((unused
))); /* prototype to pass -Wmissing-prototypes */
1439XS_EUPXS(XS_Encode_decode_utf8)static void XS_Encode_decode_utf8( CV* cv __attribute__((unused
)))
1440{
1441 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1442 if (items < 1 || items > 2)
1443 croak_xs_usagePerl_croak_xs_usage(cv, "octets, check = NULL");
1444 {
1445 SV * octets = ST(0)PL_stack_base[ax + (0)]
1446;
1447 SV * check;
1448#line 1024 "Encode.xs"
1449 HV *hv;
1450 SV **sv;
1451#line 1452 "Encode.c"
1452 SV * RETVAL;
1453
1454 if (items < 2)
1455 check = NULL((void*)0);
1456 else {
1457 check = ST(1)PL_stack_base[ax + (1)]
1458;
1459 }
1460#line 1027 "Encode.xs"
1461 hv = get_hv("Encode::Encoding", 0)Perl_get_hv( "Encode::Encoding",0);
1462 if (!hv)
1463 croakPerl_croak("utf8 encoding was not found");
1464 sv = hv_fetch(hv, "utf8", 4, 0)((SV**) Perl_hv_common_key_len( (hv),("utf8"),(4),(0) ? (0x20
| 0x10) : 0x20,((void*)0),0));
1465 if (!sv || !*sv || !SvOK(*sv)((*sv)->sv_flags & (0x00000100|0x00000200|0x00000400|0x00000800
| 0x00001000|0x00002000|0x00004000|0x00008000)))
1466 croakPerl_croak("utf8 encoding was not found");
1467 RETVAL = call_encoding(aTHX_ "decode", *sv, octets, check);
1468#line 1469 "Encode.c"
1469 RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL);
1470 ST(0)PL_stack_base[ax + (0)] = RETVAL;
1471 }
1472 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
1473}
1474
1475
1476XS_EUPXS(XS_Encode_encode_utf8)static void XS_Encode_encode_utf8( CV* cv __attribute__((unused
))); /* prototype to pass -Wmissing-prototypes */
1477XS_EUPXS(XS_Encode_encode_utf8)static void XS_Encode_encode_utf8( CV* cv __attribute__((unused
)))
1478{
1479 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1480 if (items != 1)
1481 croak_xs_usagePerl_croak_xs_usage(cv, "string");
1482 {
1483 SV * string = ST(0)PL_stack_base[ax + (0)]
1484;
1485 SV * RETVAL;
1486#line 1041 "Encode.xs"
1487 RETVAL = newSVsv(string)Perl_newSVsv_flags( (string),2|16);
1488 if (SvOK(RETVAL)((RETVAL)->sv_flags & (0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)))
1489 sv_utf8_encode(RETVAL)Perl_sv_utf8_encode( RETVAL);
1490#line 1491 "Encode.c"
1491 RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL);
1492 ST(0)PL_stack_base[ax + (0)] = RETVAL;
1493 }
1494 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
1495}
1496
1497
1498XS_EUPXS(XS_Encode_from_to)static void XS_Encode_from_to( CV* cv __attribute__((unused))
); /* prototype to pass -Wmissing-prototypes */
1499XS_EUPXS(XS_Encode_from_to)static void XS_Encode_from_to( CV* cv __attribute__((unused))
)
1500{
1501 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1502 if (items < 3 || items > 4)
1503 croak_xs_usagePerl_croak_xs_usage(cv, "octets, from, to, check = NULL");
1504 {
1505 SV * octets = ST(0)PL_stack_base[ax + (0)]
1506;
1507 SV * from = ST(1)PL_stack_base[ax + (1)]
1508;
1509 SV * to = ST(2)PL_stack_base[ax + (2)]
1510;
1511 SV * check;
1512#line 1054 "Encode.xs"
1513 SV *from_obj;
1514 SV *to_obj;
1515 SV *string;
1516 SV *new_octets;
1517 U8 *ptr;
1518 STRLEN len;
1519#line 1520 "Encode.c"
1520 SV * RETVAL;
1521
1522 if (items < 4)
1523 check = NULL((void*)0);
1524 else {
1525 check = ST(3)PL_stack_base[ax + (3)]
1526;
1527 }
1528#line 1061 "Encode.xs"
1529 SvGETMAGIC(from)((void)(__builtin_expect(((((from)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( from))
);
1530 SvGETMAGIC(to)((void)(__builtin_expect(((((to)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( to)));
1531#line 1532 "Encode.c"
1532#line 1064 "Encode.xs"
1533 if (!SvOK(from)((from)->sv_flags & (0x00000100|0x00000200|0x00000400|
0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)) || !SvOK(to)((to)->sv_flags & (0x00000100|0x00000200|0x00000400|0x00000800
| 0x00001000|0x00002000|0x00004000|0x00008000)))
1534 croakPerl_croak("Encoding name should not be undef");
1535 from_obj = find_encoding(aTHX_ from);
1536 if (!SvOK(from_obj)((from_obj)->sv_flags & (0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)))
1537 croakPerl_croak("Unknown encoding '%" SVf"-p" "'", SVfARG(from)((void*)(from)));
1538 to_obj = find_encoding(aTHX_ to);
1539 if (!SvOK(to_obj)((to_obj)->sv_flags & (0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)))
1540 croakPerl_croak("Unknown encoding '%" SVf"-p" "'", SVfARG(to)((void*)(to)));
1541 string = sv_2mortal(call_encoding(aTHX_ "decode", from_obj, octets, NULL))Perl_sv_2mortal( call_encoding( "decode", from_obj, octets, (
(void*)0)));
1542 new_octets = sv_2mortal(call_encoding(aTHX_ "encode", to_obj, string, check))Perl_sv_2mortal( call_encoding( "encode", to_obj, string, check
));
1543 SvGETMAGIC(new_octets)((void)(__builtin_expect(((((new_octets)->sv_flags & 0x00200000
)) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( new_octets
)));
1544 if (SvOK(new_octets)((new_octets)->sv_flags & (0x00000100|0x00000200|0x00000400
|0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)) && (!check || SvROK(check)((check)->sv_flags & 0x00000800) || !SvTRUE_nomg(check)(__builtin_expect(((check) ? (_Bool)1 : (_Bool)0),(1)) &&
(( ((size_t)((check) - &(PL_sv_immortals[0])) < 4) ? (
(check) == &(PL_sv_immortals[0])) : !((check)->sv_flags
& (0x00000100|0x00000200|0x00000400|0x00000800| 0x00001000
|0x00002000|0x00004000|0x00008000)) ? 0 : ((check)->sv_flags
& 0x00000400) ? ( ((XPV*)((check))->sv_any) &&
( ((XPV*)((check))->sv_any)->xpv_cur > 1 || ( ((XPV
*)((check))->sv_any)->xpv_cur && *(check)->sv_u
.svu_pv != '0' ) ) ) : ((check)->sv_flags & 0x00000100
) ? (((XPVIV*) (check)->sv_any)->xiv_u.xivu_iv != 0 ) :
(((check)->sv_flags & 0x00000800) && !( ((((check
)->sv_u.svu_rv))->sv_flags & 0x00100000) &&
((((XPVMG*) (((check)->sv_u.svu_rv))->sv_any)->xmg_stash
)->sv_flags & 0x10000000))) ? (1) : (Perl_sv_2bool_flags
( check,0))))) || sv_len(string)Perl_sv_len( string) == 0)) {
1545 ptr = (U8 *)SvPV_nomg(new_octets, len)((((new_octets)->sv_flags & (0x00000400|0x00200000)) ==
0x00000400) ? ((len = ((XPV*) (new_octets)->sv_any)->xpv_cur
), ((new_octets)->sv_u.svu_pv)) : Perl_sv_2pv_flags( new_octets
,&len,0));
1546 if (SvUTF8(new_octets)((new_octets)->sv_flags & 0x20000000))
1547 len = utf8_length(ptr, ptr+len)Perl_utf8_length( ptr,ptr+len);
1548 RETVAL = newSVuv(len)Perl_newSVuv( len);
1549 } else {
1550 RETVAL = &PL_sv_undef(PL_sv_immortals[1]);
1551 }
1552 sv_setsv_nomg(octets, new_octets)Perl_sv_setsv_flags( octets,new_octets,0);
1553 SvSETMAGIC(octets)do { if (__builtin_expect(((((octets)->sv_flags & 0x00400000
)) ? (_Bool)1 : (_Bool)0),(0))) Perl_mg_set( octets); } while
(0);
1554#line 1555 "Encode.c"
1555 RETVAL = sv_2mortal(RETVAL)Perl_sv_2mortal( RETVAL);
1556 ST(0)PL_stack_base[ax + (0)] = RETVAL;
1557 }
1558 XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0);
1559}
1560
1561
1562XS_EUPXS(XS_Encode_onBOOT)static void XS_Encode_onBOOT( CV* cv __attribute__((unused))); /* prototype to pass -Wmissing-prototypes */
1563XS_EUPXS(XS_Encode_onBOOT)static void XS_Encode_onBOOT( CV* cv __attribute__((unused)))
1564{
1565 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1566 if (items != 0)
1567 croak_xs_usagePerl_croak_xs_usage(cv, "");
1568 {
1569#line 1091 "Encode.xs"
1570{
1571#include "def_t.exh"
1572}
1573#line 1574 "Encode.c"
1574 }
1575 XSRETURN_EMPTYdo { do { const IV tmpXSoff = (0); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0); } while (0);
1576}
1577
1578#ifdef __cplusplus
1579extern "C"
1580#endif
1581XS_EXTERNAL(boot_Encode)void boot_Encode( CV* cv __attribute__((unused))); /* prototype to pass -Wmissing-prototypes */
1582XS_EXTERNAL(boot_Encode)void boot_Encode( CV* cv __attribute__((unused)))
1583{
1584#if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5))
1585 dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base
+ ax++; I32 items = (I32)(sp - mark);
1586#else
1587 dVARstruct Perl___notused_struct; dXSBOOTARGSXSAPIVERCHKI32 ax = Perl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter
)) << 16) | ((sizeof("" "3.06_01" "")-1) > 0xFF ? (Perl_croak
("panic: handshake overflow"), 0xFF) : (sizeof("" "3.06_01" ""
)-1) << 8) | ((((1)) ? (_Bool)1 : (_Bool)0) ? 0x00000020
: 0) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | ((
((1)) ? (_Bool)1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" "v"
"5" "." "32" "." "0" "")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow"
), 0x0000001F) : (sizeof("" "v" "5" "." "32" "." "0" "")-1)))
, cv, "Encode.c", "v" "5" "." "32" "." "0", "3.06_01"); SV **
mark = PL_stack_base + ax; SV **sp = PL_stack_sp; I32 items =
(I32)(sp - mark);
1588#endif
1589#if (PERL_REVISION5 == 5 && PERL_VERSION32 < 9)
1590 char* file = __FILE__"Encode.c";
1591#else
1592 const char* file = __FILE__"Encode.c";
1593#endif
1594
1595 PERL_UNUSED_VAR(file)((void)sizeof(file));
1596
1597 PERL_UNUSED_VAR(cv)((void)sizeof(cv)); /* -W */
1598 PERL_UNUSED_VAR(items)((void)sizeof(items)); /* -W */
1599#if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5))
1600 XS_VERSION_BOOTCHECKPerl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter))
<< 16) | ((sizeof("" "3.06_01" "")-1) > 0xFF ? (Perl_croak
("panic: handshake overflow"), 0xFF) : (sizeof("" "3.06_01" ""
)-1) << 8) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000020
: 0) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | ((
((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" ""
"")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow"
), 0x0000001F) : (sizeof("" "" "")-1))), cv, "Encode.c", items
, ax, "3.06_01");
1601# ifdef XS_APIVERSION_BOOTCHECKPerl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter))
<< 16) | ((sizeof("" "" "")-1) > 0xFF ? (Perl_croak
("panic: handshake overflow"), 0xFF) : (sizeof("" "" "")-1) <<
8) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000020 : 0) | ((((
0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | ((((0)) ? (_Bool
)1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" "v" "5" "." "32"
"." "0" "")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow"
), 0x0000001F) : (sizeof("" "v" "5" "." "32" "." "0" "")-1)))
, cv, "Encode.c", items, ax, "v" "5" "." "32" "." "0")
1602 XS_APIVERSION_BOOTCHECKPerl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter))
<< 16) | ((sizeof("" "" "")-1) > 0xFF ? (Perl_croak
("panic: handshake overflow"), 0xFF) : (sizeof("" "" "")-1) <<
8) | ((((0)) ? (_Bool)1 : (_Bool)0) ? 0x00000020 : 0) | ((((
0)) ? (_Bool)1 : (_Bool)0) ? 0x00000080 : 0) | ((((0)) ? (_Bool
)1 : (_Bool)0) ? 0x00000040 : 0) | ((sizeof("" "v" "5" "." "32"
"." "0" "")-1) > 0x0000001F ? (Perl_croak("panic: handshake overflow"
), 0x0000001F) : (sizeof("" "v" "5" "." "32" "." "0" "")-1)))
, cv, "Encode.c", items, ax, "v" "5" "." "32" "." "0");
1603# endif
1604#endif
1605
1606 newXS_deffile("Encode::utf8::decode", XS_Encode__utf8_decode)Perl_newXS_deffile( "Encode::utf8::decode",XS_Encode__utf8_decode
);
1607 newXS_deffile("Encode::utf8::encode", XS_Encode__utf8_encode)Perl_newXS_deffile( "Encode::utf8::encode",XS_Encode__utf8_encode
);
1608 newXS_deffile("Encode::XS::renew", XS_Encode__XS_renew)Perl_newXS_deffile( "Encode::XS::renew",XS_Encode__XS_renew);
1609 newXS_deffile("Encode::XS::renewed", XS_Encode__XS_renewed)Perl_newXS_deffile( "Encode::XS::renewed",XS_Encode__XS_renewed
);
1610 newXS_deffile("Encode::XS::name", XS_Encode__XS_name)Perl_newXS_deffile( "Encode::XS::name",XS_Encode__XS_name);
1611 newXS_deffile("Encode::XS::cat_decode", XS_Encode__XS_cat_decode)Perl_newXS_deffile( "Encode::XS::cat_decode",XS_Encode__XS_cat_decode
);
1612 newXS_deffile("Encode::XS::decode", XS_Encode__XS_decode)Perl_newXS_deffile( "Encode::XS::decode",XS_Encode__XS_decode
);
1613 newXS_deffile("Encode::XS::encode", XS_Encode__XS_encode)Perl_newXS_deffile( "Encode::XS::encode",XS_Encode__XS_encode
);
1614 newXS_deffile("Encode::XS::needs_lines", XS_Encode__XS_needs_lines)Perl_newXS_deffile( "Encode::XS::needs_lines",XS_Encode__XS_needs_lines
);
1615 newXS_deffile("Encode::XS::perlio_ok", XS_Encode__XS_perlio_ok)Perl_newXS_deffile( "Encode::XS::perlio_ok",XS_Encode__XS_perlio_ok
);
1616 newXS_deffile("Encode::XS::mime_name", XS_Encode__XS_mime_name)Perl_newXS_deffile( "Encode::XS::mime_name",XS_Encode__XS_mime_name
);
1617 (void)newXSproto_portable("Encode::is_utf8", XS_Encode_is_utf8, file, "$;$")Perl_newXS_flags( "Encode::is_utf8",XS_Encode_is_utf8,file,"$;$"
,0);
1618 (void)newXSproto_portable("Encode::_utf8_on", XS_Encode__utf8_on, file, "$")Perl_newXS_flags( "Encode::_utf8_on",XS_Encode__utf8_on,file,
"$",0);
1619 (void)newXSproto_portable("Encode::_utf8_off", XS_Encode__utf8_off, file, "$")Perl_newXS_flags( "Encode::_utf8_off",XS_Encode__utf8_off,file
,"$",0);
1620 cv = newXSproto_portable("Encode::bytes2str", XS_Encode_decode, file, "$$;$")Perl_newXS_flags( "Encode::bytes2str",XS_Encode_decode,file,"$$;$"
,0);
1621 XSANY((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))->xcv_start_u
.xcv_xsubany.any_i32 = 0;
1622 cv = newXSproto_portable("Encode::decode", XS_Encode_decode, file, "$$;$")Perl_newXS_flags( "Encode::decode",XS_Encode_decode,file,"$$;$"
,0);
1623 XSANY((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))->xcv_start_u
.xcv_xsubany.any_i32 = 0;
1624 cv = newXSproto_portable("Encode::encode", XS_Encode_encode, file, "$$;$")Perl_newXS_flags( "Encode::encode",XS_Encode_encode,file,"$$;$"
,0);
1625 XSANY((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))->xcv_start_u
.xcv_xsubany.any_i32 = 0;
1626 cv = newXSproto_portable("Encode::str2bytes", XS_Encode_encode, file, "$$;$")Perl_newXS_flags( "Encode::str2bytes",XS_Encode_encode,file,"$$;$"
,0);
1627 XSANY((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))->xcv_start_u
.xcv_xsubany.any_i32 = 0;
1628 (void)newXSproto_portable("Encode::decode_utf8", XS_Encode_decode_utf8, file, "$;$")Perl_newXS_flags( "Encode::decode_utf8",XS_Encode_decode_utf8
,file,"$;$",0);
1629 (void)newXSproto_portable("Encode::encode_utf8", XS_Encode_encode_utf8, file, "$")Perl_newXS_flags( "Encode::encode_utf8",XS_Encode_encode_utf8
,file,"$",0);
1630 (void)newXSproto_portable("Encode::from_to", XS_Encode_from_to, file, "$$$;$")Perl_newXS_flags( "Encode::from_to",XS_Encode_from_to,file,"$$$;$"
,0);
1631 (void)newXSproto_portable("Encode::onBOOT", XS_Encode_onBOOT, file, "")Perl_newXS_flags( "Encode::onBOOT",XS_Encode_onBOOT,file,"",0
);
1632
1633 /* Initialisation Section */
1634
1635#line 1096 "Encode.xs"
1636{
1637 HV *stash = gv_stashpvn("Encode", (U32)strlen("Encode"), GV_ADD)Perl_gv_stashpvn( "Encode",(U32)strlen("Encode"),0x01);
1638 newCONSTSUB(stash, "DIE_ON_ERR", newSViv(ENCODE_DIE_ON_ERR))Perl_newCONSTSUB( stash,"DIE_ON_ERR",Perl_newSViv( 0x0001));
1639 newCONSTSUB(stash, "WARN_ON_ERR", newSViv(ENCODE_WARN_ON_ERR))Perl_newCONSTSUB( stash,"WARN_ON_ERR",Perl_newSViv( 0x0002));
1640 newCONSTSUB(stash, "RETURN_ON_ERR", newSViv(ENCODE_RETURN_ON_ERR))Perl_newCONSTSUB( stash,"RETURN_ON_ERR",Perl_newSViv( 0x0004)
);
1641 newCONSTSUB(stash, "LEAVE_SRC", newSViv(ENCODE_LEAVE_SRC))Perl_newCONSTSUB( stash,"LEAVE_SRC",Perl_newSViv( 0x0008));
1642 newCONSTSUB(stash, "ONLY_PRAGMA_WARNINGS", newSViv(ENCODE_ONLY_PRAGMA_WARNINGS))Perl_newCONSTSUB( stash,"ONLY_PRAGMA_WARNINGS",Perl_newSViv( 0x0010
));
1643 newCONSTSUB(stash, "PERLQQ", newSViv(ENCODE_PERLQQ))Perl_newCONSTSUB( stash,"PERLQQ",Perl_newSViv( 0x0100));
1644 newCONSTSUB(stash, "HTMLCREF", newSViv(ENCODE_HTMLCREF))Perl_newCONSTSUB( stash,"HTMLCREF",Perl_newSViv( 0x0200));
1645 newCONSTSUB(stash, "XMLCREF", newSViv(ENCODE_XMLCREF))Perl_newCONSTSUB( stash,"XMLCREF",Perl_newSViv( 0x0400));
1646 newCONSTSUB(stash, "STOP_AT_PARTIAL", newSViv(ENCODE_STOP_AT_PARTIAL))Perl_newCONSTSUB( stash,"STOP_AT_PARTIAL",Perl_newSViv( 0x0800
));
1647 newCONSTSUB(stash, "FB_DEFAULT", newSViv(ENCODE_FB_DEFAULT))Perl_newCONSTSUB( stash,"FB_DEFAULT",Perl_newSViv( 0x0000));
1648 newCONSTSUB(stash, "FB_CROAK", newSViv(ENCODE_FB_CROAK))Perl_newCONSTSUB( stash,"FB_CROAK",Perl_newSViv( 0x0001));
1649 newCONSTSUB(stash, "FB_QUIET", newSViv(ENCODE_FB_QUIET))Perl_newCONSTSUB( stash,"FB_QUIET",Perl_newSViv( 0x0004));
1650 newCONSTSUB(stash, "FB_WARN", newSViv(ENCODE_FB_WARN))Perl_newCONSTSUB( stash,"FB_WARN",Perl_newSViv( (0x0004|0x0002
)));
1651 newCONSTSUB(stash, "FB_PERLQQ", newSViv(ENCODE_FB_PERLQQ))Perl_newCONSTSUB( stash,"FB_PERLQQ",Perl_newSViv( (0x0100|0x0008
)));
1652 newCONSTSUB(stash, "FB_HTMLCREF", newSViv(ENCODE_FB_HTMLCREF))Perl_newCONSTSUB( stash,"FB_HTMLCREF",Perl_newSViv( (0x0200|0x0008
)));
1653 newCONSTSUB(stash, "FB_XMLCREF", newSViv(ENCODE_FB_XMLCREF))Perl_newCONSTSUB( stash,"FB_XMLCREF",Perl_newSViv( (0x0400|0x0008
)));
1654}
1655
1656#line 1657 "Encode.c"
1657
1658 /* End of Initialisation Section */
1659
1660#if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5))
1661# if PERL_VERSION_GE(5, 9, 0)((5*1000000 + 32*1000 + 1) >= (5*1000000 + 9*1000 + 0))
1662 if (PL_unitcheckav)
1663 call_list(PL_scopestack_ix, PL_unitcheckav)Perl_call_list( PL_scopestack_ix,PL_unitcheckav);
1664# endif
1665 XSRETURN_YESdo { (PL_stack_base[ax + (0)] = &(PL_sv_immortals[0]) ); do
{ const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base
+ ax + (tmpXSoff - 1); return; } while (0); } while (0);
1666#else
1667 Perl_xs_boot_epilog(aTHX_ ax);
1668#endif
1669}
1670