File: | obj/gnu/usr.bin/perl/ext/File-Glob/Glob.c |
Warning: | line 206, column 7 Value stored to 'piece' is never read |
Press '?' to see keyboard shortcuts
Keyboard shortcuts:
1 | /* |
2 | * This file was generated automatically by ExtUtils::ParseXS version 3.40 from the |
3 | * contents of Glob.xs. Do not edit this file, edit Glob.xs instead. |
4 | * |
5 | * ANY CHANGES MADE HERE WILL BE LOST! |
6 | * |
7 | */ |
8 | |
9 | #line 1 "Glob.xs" |
10 | #define PERL_NO_GET_CONTEXT |
11 | |
12 | #include "EXTERN.h" |
13 | #include "perl.h" |
14 | #include "XSUB.h" |
15 | |
16 | #include "bsd_glob.h" |
17 | |
18 | #define MY_CXT_KEY"File::Glob::_guts" "1.33" "File::Glob::_guts" XS_VERSION"1.33" |
19 | |
20 | typedef struct { |
21 | #ifdef USE_ITHREADS |
22 | tTHX interp; |
23 | #endif |
24 | int x_GLOB_ERROR; |
25 | HV * x_GLOB_ENTRIES; |
26 | Perl_ophook_t x_GLOB_OLD_OPHOOK; |
27 | } my_cxt_t; |
28 | |
29 | START_MY_CXTstatic my_cxt_t my_cxt; |
30 | |
31 | #define GLOB_ERROR(my_cxt.x_GLOB_ERROR) (MY_CXTmy_cxt.x_GLOB_ERROR) |
32 | |
33 | #include "const-c.inc" |
34 | |
35 | #ifdef WIN32 |
36 | #define errfunc NULL((void*)0) |
37 | #else |
38 | static int |
39 | errfunc(const char *foo, int bar) { |
40 | PERL_UNUSED_ARG(foo)((void)sizeof(foo)); |
41 | return !(bar == EACCES13 || bar == ENOENT2 || bar == ENOTDIR20); |
42 | } |
43 | #endif |
44 | |
45 | static void |
46 | doglob(pTHX_ const char *pattern, int flags) |
47 | { |
48 | dSPSV **sp = PL_stack_sp; |
49 | glob_t pglob; |
50 | int i; |
51 | int retval; |
52 | SV *tmp; |
53 | { |
54 | dMY_CXTstruct Perl___notused_struct; |
55 | |
56 | /* call glob */ |
57 | memset(&pglob, 0, sizeof(glob_t)); |
58 | retval = bsd_glob(pattern, flags, errfunc, &pglob); |
59 | GLOB_ERROR(my_cxt.x_GLOB_ERROR) = retval; |
60 | |
61 | /* return any matches found */ |
62 | EXTEND(sp, pglob.gl_pathc)do { (void)0; if (__builtin_expect(((((pglob.gl_pathc) < 0 || PL_stack_max - (sp) < (pglob.gl_pathc))) ? (_Bool)1 : ( _Bool)0),(0))) { sp = Perl_stack_grow( sp,sp,(sizeof(pglob.gl_pathc ) > sizeof(ssize_t) && ((ssize_t)(pglob.gl_pathc) != (pglob.gl_pathc)) ? -1 : (pglob.gl_pathc))); ((void)sizeof(sp )); } } while (0); |
63 | for (i = 0; i < pglob.gl_pathc; i++) { |
64 | /* printf("# bsd_glob: %s\n", pglob.gl_pathv[i]); */ |
65 | tmp = newSVpvn_flags(pglob.gl_pathv[i], strlen(pglob.gl_pathv[i]),Perl_newSVpvn_flags( pglob.gl_pathv[i],strlen(pglob.gl_pathv[ i]),0x00080000) |
66 | SVs_TEMP)Perl_newSVpvn_flags( pglob.gl_pathv[i],strlen(pglob.gl_pathv[ i]),0x00080000); |
67 | TAINT(PL_tainted = PL_tainting); |
68 | SvTAINT(tmp)do { ((void)0); if (__builtin_expect((((((__builtin_expect((( PL_tainted) ? (_Bool)1 : (_Bool)0),(0))) ? (_Bool)1 : (_Bool) 0))) ? (_Bool)1 : (_Bool)0),(0))) 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); } while (0 ); |
69 | PUSHs(tmp)(*++sp = (tmp)); |
70 | } |
71 | PUTBACKPL_stack_sp = sp; |
72 | |
73 | bsd_globfree(&pglob); |
74 | } |
75 | } |
76 | |
77 | static void |
78 | iterate(pTHX_ bool_Bool(*globber)(pTHX_ AV *entries, const char *pat, STRLEN len, bool_Bool is_utf8)) |
79 | { |
80 | dSPSV **sp = PL_stack_sp; |
81 | dMY_CXTstruct Perl___notused_struct; |
82 | |
83 | const char * const cxixpv = (char *)&PL_op; |
84 | STRLEN const cxixlen = sizeof(OP *); |
85 | AV *entries; |
86 | U32 const gimme = GIMME_VPerl_gimme_V(); |
87 | SV *patsv = POPs(*sp--); |
88 | bool_Bool on_stack = FALSE(0); |
89 | |
90 | if (!MY_CXTmy_cxt.x_GLOB_ENTRIES) MY_CXTmy_cxt.x_GLOB_ENTRIES = newHV()((HV *)({ void *_p = (Perl_newSV_type( SVt_PVHV)); _p; })); |
91 | entries = (AV *)*(hv_fetch(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 1)((SV**) Perl_hv_common_key_len( (my_cxt.x_GLOB_ENTRIES),(cxixpv ),(cxixlen),(1) ? (0x20 | 0x10) : 0x20,((void*)0),0))); |
92 | |
93 | /* if we're just beginning, do it all first */ |
94 | if (SvTYPE(entries)((svtype)((entries)->sv_flags & 0xff)) != SVt_PVAV) { |
95 | const char *pat; |
96 | STRLEN len; |
97 | bool_Bool is_utf8; |
98 | |
99 | /* glob without args defaults to $_ */ |
100 | SvGETMAGIC(patsv)((void)(__builtin_expect(((((patsv)->sv_flags & 0x00200000 )) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( patsv) )); |
101 | if ( |
102 | !SvOK(patsv)((patsv)->sv_flags & (0x00000100|0x00000200|0x00000400 |0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000)) |
103 | && (patsv = DEFSV(*((0+(PL_defgv)->sv_u.svu_gp)->gp_sv ? &((0+(PL_defgv )->sv_u.svu_gp)->gp_sv) : &((0+(Perl_gv_add_by_type ( (PL_defgv),SVt_NULL))->sv_u.svu_gp)->gp_sv))), SvGETMAGIC(patsv)((void)(__builtin_expect(((((patsv)->sv_flags & 0x00200000 )) ? (_Bool)1 : (_Bool)0),(0)) && Perl_mg_get( patsv) )), !SvOK(patsv)((patsv)->sv_flags & (0x00000100|0x00000200|0x00000400 |0x00000800| 0x00001000|0x00002000|0x00004000|0x00008000))) |
104 | ) { |
105 | pat = ""; |
106 | len = 0; |
107 | is_utf8 = 0; |
108 | } |
109 | else { |
110 | pat = SvPV_nomg(patsv,len)((((patsv)->sv_flags & (0x00000400|0x00200000)) == 0x00000400 ) ? ((len = ((XPV*) (patsv)->sv_any)->xpv_cur), ((patsv )->sv_u.svu_pv)) : Perl_sv_2pv_flags( patsv,&len,0)); |
111 | is_utf8 = !!SvUTF8(patsv)((patsv)->sv_flags & 0x20000000); |
112 | /* the lower-level code expects a null-terminated string */ |
113 | if (!SvPOK(patsv)((patsv)->sv_flags & 0x00000400) || pat != SvPVX(patsv)((patsv)->sv_u.svu_pv) || pat[len] != '\0') { |
114 | SV *newpatsv = newSVpvn_flags(pat, len, SVs_TEMP)Perl_newSVpvn_flags( pat,len,0x00080000); |
115 | pat = SvPV_nomg(newpatsv,len)((((newpatsv)->sv_flags & (0x00000400|0x00200000)) == 0x00000400 ) ? ((len = ((XPV*) (newpatsv)->sv_any)->xpv_cur), ((newpatsv )->sv_u.svu_pv)) : Perl_sv_2pv_flags( newpatsv,&len,0) ); |
116 | } |
117 | } |
118 | |
119 | if (!IS_SAFE_SYSCALL(pat, len, "pattern", "glob")(Perl_is_safe_syscall( (pat), (len), ("pattern"), ("glob")))) { |
120 | if (gimme != G_ARRAY3) |
121 | PUSHs(&PL_sv_undef)(*++sp = (&(PL_sv_immortals[1]))); |
122 | PUTBACKPL_stack_sp = sp; |
123 | return; |
124 | } |
125 | |
126 | PUTBACKPL_stack_sp = sp; |
127 | on_stack = globber(aTHX_ entries, pat, len, is_utf8); |
128 | SPAGAINsp = PL_stack_sp; |
129 | } |
130 | |
131 | /* chuck it all out, quick or slow */ |
132 | if (gimme == G_ARRAY3) { |
133 | if (!on_stack && AvFILLp(entries)((XPVAV*) (entries)->sv_any)->xav_fill + 1) { |
134 | EXTEND(SP, AvFILLp(entries)+1)do { (void)0; if (__builtin_expect(((((((XPVAV*) (entries)-> sv_any)->xav_fill+1) < 0 || PL_stack_max - (sp) < (( (XPVAV*) (entries)->sv_any)->xav_fill+1))) ? (_Bool)1 : (_Bool)0),(0))) { sp = Perl_stack_grow( sp,sp,(sizeof(((XPVAV *) (entries)->sv_any)->xav_fill+1) > sizeof(ssize_t) && ((ssize_t)(((XPVAV*) (entries)->sv_any)->xav_fill +1) != (((XPVAV*) (entries)->sv_any)->xav_fill+1)) ? -1 : (((XPVAV*) (entries)->sv_any)->xav_fill+1))); ((void )sizeof(sp)); } } while (0); |
135 | Copy(AvARRAY(entries), SP+1, AvFILLp(entries)+1, SV *)((void)(__builtin_expect(((((( sizeof(size_t) < sizeof(((XPVAV *) (entries)->sv_any)->xav_fill+1) || sizeof(SV *) > ((size_t)1 << 8*(sizeof(size_t) - sizeof(((XPVAV*) (entries )->sv_any)->xav_fill+1)))) ? (size_t)(((XPVAV*) (entries )->sv_any)->xav_fill+1) : ((size_t)-1)/sizeof(SV *)) > ((size_t)-1)/sizeof(SV *))) ? (_Bool)1 : (_Bool)0),(0)) && (Perl_croak_memory_wrap(),0)), ((void)0), ((void)0), (void)memcpy ((char*)(sp+1),(const char*)(((entries)->sv_u.svu_array)), (((XPVAV*) (entries)->sv_any)->xav_fill+1) * sizeof(SV *))); |
136 | SPsp += AvFILLp(entries)((XPVAV*) (entries)->sv_any)->xav_fill+1; |
137 | } |
138 | /* No G_DISCARD here! It will free the stack items. */ |
139 | (void)hv_delete(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, 0)(((SV *)({ void *_p = (Perl_hv_common_key_len( (my_cxt.x_GLOB_ENTRIES ),(cxixpv),(cxixlen),(0) | 0x40,((void*)0),0)); _p; }))); |
140 | } |
141 | else { |
142 | if (AvFILLp(entries)((XPVAV*) (entries)->sv_any)->xav_fill + 1) { |
143 | mPUSHs(av_shift(entries))(*++sp = (Perl_sv_2mortal( Perl_av_shift( entries)))); |
144 | } |
145 | else { |
146 | /* return undef for EOL */ |
147 | (void)hv_delete(MY_CXT.x_GLOB_ENTRIES, cxixpv, cxixlen, G_DISCARD)(((SV *)({ void *_p = (Perl_hv_common_key_len( (my_cxt.x_GLOB_ENTRIES ),(cxixpv),(cxixlen),(0x4) | 0x40,((void*)0),0)); _p; }))); |
148 | PUSHs(&PL_sv_undef)(*++sp = (&(PL_sv_immortals[1]))); |
149 | } |
150 | } |
151 | PUTBACKPL_stack_sp = sp; |
152 | } |
153 | |
154 | /* returns true if the items are on the stack already, but only in |
155 | list context */ |
156 | static bool_Bool |
157 | csh_glob(pTHX_ AV *entries, const char *pat, STRLEN len, bool_Bool is_utf8) |
158 | { |
159 | dSPSV **sp = PL_stack_sp; |
160 | AV *patav = NULL((void*)0); |
161 | const char *patend; |
162 | const char *s = NULL((void*)0); |
163 | const char *piece = NULL((void*)0); |
164 | SV *word = NULL((void*)0); |
165 | SV *flags_sv = get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD)Perl_get_sv( "File::Glob::DEFAULT_FLAGS",0x01); |
166 | int const flags = (int)SvIV(flags_sv)((((flags_sv)->sv_flags & (0x00000100|0x00200000)) == 0x00000100 ) ? ((XPVIV*) (flags_sv)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags ( flags_sv,2)); |
167 | U32 const gimme = GIMME_VPerl_gimme_V(); |
168 | |
169 | patend = pat + len; |
170 | |
171 | assert(SvTYPE(entries) != SVt_PVAV)((void)0); |
172 | sv_upgrade((SV *)entries, SVt_PVAV)Perl_sv_upgrade( (SV *)entries,SVt_PVAV); |
173 | |
174 | /* extract patterns */ |
175 | s = pat-1; |
176 | while (++s < patend) { |
177 | switch (*s) { |
178 | case '\'': |
179 | case '"' : |
180 | { |
181 | bool_Bool found = FALSE(0); |
182 | const char quote = *s; |
183 | if (!word) { |
184 | word = newSVpvs("")Perl_newSVpvn( ("" "" ""), (sizeof("")-1)); |
185 | if (is_utf8) SvUTF8_on(word)((word)->sv_flags |= (0x20000000)); |
186 | } |
187 | if (piece) sv_catpvn(word, piece, s-piece)Perl_sv_catpvn_flags( word,piece,s-piece,2); |
188 | piece = s+1; |
189 | while (++s < patend) |
190 | if (*s == '\\') { |
191 | s++; |
192 | /* If the backslash is here to escape a quote, |
193 | obliterate it. */ |
194 | if (s < patend && *s == quote) |
195 | sv_catpvn(word, piece, s-piece-1)Perl_sv_catpvn_flags( word,piece,s-piece-1,2), piece = s; |
196 | } |
197 | else if (*s == quote) { |
198 | sv_catpvn(word, piece, s-piece)Perl_sv_catpvn_flags( word,piece,s-piece,2); |
199 | piece = NULL((void*)0); |
200 | found = TRUE(1); |
201 | break; |
202 | } |
203 | if (!found) { /* unmatched quote */ |
204 | /* Give up on tokenisation and treat the whole string |
205 | as a single token, but with whitespace stripped. */ |
206 | piece = pat; |
Value stored to 'piece' is never read | |
207 | while (isSPACE(*pat)(( (sizeof(*pat) == 1) || !(((U64)((*pat) | 0)) & ~0xFF)) && ((PL_charclass[(U8) (*pat)] & ((1U << ( 10)) | (1U << (14)))) == ((1U << (10)) | (1U << (14)))))) pat++; |
208 | while (isSPACE(*(patend-1))(( (sizeof(*(patend-1)) == 1) || !(((U64)((*(patend-1)) | 0)) & ~0xFF)) && ((PL_charclass[(U8) (*(patend-1))] & ((1U << (10)) | (1U << (14)))) == ((1U << ( 10)) | (1U << (14)))))) patend--; |
209 | /* bsd_glob expects a trailing null, but we cannot mod- |
210 | ify the original */ |
211 | if (patend < pat + len) { |
212 | if (word) sv_setpvn(word, pat, patend-pat)Perl_sv_setpvn( word,pat,patend-pat); |
213 | else |
214 | word = newSVpvn_flags(Perl_newSVpvn_flags( pat,patend-pat,0x20000000*is_utf8) |
215 | pat, patend-pat, SVf_UTF8*is_utf8Perl_newSVpvn_flags( pat,patend-pat,0x20000000*is_utf8) |
216 | )Perl_newSVpvn_flags( pat,patend-pat,0x20000000*is_utf8); |
217 | piece = NULL((void*)0); |
218 | } |
219 | else { |
220 | if (word) SvREFCNT_dec(word)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (word); _p; }))), word=NULL((void*)0); |
221 | piece = pat; |
222 | s = patend; |
223 | } |
224 | goto end_of_parsing; |
225 | } |
226 | break; |
227 | } |
228 | case '\\': |
229 | if (!piece) piece = s; |
230 | s++; |
231 | /* If the backslash is here to escape a quote, |
232 | obliterate it. */ |
233 | if (s < patend && (*s == '"' || *s == '\'')) { |
234 | if (!word) { |
235 | word = newSVpvn(piece,s-piece-1)Perl_newSVpvn( piece,s-piece-1); |
236 | if (is_utf8) SvUTF8_on(word)((word)->sv_flags |= (0x20000000)); |
237 | } |
238 | else sv_catpvn(word, piece, s-piece-1)Perl_sv_catpvn_flags( word,piece,s-piece-1,2); |
239 | piece = s; |
240 | } |
241 | break; |
242 | default: |
243 | if (isSPACE(*s)(( (sizeof(*s) == 1) || !(((U64)((*s) | 0)) & ~0xFF)) && ((PL_charclass[(U8) (*s)] & ((1U << (10)) | (1U << (14)))) == ((1U << (10)) | (1U << (14)))))) { |
244 | if (piece) { |
245 | if (!word) { |
246 | word = newSVpvn(piece,s-piece)Perl_newSVpvn( piece,s-piece); |
247 | if (is_utf8) SvUTF8_on(word)((word)->sv_flags |= (0x20000000)); |
248 | } |
249 | else sv_catpvn(word, piece, s-piece)Perl_sv_catpvn_flags( word,piece,s-piece,2); |
250 | } |
251 | if (!word) break; |
252 | if (!patav) patav = (AV *)sv_2mortal((SV *)newAV())Perl_sv_2mortal( (SV *)((AV *)({ void *_p = (Perl_newSV_type( SVt_PVAV)); _p; }))); |
253 | av_push(patav, word)Perl_av_push( patav,word); |
254 | word = NULL((void*)0); |
255 | piece = NULL((void*)0); |
256 | } |
257 | else if (!piece) piece = s; |
258 | break; |
259 | } |
260 | } |
261 | end_of_parsing: |
262 | |
263 | if (patav) { |
264 | I32 items = AvFILLp(patav)((XPVAV*) (patav)->sv_any)->xav_fill + 1; |
265 | SV **svp = AvARRAY(patav)((patav)->sv_u.svu_array); |
266 | while (items--) { |
267 | 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); |
268 | PUTBACKPL_stack_sp = sp; |
269 | doglob(aTHX_ SvPVXx(*svp++)((*svp++)->sv_u.svu_pv), flags); |
270 | SPAGAINsp = PL_stack_sp; |
271 | { |
272 | dMARKSV **mark = PL_stack_base + Perl_POPMARK(); |
273 | dORIGMARKconst I32 origmark = (I32)(mark - PL_stack_base); |
274 | while (++MARKmark <= SPsp) |
275 | av_push(entries, SvREFCNT_inc_simple_NN(*MARK))Perl_av_push( entries,(++((*mark)->sv_refcnt),((SV *)({ void *_p = (*mark); _p; })))); |
276 | SPsp = ORIGMARK(PL_stack_base + origmark); |
277 | } |
278 | } |
279 | } |
280 | /* piece is set at this point if there is no trailing whitespace. |
281 | It is the beginning of the last token or quote-delimited |
282 | piece thereof. word is set at this point if the last token has |
283 | multiple quoted pieces. */ |
284 | if (piece || word) { |
285 | if (word) { |
286 | if (piece) sv_catpvn(word, piece, s-piece)Perl_sv_catpvn_flags( word,piece,s-piece,2); |
287 | piece = SvPVX(word)((word)->sv_u.svu_pv); |
288 | } |
289 | 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); |
290 | PUTBACKPL_stack_sp = sp; |
291 | doglob(aTHX_ piece, flags); |
292 | if (word) SvREFCNT_dec(word)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (word); _p; }))); |
293 | SPAGAINsp = PL_stack_sp; |
294 | { |
295 | dMARKSV **mark = PL_stack_base + Perl_POPMARK(); |
296 | dORIGMARKconst I32 origmark = (I32)(mark - PL_stack_base); |
297 | /* short-circuit here for a fairly common case */ |
298 | if (!patav && gimme == G_ARRAY3) { PUTBACKPL_stack_sp = sp; return TRUE(1); } |
299 | while (++MARKmark <= SPsp) |
300 | av_push(entries, SvREFCNT_inc_simple_NN(*MARK))Perl_av_push( entries,(++((*mark)->sv_refcnt),((SV *)({ void *_p = (*mark); _p; })))); |
301 | |
302 | SPsp = ORIGMARK(PL_stack_base + origmark); |
303 | } |
304 | } |
305 | PUTBACKPL_stack_sp = sp; |
306 | return FALSE(0); |
307 | } |
308 | |
309 | static void |
310 | csh_glob_iter(pTHXvoid) |
311 | { |
312 | iterate(aTHX_ csh_glob); |
313 | } |
314 | |
315 | /* wrapper around doglob that can be passed to the iterator */ |
316 | static bool_Bool |
317 | doglob_iter_wrapper(pTHX_ AV *entries, const char *pattern, STRLEN len, bool_Bool is_utf8) |
318 | { |
319 | dSPSV **sp = PL_stack_sp; |
320 | SV * flags_sv = get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD)Perl_get_sv( "File::Glob::DEFAULT_FLAGS",0x01); |
321 | int const flags = (int)SvIV(flags_sv)((((flags_sv)->sv_flags & (0x00000100|0x00200000)) == 0x00000100 ) ? ((XPVIV*) (flags_sv)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags ( flags_sv,2)); |
322 | |
323 | PERL_UNUSED_VAR(len)((void)sizeof(len)); /* we use \0 termination instead */ |
324 | /* XXX we currently just use the underlying bytes of the passed SV. |
325 | * Some day someone needs to make glob utf8 aware */ |
326 | PERL_UNUSED_VAR(is_utf8)((void)sizeof(is_utf8)); |
327 | |
328 | 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); |
329 | PUTBACKPL_stack_sp = sp; |
330 | doglob(aTHX_ pattern, flags); |
331 | SPAGAINsp = PL_stack_sp; |
332 | { |
333 | dMARKSV **mark = PL_stack_base + Perl_POPMARK(); |
334 | dORIGMARKconst I32 origmark = (I32)(mark - PL_stack_base); |
335 | if (GIMME_VPerl_gimme_V() == G_ARRAY3) { PUTBACKPL_stack_sp = sp; return TRUE(1); } |
336 | sv_upgrade((SV *)entries, SVt_PVAV)Perl_sv_upgrade( (SV *)entries,SVt_PVAV); |
337 | while (++MARKmark <= SPsp) |
338 | av_push(entries, SvREFCNT_inc_simple_NN(*MARK))Perl_av_push( entries,(++((*mark)->sv_refcnt),((SV *)({ void *_p = (*mark); _p; })))); |
339 | SPsp = ORIGMARK(PL_stack_base + origmark); |
340 | } |
341 | return FALSE(0); |
342 | } |
343 | |
344 | static void |
345 | glob_ophook(pTHX_ OP *o) |
346 | { |
347 | if (PL_dirty((PL_phase == PERL_PHASE_DESTRUCT) ? (_Bool)1 : (_Bool)0)) return; |
348 | { |
349 | dMY_CXTstruct Perl___notused_struct; |
350 | if (MY_CXTmy_cxt.x_GLOB_ENTRIES |
351 | && (o->op_type == OP_GLOB || o->op_type == OP_ENTERSUB)) |
352 | (void)hv_delete(MY_CXT.x_GLOB_ENTRIES, (char *)&o, sizeof(OP *),(((SV *)({ void *_p = (Perl_hv_common_key_len( (my_cxt.x_GLOB_ENTRIES ),((char *)&o),(sizeof(OP *)),(0x4) | 0x40,((void*)0),0)) ; _p; }))) |
353 | G_DISCARD)(((SV *)({ void *_p = (Perl_hv_common_key_len( (my_cxt.x_GLOB_ENTRIES ),((char *)&o),(sizeof(OP *)),(0x4) | 0x40,((void*)0),0)) ; _p; }))); |
354 | if (MY_CXTmy_cxt.x_GLOB_OLD_OPHOOK) MY_CXTmy_cxt.x_GLOB_OLD_OPHOOK(aTHX_ o); |
355 | } |
356 | } |
357 | |
358 | #line 359 "Glob.c" |
359 | #ifndef PERL_UNUSED_VAR |
360 | # define PERL_UNUSED_VAR(var)((void)sizeof(var)) if (0) var = var |
361 | #endif |
362 | |
363 | #ifndef dVARstruct Perl___notused_struct |
364 | # define dVARstruct Perl___notused_struct dNOOPstruct Perl___notused_struct |
365 | #endif |
366 | |
367 | |
368 | /* This stuff is not part of the API! You have been warned. */ |
369 | #ifndef PERL_VERSION_DECIMAL |
370 | # define PERL_VERSION_DECIMAL(r,v,s)(r*1000000 + v*1000 + s) (r*1000000 + v*1000 + s) |
371 | #endif |
372 | #ifndef PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) |
373 | # define PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) \ |
374 | PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)(5*1000000 + 32*1000 + 1) |
375 | #endif |
376 | #ifndef PERL_VERSION_GE |
377 | # define PERL_VERSION_GE(r,v,s)((5*1000000 + 32*1000 + 1) >= (r*1000000 + v*1000 + s)) \ |
378 | (PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) >= PERL_VERSION_DECIMAL(r,v,s)(r*1000000 + v*1000 + s)) |
379 | #endif |
380 | #ifndef PERL_VERSION_LE |
381 | # define PERL_VERSION_LE(r,v,s)((5*1000000 + 32*1000 + 1) <= (r*1000000 + v*1000 + s)) \ |
382 | (PERL_DECIMAL_VERSION(5*1000000 + 32*1000 + 1) <= PERL_VERSION_DECIMAL(r,v,s)(r*1000000 + v*1000 + s)) |
383 | #endif |
384 | |
385 | /* XS_INTERNAL is the explicit static-linkage variant of the default |
386 | * XS macro. |
387 | * |
388 | * XS_EXTERNAL is the same as XS_INTERNAL except it does not include |
389 | * "STATIC", ie. it exports XSUB symbols. You probably don't want that |
390 | * for anything but the BOOT XSUB. |
391 | * |
392 | * See XSUB.h in core! |
393 | */ |
394 | |
395 | |
396 | /* TODO: This might be compatible further back than 5.10.0. */ |
397 | #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)) |
398 | # undef XS_EXTERNAL |
399 | # undef XS_INTERNAL |
400 | # if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING) |
401 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) __declspec(dllexport) XSPROTO(name)void name( CV* cv __attribute__((unused))) |
402 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) STATICstatic XSPROTO(name)void name( CV* cv __attribute__((unused))) |
403 | # endif |
404 | # if defined(__SYMBIAN32__) |
405 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) EXPORT_C XSPROTO(name)void name( CV* cv __attribute__((unused))) |
406 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) EXPORT_C STATICstatic XSPROTO(name)void name( CV* cv __attribute__((unused))) |
407 | # endif |
408 | # ifndef XS_EXTERNAL |
409 | # if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus) |
410 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) void name(pTHX_ CV* cv __attribute__unused____attribute__((unused))) |
411 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) STATICstatic void name(pTHX_ CV* cv __attribute__unused____attribute__((unused))) |
412 | # else |
413 | # ifdef __cplusplus |
414 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) extern "C" XSPROTO(name)void name( CV* cv __attribute__((unused))) |
415 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) static XSPROTO(name)void name( CV* cv __attribute__((unused))) |
416 | # else |
417 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) XSPROTO(name)void name( CV* cv __attribute__((unused))) |
418 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) STATICstatic XSPROTO(name)void name( CV* cv __attribute__((unused))) |
419 | # endif |
420 | # endif |
421 | # endif |
422 | #endif |
423 | |
424 | /* perl >= 5.10.0 && perl <= 5.15.1 */ |
425 | |
426 | |
427 | /* The XS_EXTERNAL macro is used for functions that must not be static |
428 | * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL |
429 | * macro defined, the best we can do is assume XS is the same. |
430 | * Dito for XS_INTERNAL. |
431 | */ |
432 | #ifndef XS_EXTERNAL |
433 | # define XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) XS(name)void name( CV* cv __attribute__((unused))) |
434 | #endif |
435 | #ifndef XS_INTERNAL |
436 | # define XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) XS(name)void name( CV* cv __attribute__((unused))) |
437 | #endif |
438 | |
439 | /* Now, finally, after all this mess, we want an ExtUtils::ParseXS |
440 | * internal macro that we're free to redefine for varying linkage due |
441 | * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use |
442 | * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to! |
443 | */ |
444 | |
445 | #undef XS_EUPXS |
446 | #if defined(PERL_EUPXS_ALWAYS_EXPORT) |
447 | # define XS_EUPXS(name)static void name( CV* cv __attribute__((unused))) XS_EXTERNAL(name)void name( CV* cv __attribute__((unused))) |
448 | #else |
449 | /* default to internal */ |
450 | # define XS_EUPXS(name)static void name( CV* cv __attribute__((unused))) XS_INTERNAL(name)static void name( CV* cv __attribute__((unused))) |
451 | #endif |
452 | |
453 | #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0) |
454 | #define PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0) assert(cv)((void)0); assert(params)((void)0) |
455 | |
456 | /* prototype to pass -Wmissing-prototypes */ |
457 | STATICstatic void |
458 | S_croak_xs_usage(const CV *const cv, const char *const params); |
459 | |
460 | STATICstatic void |
461 | S_croak_xs_usage(const CV *const cv, const char *const params) |
462 | { |
463 | const GV *const gv = CvGV(cv)Perl_CvGV( (CV *)(cv)); |
464 | |
465 | PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0); |
466 | |
467 | if (gv) { |
468 | const char *const gvname = GvNAME(gv)((((XPVGV*)(gv)->sv_any)->xiv_u.xivu_namehek))->hek_key; |
469 | const HV *const stash = GvSTASH(gv)(((XPVGV*)(gv)->sv_any)->xnv_u.xgv_stash); |
470 | 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); |
471 | |
472 | if (hvname) |
473 | Perl_croak_nocontextPerl_croak("Usage: %s::%s(%s)", hvname, gvname, params); |
474 | else |
475 | Perl_croak_nocontextPerl_croak("Usage: %s(%s)", gvname, params); |
476 | } else { |
477 | /* Pants. I don't think that it should be possible to get here. */ |
478 | Perl_croak_nocontextPerl_croak("Usage: CODE(0x%" UVxf"lx" ")(%s)", PTR2UV(cv)(UV)(cv), params); |
479 | } |
480 | } |
481 | #undef PERL_ARGS_ASSERT_CROAK_XS_USAGE((void)0); ((void)0) |
482 | |
483 | #define croak_xs_usagePerl_croak_xs_usage S_croak_xs_usage |
484 | |
485 | #endif |
486 | |
487 | /* NOTE: the prototype of newXSproto() is different in versions of perls, |
488 | * so we define a portable version of newXSproto() |
489 | */ |
490 | #ifdef newXS_flags |
491 | #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) |
492 | #else |
493 | #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) |
494 | #endif /* !defined(newXS_flags) */ |
495 | |
496 | #if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5)) |
497 | # define newXS_deffile(a,b)Perl_newXS_deffile( a,b) Perl_newXS(aTHX_ a,b,file) |
498 | #else |
499 | # define newXS_deffile(a,b)Perl_newXS_deffile( a,b) Perl_newXS_deffile(aTHX_ a,b) |
500 | #endif |
501 | |
502 | #line 503 "Glob.c" |
503 | |
504 | XS_EUPXS(XS_File__Glob_GLOB_ERROR)static void XS_File__Glob_GLOB_ERROR( CV* cv __attribute__((unused ))); /* prototype to pass -Wmissing-prototypes */ |
505 | XS_EUPXS(XS_File__Glob_GLOB_ERROR)static void XS_File__Glob_GLOB_ERROR( CV* cv __attribute__((unused ))) |
506 | { |
507 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
508 | if (items != 0) |
509 | croak_xs_usagePerl_croak_xs_usage(cv, ""); |
510 | { |
511 | #line 354 "Glob.xs" |
512 | dMY_CXTstruct Perl___notused_struct; |
513 | #line 514 "Glob.c" |
514 | int RETVAL; |
515 | dXSTARGSV * const targ = ((PL_op->op_private & 0x04) ? (PL_curpad [PL_op->op_targ]) : Perl_sv_newmortal()); |
516 | #line 356 "Glob.xs" |
517 | RETVAL = GLOB_ERROR(my_cxt.x_GLOB_ERROR); |
518 | #line 519 "Glob.c" |
519 | 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); |
520 | } |
521 | XSRETURN(1)do { const IV tmpXSoff = (1); ((void)0); PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); return; } while (0); |
522 | } |
523 | |
524 | |
525 | XS_EUPXS(XS_File__Glob_bsd_glob)static void XS_File__Glob_bsd_glob( CV* cv __attribute__((unused ))); /* prototype to pass -Wmissing-prototypes */ |
526 | XS_EUPXS(XS_File__Glob_bsd_glob)static void XS_File__Glob_bsd_glob( CV* cv __attribute__((unused ))) |
527 | { |
528 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
529 | if (items < 1) |
530 | croak_xs_usagePerl_croak_xs_usage(cv, "pattern_sv, ..."); |
531 | PERL_UNUSED_VAR(ax)((void)sizeof(ax)); /* -Wall */ |
532 | SPsp -= items; |
533 | { |
534 | SV * pattern_sv = ST(0)PL_stack_base[ax + (0)] |
535 | ; |
536 | #line 364 "Glob.xs" |
537 | int flags = 0; |
538 | char *pattern; |
539 | STRLEN len; |
540 | #line 541 "Glob.c" |
541 | #line 368 "Glob.xs" |
542 | { |
543 | pattern = SvPV(pattern_sv, len)((((pattern_sv)->sv_flags & (0x00000400|0x00200000)) == 0x00000400) ? ((len = ((XPV*) (pattern_sv)->sv_any)->xpv_cur ), ((pattern_sv)->sv_u.svu_pv)) : Perl_sv_2pv_flags( pattern_sv ,&len,2)); |
544 | if (!IS_SAFE_SYSCALL(pattern, len, "pattern", "bsd_glob")(Perl_is_safe_syscall( (pattern), (len), ("pattern"), ("bsd_glob" )))) |
545 | XSRETURN(0)do { const IV tmpXSoff = (0); ((void)0); PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); return; } while (0); |
546 | /* allow for optional flags argument */ |
547 | if (items > 1) { |
548 | flags = (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)); |
549 | /* remove unsupported flags */ |
550 | flags &= ~(GLOB_APPEND0x0001 | GLOB_DOOFFS0x0002 | GLOB_ALTDIRFUNC0x0040 | GLOB_MAGCHAR0x0100); |
551 | } else { |
552 | SV * flags_sv = get_sv("File::Glob::DEFAULT_FLAGS", GV_ADD)Perl_get_sv( "File::Glob::DEFAULT_FLAGS",0x01); |
553 | flags = (int)SvIV(flags_sv)((((flags_sv)->sv_flags & (0x00000100|0x00200000)) == 0x00000100 ) ? ((XPVIV*) (flags_sv)->sv_any)->xiv_u.xivu_iv : Perl_sv_2iv_flags ( flags_sv,2)); |
554 | } |
555 | |
556 | PUTBACKPL_stack_sp = sp; |
557 | doglob(aTHX_ pattern, flags); |
558 | SPAGAINsp = PL_stack_sp; |
559 | } |
560 | #line 561 "Glob.c" |
561 | PUTBACKPL_stack_sp = sp; |
562 | return; |
563 | } |
564 | } |
565 | |
566 | |
567 | XS_EUPXS(XS_File__Glob_csh_glob)static void XS_File__Glob_csh_glob( CV* cv __attribute__((unused ))); /* prototype to pass -Wmissing-prototypes */ |
568 | XS_EUPXS(XS_File__Glob_csh_glob)static void XS_File__Glob_csh_glob( CV* cv __attribute__((unused ))) |
569 | { |
570 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
571 | PERL_UNUSED_VAR(cv)((void)sizeof(cv)); /* -W */ |
572 | PERL_UNUSED_VAR(items)((void)sizeof(items)); /* -W */ |
573 | PERL_UNUSED_VAR(ax)((void)sizeof(ax)); /* -Wall */ |
574 | SPsp -= items; |
575 | { |
576 | #line 391 "Glob.xs" |
577 | /* For backward-compatibility with the original Perl function, we sim- |
578 | * ply take the first argument, regardless of how many there are. |
579 | */ |
580 | if (items) SPsp ++; |
581 | else { |
582 | XPUSHs(&PL_sv_undef)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 = (&(PL_sv_immortals[1])); } while (0); |
583 | } |
584 | PUTBACKPL_stack_sp = sp; |
585 | csh_glob_iter(aTHX); |
586 | SPAGAINsp = PL_stack_sp; |
587 | #line 588 "Glob.c" |
588 | PUTBACKPL_stack_sp = sp; |
589 | return; |
590 | } |
591 | } |
592 | |
593 | |
594 | XS_EUPXS(XS_File__Glob_bsd_glob_override)static void XS_File__Glob_bsd_glob_override( CV* cv __attribute__ ((unused))); /* prototype to pass -Wmissing-prototypes */ |
595 | XS_EUPXS(XS_File__Glob_bsd_glob_override)static void XS_File__Glob_bsd_glob_override( CV* cv __attribute__ ((unused))) |
596 | { |
597 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
598 | PERL_UNUSED_VAR(cv)((void)sizeof(cv)); /* -W */ |
599 | PERL_UNUSED_VAR(items)((void)sizeof(items)); /* -W */ |
600 | PERL_UNUSED_VAR(ax)((void)sizeof(ax)); /* -Wall */ |
601 | SPsp -= items; |
602 | { |
603 | #line 405 "Glob.xs" |
604 | if (items) SPsp ++; |
605 | else { |
606 | XPUSHs(&PL_sv_undef)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 = (&(PL_sv_immortals[1])); } while (0); |
607 | } |
608 | PUTBACKPL_stack_sp = sp; |
609 | iterate(aTHX_ doglob_iter_wrapper); |
610 | SPAGAINsp = PL_stack_sp; |
611 | #line 612 "Glob.c" |
612 | PUTBACKPL_stack_sp = sp; |
613 | return; |
614 | } |
615 | } |
616 | |
617 | #ifdef USE_ITHREADS |
618 | #define XSubPPtmpAAAA 1 |
619 | |
620 | |
621 | XS_EUPXS(XS_File__Glob_CLONE)static void XS_File__Glob_CLONE( CV* cv __attribute__((unused ))); /* prototype to pass -Wmissing-prototypes */ |
622 | XS_EUPXS(XS_File__Glob_CLONE)static void XS_File__Glob_CLONE( CV* cv __attribute__((unused ))) |
623 | { |
624 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
625 | PERL_UNUSED_VAR(cv)((void)sizeof(cv)); /* -W */ |
626 | PERL_UNUSED_VAR(items)((void)sizeof(items)); /* -W */ |
627 | { |
628 | #line 418 "Glob.xs" |
629 | HV *glob_entries_clone = NULL((void*)0); |
630 | #line 631 "Glob.c" |
631 | #line 420 "Glob.xs" |
632 | PERL_UNUSED_ARG(items)((void)sizeof(items)); |
633 | { |
634 | dMY_CXTstruct Perl___notused_struct; |
635 | if ( MY_CXTmy_cxt.x_GLOB_ENTRIES ) { |
636 | CLONE_PARAMS param; |
637 | param.stashes = NULL((void*)0); |
638 | param.flags = 0; |
639 | param.proto_perl = MY_CXTmy_cxt.interp; |
640 | |
641 | glob_entries_clone = MUTABLE_HV(sv_dup_inc((SV*)MY_CXT.x_GLOB_ENTRIES, ¶m))((HV *)({ void *_p = (sv_dup_inc((SV*)my_cxt.x_GLOB_ENTRIES, & param)); _p; })); |
642 | } |
643 | } |
644 | { |
645 | MY_CXT_CLONE(void)0; |
646 | MY_CXTmy_cxt.x_GLOB_ENTRIES = glob_entries_clone; |
647 | MY_CXTmy_cxt.interp = aTHX; |
648 | } |
649 | #line 650 "Glob.c" |
650 | } |
651 | XSRETURN_EMPTYdo { do { const IV tmpXSoff = (0); ((void)0); PL_stack_sp = PL_stack_base + ax + (tmpXSoff - 1); return; } while (0); } while (0); |
652 | } |
653 | |
654 | #endif |
655 | |
656 | /* INCLUDE: Including 'const-xs.inc' from 'Glob.xs' */ |
657 | |
658 | |
659 | XS_EUPXS(XS_File__Glob_AUTOLOAD)static void XS_File__Glob_AUTOLOAD( CV* cv __attribute__((unused ))); /* prototype to pass -Wmissing-prototypes */ |
660 | XS_EUPXS(XS_File__Glob_AUTOLOAD)static void XS_File__Glob_AUTOLOAD( CV* cv __attribute__((unused ))) |
661 | { |
662 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
663 | if (items != 0) |
664 | croak_xs_usagePerl_croak_xs_usage(cv, ""); |
665 | PERL_UNUSED_VAR(ax)((void)sizeof(ax)); /* -Wall */ |
666 | SPsp -= items; |
667 | { |
668 | #line 120 "./const-xs.inc" |
669 | SV *sv = newSVpvn_flags(SvPVX(cv), SvCUR(cv), SVs_TEMP | SvUTF8(cv))Perl_newSVpvn_flags( ((cv)->sv_u.svu_pv),((XPV*) (cv)-> sv_any)->xpv_cur,0x00080000 | ((cv)->sv_flags & 0x20000000 )); |
670 | const COP *cop = PL_curcop; |
671 | #line 672 "Glob.c" |
672 | #line 123 "./const-xs.inc" |
673 | #ifndef SYMBIAN |
674 | /* It's not obvious how to calculate this at C pre-processor time. |
675 | However, any compiler optimiser worth its salt should be able to |
676 | remove the dead code, and hopefully the now-obviously-unused static |
677 | function too. */ |
678 | HV *constant_missing = (C_ARRAY_LENGTH(values_for_notfound)(sizeof(values_for_notfound)/sizeof((values_for_notfound)[0]) ) > 1) |
679 | ? get_missing_hash(aTHX) : NULL((void*)0); |
680 | if ((C_ARRAY_LENGTH(values_for_notfound)(sizeof(values_for_notfound)/sizeof((values_for_notfound)[0]) ) > 1) |
681 | ? hv_exists_ent(constant_missing, sv, 0)((Perl_hv_common( (constant_missing),(sv),((void*)0),0,0,0x08 ,0,(0))) ? (_Bool)1 : (_Bool)0) : 0) { |
682 | sv = newSVpvfPerl_newSVpvf("Your vendor has not defined File::Glob macro %" SVf"-p" |
683 | ", used at %" COP_FILE_F"-p" " line %" UVuf"lu" "\n", |
684 | sv, COP_FILE(cop)(((cop)->cop_filegv) ? ((0+(((cop)->cop_filegv))->sv_u .svu_gp)->gp_sv) : ((void*)0)), (UV)CopLINE(cop)((cop)->cop_line)); |
685 | } else |
686 | #endif |
687 | { |
688 | sv = newSVpvfPerl_newSVpvf("%" SVf"-p" |
689 | " is not a valid File::Glob macro at %" |
690 | COP_FILE_F"-p" " line %" UVuf"lu" "\n", |
691 | sv, COP_FILE(cop)(((cop)->cop_filegv) ? ((0+(((cop)->cop_filegv))->sv_u .svu_gp)->gp_sv) : ((void*)0)), (UV)CopLINE(cop)((cop)->cop_line)); |
692 | } |
693 | croak_sv(sv_2mortal(sv))Perl_croak_sv( Perl_sv_2mortal( sv)); |
694 | #line 695 "Glob.c" |
695 | PUTBACKPL_stack_sp = sp; |
696 | return; |
697 | } |
698 | } |
699 | |
700 | |
701 | /* INCLUDE: Returning to 'Glob.xs' from 'const-xs.inc' */ |
702 | |
703 | #ifdef __cplusplus |
704 | extern "C" |
705 | #endif |
706 | XS_EXTERNAL(boot_File__Glob)void boot_File__Glob( CV* cv __attribute__((unused))); /* prototype to pass -Wmissing-prototypes */ |
707 | XS_EXTERNAL(boot_File__Glob)void boot_File__Glob( CV* cv __attribute__((unused))) |
708 | { |
709 | #if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5)) |
710 | dVARstruct Perl___notused_struct; dXSARGSSV **sp = PL_stack_sp; I32 ax = Perl_POPMARK(); SV **mark = PL_stack_base + ax++; I32 items = (I32)(sp - mark); |
711 | #else |
712 | dVARstruct Perl___notused_struct; dXSBOOTARGSXSAPIVERCHKI32 ax = Perl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter )) << 16) | ((sizeof("" "1.33" "")-1) > 0xFF ? (Perl_croak ("panic: handshake overflow"), 0xFF) : (sizeof("" "1.33" "")- 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, "Glob.c", "v" "5" "." "32" "." "0", "1.33"); SV **mark = PL_stack_base + ax; SV **sp = PL_stack_sp; I32 items = (I32) (sp - mark); |
713 | #endif |
714 | #if (PERL_REVISION5 == 5 && PERL_VERSION32 < 9) |
715 | char* file = __FILE__"Glob.c"; |
716 | #else |
717 | const char* file = __FILE__"Glob.c"; |
718 | #endif |
719 | |
720 | PERL_UNUSED_VAR(file)((void)sizeof(file)); |
721 | |
722 | PERL_UNUSED_VAR(cv)((void)sizeof(cv)); /* -W */ |
723 | PERL_UNUSED_VAR(items)((void)sizeof(items)); /* -W */ |
724 | #if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5)) |
725 | XS_VERSION_BOOTCHECKPerl_xs_handshake((((sizeof(struct PerlHandShakeInterpreter)) << 16) | ((sizeof("" "1.33" "")-1) > 0xFF ? (Perl_croak ("panic: handshake overflow"), 0xFF) : (sizeof("" "1.33" "")- 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, "Glob.c", items, ax, "1.33"); |
726 | # 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, "Glob.c", items, ax, "v" "5" "." "32" "." "0") |
727 | 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, "Glob.c", items, ax, "v" "5" "." "32" "." "0"); |
728 | # endif |
729 | #endif |
730 | |
731 | newXS_deffile("File::Glob::GLOB_ERROR", XS_File__Glob_GLOB_ERROR)Perl_newXS_deffile( "File::Glob::GLOB_ERROR",XS_File__Glob_GLOB_ERROR ); |
732 | newXS_deffile("File::Glob::bsd_glob", XS_File__Glob_bsd_glob)Perl_newXS_deffile( "File::Glob::bsd_glob",XS_File__Glob_bsd_glob ); |
733 | newXS_deffile("File::Glob::csh_glob", XS_File__Glob_csh_glob)Perl_newXS_deffile( "File::Glob::csh_glob",XS_File__Glob_csh_glob ); |
734 | newXS_deffile("File::Glob::bsd_glob_override", XS_File__Glob_bsd_glob_override)Perl_newXS_deffile( "File::Glob::bsd_glob_override",XS_File__Glob_bsd_glob_override ); |
735 | #if XSubPPtmpAAAA |
736 | newXS_deffile("File::Glob::CLONE", XS_File__Glob_CLONE)Perl_newXS_deffile( "File::Glob::CLONE",XS_File__Glob_CLONE); |
737 | #endif |
738 | newXS_deffile("File::Glob::AUTOLOAD", XS_File__Glob_AUTOLOAD)Perl_newXS_deffile( "File::Glob::AUTOLOAD",XS_File__Glob_AUTOLOAD ); |
739 | |
740 | /* Initialisation Section */ |
741 | |
742 | #if XSubPPtmpAAAA |
743 | #endif |
744 | #line 441 "Glob.xs" |
745 | { |
746 | #ifndef PERL_EXTERNAL_GLOB |
747 | /* Don't do this at home! The globhook interface is highly volatile. */ |
748 | PL_globhook = csh_glob_iter; |
749 | #endif |
750 | } |
751 | |
752 | #line 449 "Glob.xs" |
753 | { |
754 | MY_CXT_INIT(void)0; |
755 | { |
756 | dMY_CXTstruct Perl___notused_struct; |
757 | MY_CXTmy_cxt.x_GLOB_ENTRIES = NULL((void*)0); |
758 | MY_CXTmy_cxt.x_GLOB_OLD_OPHOOK = PL_opfreehook; |
759 | #ifdef USE_ITHREADS |
760 | MY_CXTmy_cxt.interp = aTHX; |
761 | #endif |
762 | PL_opfreehook = glob_ophook; |
763 | } |
764 | } |
765 | |
766 | #line 2 "./const-xs.inc" |
767 | { |
768 | #if defined(dTHXstruct Perl___notused_struct) && !defined(PERL_NO_GET_CONTEXT) |
769 | dTHXstruct Perl___notused_struct; |
770 | #endif |
771 | HV *symbol_table = get_hv("File::Glob::", GV_ADD)Perl_get_hv( "File::Glob::",0x01); |
772 | |
773 | static const struct iv_s values_for_iv[] = |
774 | { |
775 | #ifdef GLOB_ABEND(-2) |
776 | { "GLOB_ABEND", 10, GLOB_ABEND(-2) }, |
777 | #endif |
778 | #ifdef GLOB_ALPHASORT0x2000 |
779 | { "GLOB_ALPHASORT", 14, GLOB_ALPHASORT0x2000 }, |
780 | #endif |
781 | #ifdef GLOB_ALTDIRFUNC0x0040 |
782 | { "GLOB_ALTDIRFUNC", 15, GLOB_ALTDIRFUNC0x0040 }, |
783 | #endif |
784 | #ifdef GLOB_BRACE0x0080 |
785 | { "GLOB_BRACE", 10, GLOB_BRACE0x0080 }, |
786 | #endif |
787 | #ifdef GLOB_ERR0x0004 |
788 | { "GLOB_ERR", 8, GLOB_ERR0x0004 }, |
789 | #endif |
790 | #ifdef GLOB_LIMIT0x4000 |
791 | { "GLOB_LIMIT", 10, GLOB_LIMIT0x4000 }, |
792 | #endif |
793 | #ifdef GLOB_MARK0x0008 |
794 | { "GLOB_MARK", 9, GLOB_MARK0x0008 }, |
795 | #endif |
796 | #ifdef GLOB_NOCASE0x1000 |
797 | { "GLOB_NOCASE", 11, GLOB_NOCASE0x1000 }, |
798 | #endif |
799 | #ifdef GLOB_NOCHECK0x0010 |
800 | { "GLOB_NOCHECK", 12, GLOB_NOCHECK0x0010 }, |
801 | #endif |
802 | #ifdef GLOB_NOMAGIC0x0200 |
803 | { "GLOB_NOMAGIC", 12, GLOB_NOMAGIC0x0200 }, |
804 | #endif |
805 | #ifdef GLOB_NOSORT0x0020 |
806 | { "GLOB_NOSORT", 11, GLOB_NOSORT0x0020 }, |
807 | #endif |
808 | #ifdef GLOB_NOSPACE(-1) |
809 | { "GLOB_NOSPACE", 12, GLOB_NOSPACE(-1) }, |
810 | #endif |
811 | #ifdef GLOB_QUOTE0x0400 |
812 | { "GLOB_QUOTE", 10, GLOB_QUOTE0x0400 }, |
813 | #endif |
814 | #ifdef GLOB_TILDE0x0800 |
815 | { "GLOB_TILDE", 10, GLOB_TILDE0x0800 }, |
816 | #endif |
817 | { "GLOB_CSH", 8, GLOB_BRACE0x0080|GLOB_NOMAGIC0x0200|GLOB_QUOTE0x0400|GLOB_TILDE0x0800|GLOB_ALPHASORT0x2000 }, |
818 | { NULL((void*)0), 0, 0 } }; |
819 | const struct iv_s *value_for_iv = values_for_iv; |
820 | while (value_for_iv->name) { |
821 | constant_add_symbol(aTHX_ symbol_table, value_for_iv->name, |
822 | value_for_iv->namelen, newSViv(value_for_iv->value)Perl_newSViv( value_for_iv->value)); |
823 | ++value_for_iv; |
824 | } |
825 | if (C_ARRAY_LENGTH(values_for_notfound)(sizeof(values_for_notfound)/sizeof((values_for_notfound)[0]) ) > 1) { |
826 | #ifndef SYMBIAN |
827 | HV *const constant_missing = get_missing_hash(aTHX); |
828 | #endif |
829 | const struct notfound_s *value_for_notfound = values_for_notfound; |
830 | do { |
831 | |
832 | /* Need to add prototypes, else parsing will vary by platform. */ |
833 | HE *he = (HE*) hv_common_key_len(symbol_table,Perl_hv_common_key_len( symbol_table,value_for_notfound->name ,value_for_notfound->namelen,0x10,((void*)0),0) |
834 | value_for_notfound->name,Perl_hv_common_key_len( symbol_table,value_for_notfound->name ,value_for_notfound->namelen,0x10,((void*)0),0) |
835 | value_for_notfound->namelen,Perl_hv_common_key_len( symbol_table,value_for_notfound->name ,value_for_notfound->namelen,0x10,((void*)0),0) |
836 | HV_FETCH_LVALUE, NULL, 0)Perl_hv_common_key_len( symbol_table,value_for_notfound->name ,value_for_notfound->namelen,0x10,((void*)0),0); |
837 | SV *sv; |
838 | #ifndef SYMBIAN |
839 | HEK *hek; |
840 | #endif |
841 | if (!he) { |
842 | croakPerl_croak("Couldn't add key '%s' to %%File::Glob::", |
843 | value_for_notfound->name); |
844 | } |
845 | sv = HeVAL(he)(he)->he_valu.hent_val; |
846 | if (!SvOK(sv)((sv)->sv_flags & (0x00000100|0x00000200|0x00000400|0x00000800 | 0x00001000|0x00002000|0x00004000|0x00008000)) && SvTYPE(sv)((svtype)((sv)->sv_flags & 0xff)) != SVt_PVGV) { |
847 | /* Nothing was here before, so mark a prototype of "" */ |
848 | sv_setpvn(sv, "", 0)Perl_sv_setpvn( sv,"",0); |
849 | } else if (SvPOK(sv)((sv)->sv_flags & 0x00000400) && SvCUR(sv)((XPV*) (sv)->sv_any)->xpv_cur == 0) { |
850 | /* There is already a prototype of "" - do nothing */ |
851 | } else { |
852 | /* Someone has been here before us - have to make a real |
853 | typeglob. */ |
854 | /* It turns out to be incredibly hard to deal with all the |
855 | corner cases of sub foo (); and reporting errors correctly, |
856 | so lets cheat a bit. Start with a constant subroutine */ |
857 | CV *cv = newCONSTSUB(symbol_table,Perl_newCONSTSUB( symbol_table,value_for_notfound->name,& (PL_sv_immortals[0])) |
858 | value_for_notfound->name,Perl_newCONSTSUB( symbol_table,value_for_notfound->name,& (PL_sv_immortals[0])) |
859 | &PL_sv_yes)Perl_newCONSTSUB( symbol_table,value_for_notfound->name,& (PL_sv_immortals[0])); |
860 | /* and then turn it into a non constant declaration only. */ |
861 | SvREFCNT_dec(CvXSUBANY(cv).any_ptr)Perl_SvREFCNT_dec( ((SV *)({ void *_p = (((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))->xcv_start_u.xcv_xsubany.any_ptr ); _p; }))); |
862 | CvCONST_off(cv)(((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))->xcv_flags &= ~0x0004); |
863 | CvXSUB(cv)((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))->xcv_root_u .xcv_xsub = NULL((void*)0); |
864 | CvXSUBANY(cv)((XPVCV*)({ void *_p = ((cv)->sv_any); _p; }))->xcv_start_u .xcv_xsubany.any_ptr = NULL((void*)0); |
865 | } |
866 | #ifndef SYMBIAN |
867 | hek = HeKEY_hek(he)(he)->hent_hek; |
868 | if (!hv_common(constant_missing, NULL, HEK_KEY(hek),Perl_hv_common( constant_missing,((void*)0),(hek)->hek_key ,(hek)->hek_len,(*((unsigned char *)((hek)->hek_key)+(hek )->hek_len+1)),0x04,&(PL_sv_immortals[0]),(hek)->hek_hash ) |
869 | HEK_LEN(hek), HEK_FLAGS(hek), HV_FETCH_ISSTORE,Perl_hv_common( constant_missing,((void*)0),(hek)->hek_key ,(hek)->hek_len,(*((unsigned char *)((hek)->hek_key)+(hek )->hek_len+1)),0x04,&(PL_sv_immortals[0]),(hek)->hek_hash ) |
870 | &PL_sv_yes, HEK_HASH(hek))Perl_hv_common( constant_missing,((void*)0),(hek)->hek_key ,(hek)->hek_len,(*((unsigned char *)((hek)->hek_key)+(hek )->hek_len+1)),0x04,&(PL_sv_immortals[0]),(hek)->hek_hash )) |
871 | croakPerl_croak("Couldn't add key '%s' to missing_hash", |
872 | value_for_notfound->name); |
873 | #endif |
874 | } while ((++value_for_notfound)->name); |
875 | } |
876 | /* As we've been creating subroutines, we better invalidate any cached |
877 | methods */ |
878 | mro_method_changed_in(symbol_table)Perl_mro_method_changed_in( symbol_table); |
879 | } |
880 | |
881 | #line 882 "Glob.c" |
882 | |
883 | /* End of Initialisation Section */ |
884 | |
885 | #if PERL_VERSION_LE(5, 21, 5)((5*1000000 + 32*1000 + 1) <= (5*1000000 + 21*1000 + 5)) |
886 | # if PERL_VERSION_GE(5, 9, 0)((5*1000000 + 32*1000 + 1) >= (5*1000000 + 9*1000 + 0)) |
887 | if (PL_unitcheckav) |
888 | call_list(PL_scopestack_ix, PL_unitcheckav)Perl_call_list( PL_scopestack_ix,PL_unitcheckav); |
889 | # endif |
890 | 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); |
891 | #else |
892 | Perl_xs_boot_epilog(aTHX_ ax); |
893 | #endif |
894 | } |
895 |