line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
/* Copyright (C) 2003, 2004, 2006, 2007 Matthijs van Duin |
2
|
|
|
|
|
|
|
* |
3
|
|
|
|
|
|
|
* Copyright (C) 2010, 2011, 2013, 2015, 2017 |
4
|
|
|
|
|
|
|
* Andrew Main (Zefram) |
5
|
|
|
|
|
|
|
* |
6
|
|
|
|
|
|
|
* Parts from perl, which is Copyright (C) 1991-2013 Larry Wall and others |
7
|
|
|
|
|
|
|
* |
8
|
|
|
|
|
|
|
* You may distribute under the same terms as perl itself, which is either |
9
|
|
|
|
|
|
|
* the GNU General Public License or the Artistic License. |
10
|
|
|
|
|
|
|
*/ |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
#define PERL_CORE |
13
|
|
|
|
|
|
|
#define PERL_NO_GET_CONTEXT |
14
|
|
|
|
|
|
|
#include "EXTERN.h" |
15
|
|
|
|
|
|
|
#include "config.h" |
16
|
|
|
|
|
|
|
#undef USE_DTRACE |
17
|
|
|
|
|
|
|
#include "perl.h" |
18
|
|
|
|
|
|
|
#undef PERL_CORE |
19
|
|
|
|
|
|
|
#include "XSUB.h" |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
#ifdef USE_5005THREADS |
23
|
|
|
|
|
|
|
#error "5.005 threads not supported by Data::Alias" |
24
|
|
|
|
|
|
|
#endif |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
#ifndef PERL_COMBI_VERSION |
28
|
|
|
|
|
|
|
#define PERL_COMBI_VERSION (PERL_REVISION * 1000000 + PERL_VERSION * 1000 + \ |
29
|
|
|
|
|
|
|
PERL_SUBVERSION) |
30
|
|
|
|
|
|
|
#endif |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
#ifndef cBOOL |
33
|
|
|
|
|
|
|
#define cBOOL(x) ((bool)!!(x)) |
34
|
|
|
|
|
|
|
#endif |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION < 5037002) |
37
|
|
|
|
|
|
|
#define KW_DO DO |
38
|
|
|
|
|
|
|
#endif |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
#ifndef G_LIST |
41
|
|
|
|
|
|
|
#define G_LIST G_ARRAY |
42
|
|
|
|
|
|
|
#endif |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
#ifndef RenewOpc |
46
|
|
|
|
|
|
|
#if defined(PL_OP_SLAB_ALLOC) || (PERL_COMBI_VERSION >= 5017002) |
47
|
|
|
|
|
|
|
#define RenewOpc(m,v,n,t,c) \ |
48
|
|
|
|
|
|
|
STMT_START { \ |
49
|
|
|
|
|
|
|
t *tMp_; \ |
50
|
|
|
|
|
|
|
NewOp(m,tMp_,n,t); \ |
51
|
|
|
|
|
|
|
Copy(v,tMp_,n,t); \ |
52
|
|
|
|
|
|
|
FreeOp(v); \ |
53
|
|
|
|
|
|
|
v = (c*) tMp_; \ |
54
|
|
|
|
|
|
|
} STMT_END |
55
|
|
|
|
|
|
|
#else |
56
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5009004) |
57
|
|
|
|
|
|
|
#define RenewOpc(m,v,n,t,c) \ |
58
|
|
|
|
|
|
|
(v = (MEM_WRAP_CHECK_(n,t) \ |
59
|
|
|
|
|
|
|
(c*)PerlMemShared_realloc(v, (n)*sizeof(t)))) |
60
|
|
|
|
|
|
|
#else |
61
|
|
|
|
|
|
|
#define RenewOpc(m,v,n,t,c) \ |
62
|
|
|
|
|
|
|
Renewc(v,n,t,c) |
63
|
|
|
|
|
|
|
#endif |
64
|
|
|
|
|
|
|
#endif |
65
|
|
|
|
|
|
|
#endif |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
#ifndef RenewOp |
68
|
|
|
|
|
|
|
#define RenewOp(m,v,n,t) \ |
69
|
|
|
|
|
|
|
RenewOpc(m,v,n,t,t) |
70
|
|
|
|
|
|
|
#endif |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
#ifdef avhv_keys |
74
|
|
|
|
|
|
|
#define DA_FEATURE_AVHV 1 |
75
|
|
|
|
|
|
|
#endif |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5009003) |
78
|
|
|
|
|
|
|
#define PL_no_helem PL_no_helem_sv |
79
|
|
|
|
|
|
|
#endif |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
#ifndef SvPVX_const |
82
|
|
|
|
|
|
|
#define SvPVX_const SvPVX |
83
|
|
|
|
|
|
|
#endif |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
#ifndef SvREFCNT_inc_NN |
86
|
|
|
|
|
|
|
#define SvREFCNT_inc_NN SvREFCNT_inc |
87
|
|
|
|
|
|
|
#endif |
88
|
|
|
|
|
|
|
#ifndef SvREFCNT_inc_simple_NN |
89
|
|
|
|
|
|
|
#define SvREFCNT_inc_simple_NN SvREFCNT_inc_NN |
90
|
|
|
|
|
|
|
#endif |
91
|
|
|
|
|
|
|
#ifndef SvREFCNT_inc_simple_void_NN |
92
|
|
|
|
|
|
|
#define SvREFCNT_inc_simple_void_NN SvREFCNT_inc_simple_NN |
93
|
|
|
|
|
|
|
#endif |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
#ifndef GvGP_set |
96
|
|
|
|
|
|
|
#define GvGP_set(gv, val) (GvGP(gv) = (val)) |
97
|
|
|
|
|
|
|
#endif |
98
|
|
|
|
|
|
|
#ifndef GvCV_set |
99
|
|
|
|
|
|
|
#define GvCV_set(gv, val) (GvCV(gv) = (val)) |
100
|
|
|
|
|
|
|
#endif |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5009003) |
103
|
|
|
|
|
|
|
#define DA_FEATURE_MULTICALL 1 |
104
|
|
|
|
|
|
|
#endif |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5009002) |
107
|
|
|
|
|
|
|
#define DA_FEATURE_RETOP 1 |
108
|
|
|
|
|
|
|
#endif |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
#define INT2SIZE(x) ((MEM_SIZE)(SSize_t)(x)) |
111
|
|
|
|
|
|
|
#define DA_ARRAY_MAXIDX ((IV) (INT2SIZE(-1) / (2 * sizeof(SV *))) ) |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
#ifndef Nullsv |
114
|
|
|
|
|
|
|
#define Nullsv ((SV*)NULL) |
115
|
|
|
|
|
|
|
#endif |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
#ifndef Nullop |
118
|
|
|
|
|
|
|
#define Nullop ((OP*)NULL) |
119
|
|
|
|
|
|
|
#endif |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
#ifndef lex_end |
122
|
|
|
|
|
|
|
#define lex_end() ((void) 0) |
123
|
|
|
|
|
|
|
#endif |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
#ifndef op_lvalue |
126
|
|
|
|
|
|
|
#define op_lvalue(o, t) mod(o, t) |
127
|
|
|
|
|
|
|
#endif |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
#define DA_HAVE_OP_AELEMFAST_LEX (PERL_COMBI_VERSION >= 5015000) |
130
|
|
|
|
|
|
|
#define DA_HAVE_OP_PADRANGE (PERL_COMBI_VERSION >= 5017006) |
131
|
|
|
|
|
|
|
#define DA_HAVE_OP_PADSV_STORE (PERL_COMBI_VERSION >= 5037003) |
132
|
|
|
|
|
|
|
#define DA_HAVE_OP_AELEMFASTLEX_STORE (PERL_COMBI_VERSION >= 5037004) |
133
|
|
|
|
|
|
|
#define DA_HAVE_OP_EMPTYAVHV (PERL_COMBI_VERSION >= 5037006) |
134
|
|
|
|
|
|
|
|
135
|
|
|
|
|
|
|
#if DA_HAVE_OP_PADRANGE |
136
|
|
|
|
|
|
|
#define IS_PUSHMARK_OR_PADRANGE(op) \ |
137
|
|
|
|
|
|
|
((op)->op_type == OP_PUSHMARK || (op)->op_type == OP_PADRANGE) |
138
|
|
|
|
|
|
|
#else |
139
|
|
|
|
|
|
|
#define IS_PUSHMARK_OR_PADRANGE(op) ((op)->op_type == OP_PUSHMARK) |
140
|
|
|
|
|
|
|
#endif |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION < 5010001) |
143
|
|
|
|
|
|
|
typedef unsigned Optype; |
144
|
|
|
|
|
|
|
#endif |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
#ifndef OpMORESIB_set |
147
|
|
|
|
|
|
|
#define OpMORESIB_set(o, sib) ((o)->op_sibling = (sib)) |
148
|
|
|
|
|
|
|
#define OpLASTSIB_set(o, parent) ((o)->op_sibling = NULL) |
149
|
|
|
|
|
|
|
#define OpMAYBESIB_set(o, sib, parent) ((o)->op_sibling = (sib)) |
150
|
|
|
|
|
|
|
#endif |
151
|
|
|
|
|
|
|
#ifndef OpSIBLING |
152
|
|
|
|
|
|
|
#define OpHAS_SIBLING(o) (cBOOL((o)->op_sibling)) |
153
|
|
|
|
|
|
|
#define OpSIBLING(o) (0 + (o)->op_sibling) |
154
|
|
|
|
|
|
|
#endif |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION < 5009003) |
157
|
|
|
|
|
|
|
typedef OP *(*Perl_check_t)(pTHX_ OP *); |
158
|
|
|
|
|
|
|
#endif |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
#ifndef wrap_op_checker |
161
|
|
|
|
|
|
|
#define wrap_op_checker(c,n,o) THX_wrap_op_checker(aTHX_ c,n,o) |
162
|
|
|
|
|
|
|
static void THX_wrap_op_checker(pTHX_ Optype opcode, |
163
|
|
|
|
|
|
|
Perl_check_t new_checker, Perl_check_t *old_checker_p) |
164
|
|
|
|
|
|
|
{ |
165
|
|
|
|
|
|
|
if(*old_checker_p) return; |
166
|
|
|
|
|
|
|
OP_REFCNT_LOCK; |
167
|
|
|
|
|
|
|
if(!*old_checker_p) { |
168
|
|
|
|
|
|
|
*old_checker_p = PL_check[opcode]; |
169
|
|
|
|
|
|
|
PL_check[opcode] = new_checker; |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
OP_REFCNT_UNLOCK; |
172
|
|
|
|
|
|
|
} |
173
|
|
|
|
|
|
|
#endif |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
#define DA_HAVE_LEX_KNOWNEXT (PERL_COMBI_VERSION < 5025001) |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5011000) && !defined(SVt_RV) |
178
|
|
|
|
|
|
|
#define SVt_RV SVt_IV |
179
|
|
|
|
|
|
|
#endif |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
#ifndef IS_PADGV |
182
|
|
|
|
|
|
|
#ifdef USE_ITHREADS |
183
|
|
|
|
|
|
|
#define IS_PADGV(v) ((v) && SvTYPE(v) == SVt_PVGV) |
184
|
|
|
|
|
|
|
#else |
185
|
|
|
|
|
|
|
#define IS_PADGV(v) 0 |
186
|
|
|
|
|
|
|
#endif |
187
|
|
|
|
|
|
|
#endif |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
#ifndef PadnamelistARRAY |
190
|
|
|
|
|
|
|
#define PadnamelistARRAY(pnl) AvARRAY(pnl) |
191
|
|
|
|
|
|
|
#endif |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
#ifndef PadnameOUTER |
194
|
|
|
|
|
|
|
#define PadnameOUTER(pn) (!!SvFAKE(pn)) |
195
|
|
|
|
|
|
|
#endif |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5006000) && (PERL_COMBI_VERSION < 5011000) |
198
|
|
|
|
|
|
|
#define case_OP_SETSTATE_ case OP_SETSTATE: |
199
|
|
|
|
|
|
|
#else |
200
|
|
|
|
|
|
|
#define case_OP_SETSTATE_ |
201
|
|
|
|
|
|
|
#endif |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5011002) |
204
|
|
|
|
|
|
|
static char const msg_no_symref[] = |
205
|
|
|
|
|
|
|
"Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use"; |
206
|
|
|
|
|
|
|
#else |
207
|
|
|
|
|
|
|
#define msg_no_symref PL_no_symref |
208
|
|
|
|
|
|
|
#endif |
209
|
|
|
|
|
|
|
|
210
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5009005) |
211
|
|
|
|
|
|
|
#ifdef PERL_MAD |
212
|
|
|
|
|
|
|
#error "Data::Alias doesn't support Misc Attribute Decoration yet" |
213
|
|
|
|
|
|
|
#endif |
214
|
|
|
|
|
|
|
#if DA_HAVE_LEX_KNOWNEXT |
215
|
|
|
|
|
|
|
#define PL_lex_defer (PL_parser->lex_defer) |
216
|
|
|
|
|
|
|
#endif |
217
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION < 5021004) |
218
|
|
|
|
|
|
|
#define PL_lex_expect (PL_parser->lex_expect) |
219
|
|
|
|
|
|
|
#endif |
220
|
|
|
|
|
|
|
#define PL_linestr (PL_parser->linestr) |
221
|
|
|
|
|
|
|
#define PL_expect (PL_parser->expect) |
222
|
|
|
|
|
|
|
#define PL_bufptr (PL_parser->bufptr) |
223
|
|
|
|
|
|
|
#define PL_oldbufptr (PL_parser->oldbufptr) |
224
|
|
|
|
|
|
|
#define PL_oldoldbufptr (PL_parser->oldoldbufptr) |
225
|
|
|
|
|
|
|
#define PL_bufend (PL_parser->bufend) |
226
|
|
|
|
|
|
|
#define PL_last_uni (PL_parser->last_uni) |
227
|
|
|
|
|
|
|
#define PL_last_lop (PL_parser->last_lop) |
228
|
|
|
|
|
|
|
#define PL_lex_state (PL_parser->lex_state) |
229
|
|
|
|
|
|
|
#define PL_nexttoke (PL_parser->nexttoke) |
230
|
|
|
|
|
|
|
#define PL_nexttype (PL_parser->nexttype) |
231
|
|
|
|
|
|
|
#define PL_tokenbuf (PL_parser->tokenbuf) |
232
|
|
|
|
|
|
|
#define PL_yylval (PL_parser->yylval) |
233
|
|
|
|
|
|
|
#elif (PERL_COMBI_VERSION >= 5009001) |
234
|
|
|
|
|
|
|
#define PL_yylval (*PL_yylvalp) |
235
|
|
|
|
|
|
|
#endif |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
#define OPpALIASAV 1 |
239
|
|
|
|
|
|
|
#define OPpALIASHV 2 |
240
|
|
|
|
|
|
|
#define OPpALIAS (OPpALIASAV | OPpALIASHV) |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
#define OPpUSEFUL OPpLVAL_INTRO |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
#define MOD(op) op_lvalue((op), OP_GREPSTART) |
245
|
|
|
|
|
|
|
|
246
|
|
|
|
|
|
|
#ifndef OPpPAD_STATE |
247
|
|
|
|
|
|
|
#define OPpPAD_STATE 0 |
248
|
|
|
|
|
|
|
#endif |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
#ifndef SVs_PADBUSY |
251
|
|
|
|
|
|
|
#define SVs_PADBUSY 0 |
252
|
|
|
|
|
|
|
#endif |
253
|
|
|
|
|
|
|
#define SVs_PADFLAGS (SVs_PADBUSY|SVs_PADMY|SVs_PADTMP) |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
#ifdef pp_dorassign |
256
|
|
|
|
|
|
|
#define DA_HAVE_OP_DORASSIGN 1 |
257
|
|
|
|
|
|
|
#else |
258
|
|
|
|
|
|
|
#define DA_HAVE_OP_DORASSIGN (PERL_COMBI_VERSION >= 5009000) |
259
|
|
|
|
|
|
|
#endif |
260
|
|
|
|
|
|
|
|
261
|
|
|
|
|
|
|
#define DA_TIED_ERR "Can't %s alias %s tied %s" |
262
|
|
|
|
|
|
|
#define DA_ODD_HASH_ERR "Odd number of elements in hash assignment" |
263
|
|
|
|
|
|
|
#define DA_TARGET_ERR "Unsupported alias target" |
264
|
|
|
|
|
|
|
#define DA_TARGET_ERR_AT "Unsupported alias target at %s line %"UVuf"\n" |
265
|
|
|
|
|
|
|
#define DA_DEREF_ERR "Can't deref string (\"%.32s\")" |
266
|
|
|
|
|
|
|
#define DA_OUTER_ERR "Aliasing of outer lexical variable has limited scope" |
267
|
|
|
|
|
|
|
|
268
|
|
|
|
|
|
|
#define _PUSHaa(a1,a2) PUSHs((SV*)(Size_t)(a1));PUSHs((SV*)(Size_t)(a2)) |
269
|
|
|
|
|
|
|
#define PUSHaa(a1,a2) STMT_START { _PUSHaa(a1,a2); } STMT_END |
270
|
|
|
|
|
|
|
#define XPUSHaa(a1,a2) STMT_START { EXTEND(sp,2); _PUSHaa(a1,a2); } STMT_END |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
#define DA_ALIAS_PAD ((Size_t) -1) |
273
|
|
|
|
|
|
|
#define DA_ALIAS_RV ((Size_t) -2) |
274
|
|
|
|
|
|
|
#define DA_ALIAS_GV ((Size_t) -3) |
275
|
|
|
|
|
|
|
#define DA_ALIAS_AV ((Size_t) -4) |
276
|
|
|
|
|
|
|
#define DA_ALIAS_HV ((Size_t) -5) |
277
|
|
|
|
|
|
|
|
278
|
|
|
|
|
|
|
STATIC OP *(*da_old_ck_rv2cv)(pTHX_ OP *op); |
279
|
|
|
|
|
|
|
STATIC OP *(*da_old_ck_entersub)(pTHX_ OP *op); |
280
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5021007) |
281
|
|
|
|
|
|
|
STATIC OP *(*da_old_ck_aelem)(pTHX_ OP *op); |
282
|
|
|
|
|
|
|
STATIC OP *(*da_old_ck_helem)(pTHX_ OP *op); |
283
|
|
|
|
|
|
|
#endif |
284
|
|
|
|
|
|
|
|
285
|
|
|
|
|
|
|
#ifdef USE_ITHREADS |
286
|
|
|
|
|
|
|
|
287
|
|
|
|
|
|
|
#define DA_GLOBAL_KEY "Data::Alias::_global" |
288
|
|
|
|
|
|
|
#define DA_FETCH(create) hv_fetch(PL_modglobal, DA_GLOBAL_KEY, \ |
289
|
|
|
|
|
|
|
sizeof(DA_GLOBAL_KEY) - 1, create) |
290
|
|
|
|
|
|
|
#define DA_ACTIVE ((_dap = DA_FETCH(FALSE)) && (_da = *_dap)) |
291
|
|
|
|
|
|
|
#define DA_INIT STMT_START { _dap = DA_FETCH(TRUE); _da = *_dap; \ |
292
|
|
|
|
|
|
|
sv_upgrade(_da, SVt_PVLV); LvTYPE(_da) = 't'; } STMT_END |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
#define dDA SV *_da, **_dap |
295
|
|
|
|
|
|
|
#define dDAforce SV *_da = *DA_FETCH(FALSE) |
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
#define da_inside (*(I32 *) &SvIVX(_da)) |
298
|
|
|
|
|
|
|
#define da_iscope (*(PERL_CONTEXT **) &SvPVX(_da)) |
299
|
|
|
|
|
|
|
#define da_cv (*(CV **) &LvTARGOFF(_da)) |
300
|
|
|
|
|
|
|
#define da_cvc (*(CV **) &LvTARGLEN(_da)) |
301
|
|
|
|
|
|
|
|
302
|
|
|
|
|
|
|
#else |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
#define dDA dNOOP |
305
|
|
|
|
|
|
|
#define dDAforce dNOOP |
306
|
|
|
|
|
|
|
#define DA_ACTIVE 42 |
307
|
|
|
|
|
|
|
#define DA_INIT |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
STATIC CV *da_cv, *da_cvc; |
310
|
|
|
|
|
|
|
STATIC I32 da_inside; |
311
|
|
|
|
|
|
|
STATIC PERL_CONTEXT *da_iscope; |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
#endif |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
STATIC void (*da_old_peepp)(pTHX_ OP *); |
316
|
|
|
|
|
|
|
|
317
|
0
|
|
|
|
|
|
STATIC OP *da_tag_rv2cv(pTHX) { return NORMAL; } |
318
|
0
|
|
|
|
|
|
STATIC OP *da_tag_list(pTHX) { return NORMAL; } |
319
|
0
|
|
|
|
|
|
STATIC OP *da_tag_entersub(pTHX) { return NORMAL; } |
320
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5031002) |
321
|
|
|
|
|
|
|
STATIC OP *da_tag_enter(pTHX) { return NORMAL; } |
322
|
|
|
|
|
|
|
#endif |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
STATIC void da_peep(pTHX_ OP *o); |
325
|
|
|
|
|
|
|
STATIC void da_peep2(pTHX_ OP *o); |
326
|
|
|
|
|
|
|
|
327
|
33
|
|
|
|
|
|
STATIC SV *da_fetch(pTHX_ SV *a1, SV *a2) { |
328
|
33
|
|
|
|
|
|
switch ((Size_t) a1) { |
329
|
|
|
|
|
|
|
case DA_ALIAS_PAD: |
330
|
8
|
|
|
|
|
|
return PAD_SVl((Size_t) a2); |
331
|
|
|
|
|
|
|
case DA_ALIAS_RV: |
332
|
13
|
50
|
|
|
|
|
if (SvTYPE(a2) == SVt_PVGV) |
333
|
13
|
|
|
|
|
|
a2 = GvSV(a2); |
334
|
0
|
0
|
|
|
|
|
else if (!SvROK(a2) || !(a2 = SvRV(a2)) |
|
|
0
|
|
|
|
|
|
335
|
0
|
0
|
|
|
|
|
|| (SvTYPE(a2) > SVt_PVLV && SvTYPE(a2) != SVt_PVGV)) |
|
|
0
|
|
|
|
|
|
336
|
0
|
|
|
|
|
|
Perl_croak(aTHX_ "Not a SCALAR reference"); |
337
|
|
|
|
|
|
|
case DA_ALIAS_GV: |
338
|
13
|
|
|
|
|
|
return a2; |
339
|
|
|
|
|
|
|
case DA_ALIAS_AV: |
340
|
|
|
|
|
|
|
case DA_ALIAS_HV: |
341
|
0
|
|
|
|
|
|
break; |
342
|
|
|
|
|
|
|
default: |
343
|
12
|
|
|
|
|
|
switch (SvTYPE(a1)) { |
344
|
|
|
|
|
|
|
SV **svp; |
345
|
|
|
|
|
|
|
HE *he; |
346
|
|
|
|
|
|
|
case SVt_PVAV: |
347
|
8
|
|
|
|
|
|
svp = av_fetch((AV *) a1, (Size_t) a2, FALSE); |
348
|
8
|
50
|
|
|
|
|
return svp ? *svp : &PL_sv_undef; |
349
|
|
|
|
|
|
|
case SVt_PVHV: |
350
|
4
|
|
|
|
|
|
he = hv_fetch_ent((HV *) a1, a2, FALSE, 0); |
351
|
4
|
50
|
|
|
|
|
return he ? HeVAL(he) : &PL_sv_undef; |
352
|
|
|
|
|
|
|
default: |
353
|
|
|
|
|
|
|
/* suppress warning */ ; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
} |
356
|
0
|
|
|
|
|
|
Perl_croak(aTHX_ DA_TARGET_ERR); |
357
|
|
|
|
|
|
|
return NULL; /* suppress warning on win32 */ |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
#define PREP_ALIAS_INC(sV) \ |
361
|
|
|
|
|
|
|
STMT_START { \ |
362
|
|
|
|
|
|
|
if (SvPADTMP(sV) && !IS_PADGV(sV)) { \ |
363
|
|
|
|
|
|
|
sV = newSVsv(sV); \ |
364
|
|
|
|
|
|
|
SvREADONLY_on(sV); \ |
365
|
|
|
|
|
|
|
} else { \ |
366
|
|
|
|
|
|
|
switch (SvTYPE(sV)) { \ |
367
|
|
|
|
|
|
|
case SVt_PVLV: \ |
368
|
|
|
|
|
|
|
if (LvTYPE(sV) == 'y') { \ |
369
|
|
|
|
|
|
|
if (LvTARGLEN(sV)) \ |
370
|
|
|
|
|
|
|
vivify_defelem(sV); \ |
371
|
|
|
|
|
|
|
sV = LvTARG(sV); \ |
372
|
|
|
|
|
|
|
if (!sV) \ |
373
|
|
|
|
|
|
|
sV = &PL_sv_undef; \ |
374
|
|
|
|
|
|
|
} \ |
375
|
|
|
|
|
|
|
break; \ |
376
|
|
|
|
|
|
|
case SVt_PVAV: \ |
377
|
|
|
|
|
|
|
if (!AvREAL((AV *) sV) && AvREIFY((AV *) sV)) \ |
378
|
|
|
|
|
|
|
av_reify((AV *) sV); \ |
379
|
|
|
|
|
|
|
break; \ |
380
|
|
|
|
|
|
|
default: \ |
381
|
|
|
|
|
|
|
/* suppress warning */ ; \ |
382
|
|
|
|
|
|
|
} \ |
383
|
|
|
|
|
|
|
SvTEMP_off(sV); \ |
384
|
|
|
|
|
|
|
SvREFCNT_inc_simple_void_NN(sV); \ |
385
|
|
|
|
|
|
|
} \ |
386
|
|
|
|
|
|
|
} STMT_END |
387
|
|
|
|
|
|
|
|
388
|
1
|
|
|
|
|
|
STATIC void da_restore_gvcv(pTHX_ void *gv_v) { |
389
|
1
|
|
|
|
|
|
GV *gv = (GV*)gv_v; |
390
|
1
|
|
|
|
|
|
CV *restcv = (CV *) SSPOPPTR; |
391
|
1
|
|
|
|
|
|
CV *oldcv = GvCV(gv); |
392
|
1
|
|
|
|
|
|
GvCV_set(gv, restcv); |
393
|
1
|
|
|
|
|
|
SvREFCNT_dec(oldcv); |
394
|
1
|
|
|
|
|
|
SvREFCNT_dec((SV *) gv); |
395
|
1
|
|
|
|
|
|
} |
396
|
|
|
|
|
|
|
|
397
|
26
|
|
|
|
|
|
STATIC void da_alias_pad(pTHX_ PADOFFSET index, SV *value) { |
398
|
26
|
|
|
|
|
|
SV *old = PAD_SVl(index); |
399
|
26
|
50
|
|
|
|
|
PREP_ALIAS_INC(value); |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
400
|
26
|
|
|
|
|
|
PAD_SVl(index) = value; |
401
|
26
|
|
|
|
|
|
SvFLAGS(value) |= (SvFLAGS(old) & SVs_PADFLAGS); |
402
|
26
|
100
|
|
|
|
|
if (old != &PL_sv_undef) |
403
|
14
|
|
|
|
|
|
SvREFCNT_dec(old); |
404
|
26
|
|
|
|
|
|
} |
405
|
|
|
|
|
|
|
|
406
|
175
|
|
|
|
|
|
STATIC void da_alias(pTHX_ SV *a1, SV *a2, SV *value) { |
407
|
175
|
100
|
|
|
|
|
if ((Size_t) a1 == DA_ALIAS_PAD) |
408
|
26
|
|
|
|
|
|
return da_alias_pad(aTHX_ (PADOFFSET)(Size_t)a2, value); |
409
|
|
|
|
|
|
|
|
410
|
149
|
100
|
|
|
|
|
PREP_ALIAS_INC(value); |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
411
|
149
|
|
|
|
|
|
switch ((Size_t) a1) { |
412
|
|
|
|
|
|
|
SV **svp; |
413
|
|
|
|
|
|
|
GV *gv; |
414
|
|
|
|
|
|
|
case DA_ALIAS_RV: |
415
|
97
|
100
|
|
|
|
|
if (SvTYPE(a2) == SVt_PVGV) { |
416
|
90
|
|
|
|
|
|
sv_2mortal(value); |
417
|
90
|
|
|
|
|
|
goto globassign; |
418
|
|
|
|
|
|
|
} |
419
|
7
|
|
|
|
|
|
value = newRV_noinc(value); |
420
|
7
|
|
|
|
|
|
goto refassign; |
421
|
|
|
|
|
|
|
case DA_ALIAS_GV: |
422
|
14
|
100
|
|
|
|
|
if (!SvROK(value)) { |
423
|
|
|
|
|
|
|
refassign: |
424
|
12
|
50
|
|
|
|
|
SvSetMagicSV(a2, value); |
|
|
50
|
|
|
|
|
|
425
|
12
|
|
|
|
|
|
SvREFCNT_dec(value); |
426
|
12
|
|
|
|
|
|
return; |
427
|
|
|
|
|
|
|
} |
428
|
9
|
|
|
|
|
|
value = SvRV(sv_2mortal(value)); |
429
|
|
|
|
|
|
|
globassign: |
430
|
99
|
|
|
|
|
|
gv = (GV *) a2; |
431
|
|
|
|
|
|
|
#ifdef GV_UNIQUE_CHECK |
432
|
|
|
|
|
|
|
if (GvUNIQUE(gv)) |
433
|
|
|
|
|
|
|
Perl_croak(aTHX_ PL_no_modify); |
434
|
|
|
|
|
|
|
#endif |
435
|
99
|
|
|
|
|
|
switch (SvTYPE(value)) { |
436
|
|
|
|
|
|
|
CV *oldcv; |
437
|
|
|
|
|
|
|
case SVt_PVCV: |
438
|
1
|
|
|
|
|
|
oldcv = GvCV(gv); |
439
|
1
|
50
|
|
|
|
|
if (oldcv != (CV *) value) { |
440
|
1
|
50
|
|
|
|
|
if (GvCVGEN(gv)) { |
441
|
0
|
|
|
|
|
|
GvCV_set(gv, NULL); |
442
|
0
|
|
|
|
|
|
GvCVGEN(gv) = 0; |
443
|
0
|
|
|
|
|
|
SvREFCNT_dec((SV *) oldcv); |
444
|
0
|
|
|
|
|
|
oldcv = NULL; |
445
|
|
|
|
|
|
|
} |
446
|
1
|
|
|
|
|
|
PL_sub_generation++; |
447
|
|
|
|
|
|
|
} |
448
|
1
|
|
|
|
|
|
GvMULTI_on(gv); |
449
|
1
|
50
|
|
|
|
|
if (GvINTRO(gv)) { |
450
|
1
|
|
|
|
|
|
SvREFCNT_inc_simple_void_NN((SV *) gv); |
451
|
1
|
|
|
|
|
|
SvREFCNT_inc_simple_void_NN(value); |
452
|
1
|
|
|
|
|
|
GvINTRO_off(gv); |
453
|
1
|
50
|
|
|
|
|
SSCHECK(1); |
454
|
1
|
|
|
|
|
|
SSPUSHPTR((SV *) oldcv); |
455
|
1
|
|
|
|
|
|
SAVEDESTRUCTOR_X(da_restore_gvcv, (void*)gv); |
456
|
1
|
|
|
|
|
|
GvCV_set(gv, (CV*)value); |
457
|
|
|
|
|
|
|
} else { |
458
|
0
|
|
|
|
|
|
SvREFCNT_inc_simple_void_NN(value); |
459
|
0
|
|
|
|
|
|
GvCV_set(gv, (CV*)value); |
460
|
0
|
|
|
|
|
|
SvREFCNT_dec((SV *) oldcv); |
461
|
|
|
|
|
|
|
} |
462
|
1
|
|
|
|
|
|
return; |
463
|
10
|
|
|
|
|
|
case SVt_PVAV: svp = (SV **) &GvAV(gv); break; |
464
|
10
|
|
|
|
|
|
case SVt_PVHV: svp = (SV **) &GvHV(gv); break; |
465
|
1
|
|
|
|
|
|
case SVt_PVFM: svp = (SV **) &GvFORM(gv); break; |
466
|
1
|
|
|
|
|
|
case SVt_PVIO: svp = (SV **) &GvIOp(gv); break; |
467
|
76
|
|
|
|
|
|
default: svp = &GvSV(gv); |
468
|
|
|
|
|
|
|
} |
469
|
98
|
|
|
|
|
|
GvMULTI_on(gv); |
470
|
98
|
100
|
|
|
|
|
if (GvINTRO(gv)) { |
471
|
5
|
|
|
|
|
|
GvINTRO_off(gv); |
472
|
5
|
|
|
|
|
|
SAVEGENERICSV(*svp); |
473
|
5
|
|
|
|
|
|
*svp = SvREFCNT_inc_simple_NN(value); |
474
|
|
|
|
|
|
|
} else { |
475
|
93
|
|
|
|
|
|
SV *old = *svp; |
476
|
93
|
|
|
|
|
|
*svp = SvREFCNT_inc_simple_NN(value); |
477
|
93
|
|
|
|
|
|
SvREFCNT_dec(old); |
478
|
|
|
|
|
|
|
} |
479
|
98
|
|
|
|
|
|
return; |
480
|
|
|
|
|
|
|
case DA_ALIAS_AV: |
481
|
|
|
|
|
|
|
case DA_ALIAS_HV: |
482
|
0
|
|
|
|
|
|
break; |
483
|
|
|
|
|
|
|
default: |
484
|
38
|
|
|
|
|
|
switch (SvTYPE(a1)) { |
485
|
|
|
|
|
|
|
case SVt_PVAV: |
486
|
23
|
50
|
|
|
|
|
if (!av_store((AV *) a1, (SSize_t) a2, value)) |
487
|
0
|
|
|
|
|
|
SvREFCNT_dec(value); |
488
|
23
|
|
|
|
|
|
return; |
489
|
|
|
|
|
|
|
case SVt_PVHV: |
490
|
15
|
100
|
|
|
|
|
if (value == &PL_sv_undef) { |
491
|
1
|
|
|
|
|
|
(void) hv_delete_ent((HV *) a1, a2, |
492
|
|
|
|
|
|
|
G_DISCARD, 0); |
493
|
|
|
|
|
|
|
} else { |
494
|
14
|
50
|
|
|
|
|
if (!hv_store_ent((HV *) a1, a2, value, 0)) |
495
|
0
|
|
|
|
|
|
SvREFCNT_dec(value); |
496
|
|
|
|
|
|
|
} |
497
|
15
|
|
|
|
|
|
return; |
498
|
|
|
|
|
|
|
default: |
499
|
|
|
|
|
|
|
/* suppress warning */ ; |
500
|
|
|
|
|
|
|
} |
501
|
|
|
|
|
|
|
} |
502
|
0
|
|
|
|
|
|
SvREFCNT_dec(value); |
503
|
0
|
|
|
|
|
|
Perl_croak(aTHX_ DA_TARGET_ERR); |
504
|
|
|
|
|
|
|
} |
505
|
|
|
|
|
|
|
|
506
|
14
|
|
|
|
|
|
STATIC void da_unlocalize_gvar(pTHX_ void *gp_v) { |
507
|
14
|
|
|
|
|
|
GP *gp = (GP*) gp_v; |
508
|
14
|
|
|
|
|
|
SV *value = (SV *) SSPOPPTR; |
509
|
14
|
|
|
|
|
|
SV **sptr = (SV **) SSPOPPTR; |
510
|
14
|
|
|
|
|
|
SV *old = *sptr; |
511
|
14
|
|
|
|
|
|
*sptr = value; |
512
|
14
|
|
|
|
|
|
SvREFCNT_dec(old); |
513
|
|
|
|
|
|
|
|
514
|
14
|
100
|
|
|
|
|
if (gp->gp_refcnt > 1) { |
515
|
11
|
|
|
|
|
|
--gp->gp_refcnt; |
516
|
|
|
|
|
|
|
} else { |
517
|
3
|
|
|
|
|
|
SV *gv = newSV(0); |
518
|
3
|
|
|
|
|
|
sv_upgrade(gv, SVt_PVGV); |
519
|
3
|
|
|
|
|
|
SvSCREAM_on(gv); |
520
|
3
|
|
|
|
|
|
GvGP_set(gv, gp); |
521
|
3
|
|
|
|
|
|
sv_free(gv); |
522
|
|
|
|
|
|
|
} |
523
|
14
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
|
|
525
|
14
|
|
|
|
|
|
STATIC void da_localize_gvar(pTHX_ GP *gp, SV **sptr) { |
526
|
14
|
50
|
|
|
|
|
SSCHECK(2); |
527
|
14
|
|
|
|
|
|
SSPUSHPTR(sptr); |
528
|
14
|
|
|
|
|
|
SSPUSHPTR(*sptr); |
529
|
14
|
|
|
|
|
|
SAVEDESTRUCTOR_X(da_unlocalize_gvar, (void*)gp); |
530
|
14
|
|
|
|
|
|
++gp->gp_refcnt; |
531
|
14
|
|
|
|
|
|
*sptr = Nullsv; |
532
|
14
|
|
|
|
|
|
} |
533
|
|
|
|
|
|
|
|
534
|
99
|
|
|
|
|
|
STATIC SV *da_refgen(pTHX_ SV *sv) { |
535
|
|
|
|
|
|
|
SV *rv; |
536
|
99
|
50
|
|
|
|
|
PREP_ALIAS_INC(sv); |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
537
|
99
|
|
|
|
|
|
rv = sv_newmortal(); |
538
|
99
|
|
|
|
|
|
sv_upgrade(rv, SVt_RV); |
539
|
99
|
|
|
|
|
|
SvRV(rv) = sv; |
540
|
99
|
|
|
|
|
|
SvROK_on(rv); |
541
|
99
|
|
|
|
|
|
SvREADONLY_on(rv); |
542
|
99
|
|
|
|
|
|
return rv; |
543
|
|
|
|
|
|
|
} |
544
|
|
|
|
|
|
|
|
545
|
69
|
|
|
|
|
|
STATIC OP *DataAlias_pp_srefgen(pTHX) { |
546
|
69
|
|
|
|
|
|
dSP; |
547
|
69
|
|
|
|
|
|
SETs(da_refgen(aTHX_ TOPs)); |
548
|
69
|
|
|
|
|
|
RETURN; |
549
|
|
|
|
|
|
|
} |
550
|
|
|
|
|
|
|
|
551
|
4
|
|
|
|
|
|
STATIC OP *DataAlias_pp_refgen(pTHX) { |
552
|
4
|
|
|
|
|
|
dSP; dMARK; |
553
|
4
|
50
|
|
|
|
|
if (GIMME_V != G_LIST) { |
|
|
50
|
|
|
|
|
|
554
|
4
|
|
|
|
|
|
++MARK; |
555
|
4
|
50
|
|
|
|
|
*MARK = da_refgen(aTHX_ MARK <= SP ? TOPs : &PL_sv_undef); |
556
|
4
|
|
|
|
|
|
SP = MARK; |
557
|
|
|
|
|
|
|
} else { |
558
|
0
|
0
|
|
|
|
|
EXTEND_MORTAL(SP - MARK); |
559
|
0
|
0
|
|
|
|
|
while (++MARK <= SP) |
560
|
0
|
|
|
|
|
|
*MARK = da_refgen(aTHX_ *MARK); |
561
|
|
|
|
|
|
|
} |
562
|
4
|
|
|
|
|
|
RETURN; |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
|
565
|
13
|
|
|
|
|
|
STATIC OP *DataAlias_pp_anonlist(pTHX) { |
566
|
13
|
|
|
|
|
|
dSP; dMARK; |
567
|
13
|
|
|
|
|
|
I32 i = SP - MARK; |
568
|
13
|
|
|
|
|
|
AV *av = newAV(); |
569
|
|
|
|
|
|
|
SV **svp, *sv; |
570
|
13
|
|
|
|
|
|
av_extend(av, i - 1); |
571
|
13
|
|
|
|
|
|
AvFILLp(av) = i - 1; |
572
|
13
|
|
|
|
|
|
svp = AvARRAY(av); |
573
|
32
|
100
|
|
|
|
|
while (i--) |
574
|
19
|
|
|
|
|
|
SvTEMP_off(svp[i] = SvREFCNT_inc_NN(POPs)); |
575
|
13
|
100
|
|
|
|
|
if (PL_op->op_flags & OPf_SPECIAL) { |
576
|
9
|
|
|
|
|
|
sv = da_refgen(aTHX_ (SV *) av); |
577
|
9
|
|
|
|
|
|
SvREFCNT_dec((SV *) av); |
578
|
|
|
|
|
|
|
} else { |
579
|
4
|
|
|
|
|
|
sv = sv_2mortal((SV *) av); |
580
|
|
|
|
|
|
|
} |
581
|
13
|
50
|
|
|
|
|
XPUSHs(sv); |
582
|
13
|
|
|
|
|
|
RETURN; |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
|
585
|
22
|
|
|
|
|
|
STATIC OP *DataAlias_pp_anonhash(pTHX) { |
586
|
22
|
|
|
|
|
|
dSP; dMARK; dORIGMARK; |
587
|
22
|
|
|
|
|
|
HV *hv = (HV *) newHV(); |
588
|
|
|
|
|
|
|
SV *sv; |
589
|
53
|
100
|
|
|
|
|
while (MARK < SP) { |
590
|
32
|
|
|
|
|
|
SV *key = *++MARK; |
591
|
32
|
|
|
|
|
|
SV *val = &PL_sv_undef; |
592
|
32
|
100
|
|
|
|
|
if (MARK < SP) |
593
|
30
|
|
|
|
|
|
SvTEMP_off(val = SvREFCNT_inc_NN(*++MARK)); |
594
|
2
|
100
|
|
|
|
|
else if (ckWARN(WARN_MISC)) |
595
|
1
|
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_MISC), |
596
|
|
|
|
|
|
|
"Odd number of elements in anonymous hash"); |
597
|
31
|
100
|
|
|
|
|
if (val == &PL_sv_undef) |
598
|
3
|
|
|
|
|
|
(void) hv_delete_ent(hv, key, G_DISCARD, 0); |
599
|
|
|
|
|
|
|
else |
600
|
28
|
|
|
|
|
|
(void) hv_store_ent(hv, key, val, 0); |
601
|
|
|
|
|
|
|
} |
602
|
21
|
|
|
|
|
|
SP = ORIGMARK; |
603
|
21
|
100
|
|
|
|
|
if (PL_op->op_flags & OPf_SPECIAL) { |
604
|
17
|
|
|
|
|
|
sv = da_refgen(aTHX_ (SV *) hv); |
605
|
17
|
|
|
|
|
|
SvREFCNT_dec((SV *) hv); |
606
|
|
|
|
|
|
|
} else { |
607
|
4
|
|
|
|
|
|
sv = sv_2mortal((SV *) hv); |
608
|
|
|
|
|
|
|
} |
609
|
21
|
50
|
|
|
|
|
XPUSHs(sv); |
610
|
21
|
|
|
|
|
|
RETURN; |
611
|
|
|
|
|
|
|
} |
612
|
|
|
|
|
|
|
|
613
|
17
|
|
|
|
|
|
STATIC OP *DataAlias_pp_aelemfast(pTHX) { |
614
|
17
|
|
|
|
|
|
dSP; |
615
|
17
|
|
|
|
|
|
AV *av = |
616
|
|
|
|
|
|
|
#if DA_HAVE_OP_AELEMFAST_LEX |
617
|
17
|
|
|
|
|
|
PL_op->op_type == OP_AELEMFAST_LEX ? |
618
|
|
|
|
|
|
|
#else |
619
|
|
|
|
|
|
|
(PL_op->op_flags & OPf_SPECIAL) ? |
620
|
|
|
|
|
|
|
#endif |
621
|
17
|
100
|
|
|
|
|
(AV *) PAD_SV(PL_op->op_targ) : GvAVn(cGVOP_gv); |
|
|
50
|
|
|
|
|
|
622
|
17
|
|
|
|
|
|
IV index = PL_op->op_private; |
623
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5019010) |
624
|
17
|
|
|
|
|
|
index = (I8)index; |
625
|
|
|
|
|
|
|
#endif |
626
|
17
|
50
|
|
|
|
|
if (!av_fetch(av, index, TRUE)) |
627
|
0
|
|
|
|
|
|
DIE(aTHX_ PL_no_aelem, index); |
628
|
17
|
50
|
|
|
|
|
XPUSHaa(av, index); |
629
|
17
|
|
|
|
|
|
RETURN; |
630
|
|
|
|
|
|
|
} |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
#if DA_HAVE_OP_AELEMFASTLEX_STORE |
633
|
|
|
|
|
|
|
STATIC OP *DataAlias_pp_aelemfastlex_store(pTHX) { |
634
|
|
|
|
|
|
|
dSP; |
635
|
|
|
|
|
|
|
SV *value = TOPs; |
636
|
|
|
|
|
|
|
/* inlined simplified DataAlias_pp_aelemfast */ |
637
|
|
|
|
|
|
|
AV *av = (AV *) PAD_SV(PL_op->op_targ); |
638
|
|
|
|
|
|
|
IV index = (I8)PL_op->op_private; |
639
|
|
|
|
|
|
|
if (!av_fetch(av, index, TRUE)) |
640
|
|
|
|
|
|
|
DIE(aTHX_ PL_no_aelem, index); |
641
|
|
|
|
|
|
|
/* inlined simplified DataAlias_pp_sassign */ |
642
|
|
|
|
|
|
|
PREP_ALIAS_INC(value); |
643
|
|
|
|
|
|
|
if (!av_store(av, index, value)) |
644
|
|
|
|
|
|
|
SvREFCNT_dec(value); |
645
|
|
|
|
|
|
|
RETURN; |
646
|
|
|
|
|
|
|
} |
647
|
|
|
|
|
|
|
#endif |
648
|
|
|
|
|
|
|
|
649
|
6
|
|
|
|
|
|
STATIC bool da_badmagic(pTHX_ SV *sv) { |
650
|
6
|
|
|
|
|
|
MAGIC *mg = SvMAGIC(sv); |
651
|
12
|
100
|
|
|
|
|
while (mg) { |
652
|
6
|
50
|
|
|
|
|
if (isUPPER(mg->mg_type)) |
653
|
0
|
|
|
|
|
|
return TRUE; |
654
|
6
|
|
|
|
|
|
mg = mg->mg_moremagic; |
655
|
|
|
|
|
|
|
} |
656
|
6
|
|
|
|
|
|
return FALSE; |
657
|
|
|
|
|
|
|
} |
658
|
|
|
|
|
|
|
|
659
|
4
|
|
|
|
|
|
STATIC OP *DataAlias_pp_aelem(pTHX) { |
660
|
4
|
|
|
|
|
|
dSP; |
661
|
4
|
|
|
|
|
|
SV *elem = POPs, **svp; |
662
|
4
|
|
|
|
|
|
AV *av = (AV *) POPs; |
663
|
4
|
50
|
|
|
|
|
IV index = SvIV(elem); |
664
|
4
|
50
|
|
|
|
|
if (SvRMAGICAL(av) && da_badmagic(aTHX_ (SV *) av)) |
|
|
0
|
|
|
|
|
|
665
|
0
|
|
|
|
|
|
DIE(aTHX_ DA_TIED_ERR, "put", "into", "array"); |
666
|
4
|
50
|
|
|
|
|
if (SvROK(elem) && !SvGAMAGIC(elem) && ckWARN(WARN_MISC)) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
667
|
0
|
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_MISC), |
668
|
|
|
|
|
|
|
"Use of reference \"%"SVf"\" as array index", elem); |
669
|
4
|
50
|
|
|
|
|
if (SvTYPE(av) != SVt_PVAV) |
670
|
0
|
|
|
|
|
|
RETPUSHUNDEF; |
671
|
4
|
50
|
|
|
|
|
if (index > DA_ARRAY_MAXIDX || !(svp = av_fetch(av, index, TRUE))) |
|
|
50
|
|
|
|
|
|
672
|
0
|
|
|
|
|
|
DIE(aTHX_ PL_no_aelem, index); |
673
|
4
|
100
|
|
|
|
|
if (PL_op->op_private & OPpLVAL_INTRO) |
674
|
2
|
|
|
|
|
|
save_aelem(av, index, svp); |
675
|
4
|
|
|
|
|
|
PUSHaa(av, index); |
676
|
4
|
|
|
|
|
|
RETURN; |
677
|
|
|
|
|
|
|
} |
678
|
|
|
|
|
|
|
|
679
|
|
|
|
|
|
|
#if DA_FEATURE_AVHV |
680
|
|
|
|
|
|
|
STATIC I32 da_avhv_index(pTHX_ AV *av, SV *key) { |
681
|
|
|
|
|
|
|
HV *keys = (HV *) SvRV(*AvARRAY(av)); |
682
|
|
|
|
|
|
|
HE *he = hv_fetch_ent(keys, key, FALSE, 0); |
683
|
|
|
|
|
|
|
I32 index; |
684
|
|
|
|
|
|
|
if (!he) |
685
|
|
|
|
|
|
|
Perl_croak(aTHX_ "No such pseudo-hash field \"%s\"", |
686
|
|
|
|
|
|
|
SvPV_nolen(key)); |
687
|
|
|
|
|
|
|
if ((index = SvIV(HeVAL(he))) <= 0) |
688
|
|
|
|
|
|
|
Perl_croak(aTHX_ "Bad index while coercing array into hash"); |
689
|
|
|
|
|
|
|
if (index > AvMAX(av)) { |
690
|
|
|
|
|
|
|
I32 real = AvREAL(av); |
691
|
|
|
|
|
|
|
AvREAL_on(av); |
692
|
|
|
|
|
|
|
av_extend(av, index); |
693
|
|
|
|
|
|
|
if (!real) |
694
|
|
|
|
|
|
|
AvREAL_off(av); |
695
|
|
|
|
|
|
|
} |
696
|
|
|
|
|
|
|
return index; |
697
|
|
|
|
|
|
|
} |
698
|
|
|
|
|
|
|
#endif |
699
|
|
|
|
|
|
|
|
700
|
|
|
|
|
|
|
#ifndef save_hdelete |
701
|
|
|
|
|
|
|
STATIC void DataAlias_save_hdelete(pTHX_ HV *hv, SV *keysv) { |
702
|
|
|
|
|
|
|
STRLEN len; |
703
|
|
|
|
|
|
|
const char *key = SvPV_const(keysv, len); |
704
|
|
|
|
|
|
|
save_delete(hv, savepvn(key, len), SvUTF8(keysv) ? -(I32)len : (I32)len); |
705
|
|
|
|
|
|
|
} |
706
|
|
|
|
|
|
|
#define save_hdelete(hv, keysv) DataAlias_save_hdelete(aTHX_ (hv), (keysv)) |
707
|
|
|
|
|
|
|
#endif |
708
|
|
|
|
|
|
|
|
709
|
11
|
|
|
|
|
|
STATIC OP *DataAlias_pp_helem(pTHX) { |
710
|
11
|
|
|
|
|
|
dSP; |
711
|
11
|
|
|
|
|
|
SV *key = POPs; |
712
|
11
|
|
|
|
|
|
HV *hv = (HV *) POPs; |
713
|
|
|
|
|
|
|
HE *he; |
714
|
11
|
|
|
|
|
|
bool const localizing = PL_op->op_private & OPpLVAL_INTRO; |
715
|
|
|
|
|
|
|
|
716
|
11
|
50
|
|
|
|
|
if (SvRMAGICAL(hv) && da_badmagic(aTHX_ (SV *) hv)) |
|
|
0
|
|
|
|
|
|
717
|
0
|
|
|
|
|
|
DIE(aTHX_ DA_TIED_ERR, "put", "into", "hash"); |
718
|
|
|
|
|
|
|
|
719
|
11
|
50
|
|
|
|
|
if (SvTYPE(hv) == SVt_PVHV) { |
720
|
11
|
|
|
|
|
|
bool existed = TRUE; |
721
|
11
|
100
|
|
|
|
|
if (localizing) |
722
|
2
|
|
|
|
|
|
existed = hv_exists_ent(hv, key, 0); |
723
|
11
|
50
|
|
|
|
|
if (!(he = hv_fetch_ent(hv, key, TRUE, 0))) |
724
|
0
|
0
|
|
|
|
|
DIE(aTHX_ PL_no_helem, SvPV_nolen(key)); |
725
|
11
|
100
|
|
|
|
|
if (localizing) { |
726
|
2
|
100
|
|
|
|
|
if (!existed) |
727
|
1
|
|
|
|
|
|
save_hdelete(hv, key); |
728
|
|
|
|
|
|
|
else |
729
|
11
|
|
|
|
|
|
save_helem(hv, key, &HeVAL(he)); |
730
|
|
|
|
|
|
|
} |
731
|
|
|
|
|
|
|
} |
732
|
|
|
|
|
|
|
#if DA_FEATURE_AVHV |
733
|
|
|
|
|
|
|
else if (SvTYPE(hv) == SVt_PVAV && avhv_keys((AV *) hv)) { |
734
|
|
|
|
|
|
|
I32 i = da_avhv_index(aTHX_ (AV *) hv, key); |
735
|
|
|
|
|
|
|
if (localizing) |
736
|
|
|
|
|
|
|
save_aelem((AV *) hv, i, &AvARRAY(hv)[i]); |
737
|
|
|
|
|
|
|
key = (SV *) (Size_t) i; |
738
|
|
|
|
|
|
|
} |
739
|
|
|
|
|
|
|
#endif |
740
|
|
|
|
|
|
|
else { |
741
|
0
|
|
|
|
|
|
hv = (HV *) &PL_sv_undef; |
742
|
0
|
|
|
|
|
|
key = NULL; |
743
|
|
|
|
|
|
|
} |
744
|
11
|
|
|
|
|
|
PUSHaa(hv, key); |
745
|
11
|
|
|
|
|
|
RETURN; |
746
|
|
|
|
|
|
|
} |
747
|
|
|
|
|
|
|
|
748
|
3
|
|
|
|
|
|
STATIC OP *DataAlias_pp_aslice(pTHX) { |
749
|
3
|
|
|
|
|
|
dSP; dMARK; |
750
|
3
|
|
|
|
|
|
AV *av = (AV *) POPs; |
751
|
|
|
|
|
|
|
IV max, count; |
752
|
|
|
|
|
|
|
SV **src, **dst; |
753
|
3
|
|
|
|
|
|
const U32 local = PL_op->op_private & OPpLVAL_INTRO; |
754
|
3
|
50
|
|
|
|
|
if (SvTYPE(av) != SVt_PVAV) |
755
|
0
|
|
|
|
|
|
DIE(aTHX_ "Not an array"); |
756
|
3
|
50
|
|
|
|
|
if (SvRMAGICAL(av) && da_badmagic(aTHX_ (SV *) av)) |
|
|
0
|
|
|
|
|
|
757
|
0
|
|
|
|
|
|
DIE(aTHX_ DA_TIED_ERR, "put", "into", "array"); |
758
|
3
|
|
|
|
|
|
count = SP - MARK; |
759
|
3
|
50
|
|
|
|
|
EXTEND(sp, count); |
|
|
50
|
|
|
|
|
|
760
|
3
|
|
|
|
|
|
src = SP; |
761
|
3
|
|
|
|
|
|
dst = SP += count; |
762
|
3
|
|
|
|
|
|
max = AvFILLp(av); |
763
|
3
|
|
|
|
|
|
count = max + 1; |
764
|
9
|
100
|
|
|
|
|
while (MARK < src) { |
765
|
6
|
50
|
|
|
|
|
IV i = SvIVx(*src); |
766
|
6
|
50
|
|
|
|
|
if (i > DA_ARRAY_MAXIDX || (i < 0 && (i += count) < 0)) |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
767
|
0
|
|
|
|
|
|
DIE(aTHX_ PL_no_aelem, SvIVX(*src)); |
768
|
6
|
100
|
|
|
|
|
if (local) |
769
|
2
|
|
|
|
|
|
save_aelem(av, i, av_fetch(av, i, TRUE)); |
770
|
6
|
100
|
|
|
|
|
if (i > max) |
771
|
2
|
|
|
|
|
|
max = i; |
772
|
6
|
|
|
|
|
|
*dst-- = (SV *) (Size_t) i; |
773
|
6
|
|
|
|
|
|
*dst-- = (SV *) av; |
774
|
6
|
|
|
|
|
|
--src; |
775
|
|
|
|
|
|
|
} |
776
|
3
|
100
|
|
|
|
|
if (max > AvMAX(av)) |
777
|
1
|
|
|
|
|
|
av_extend(av, max); |
778
|
3
|
|
|
|
|
|
RETURN; |
779
|
|
|
|
|
|
|
} |
780
|
|
|
|
|
|
|
|
781
|
3
|
|
|
|
|
|
STATIC OP *DataAlias_pp_hslice(pTHX) { |
782
|
3
|
|
|
|
|
|
dSP; dMARK; |
783
|
3
|
|
|
|
|
|
HV *hv = (HV *) POPs; |
784
|
|
|
|
|
|
|
SV *key; |
785
|
|
|
|
|
|
|
HE *he; |
786
|
|
|
|
|
|
|
SV **src, **dst; |
787
|
3
|
|
|
|
|
|
IV i = SP - MARK; |
788
|
3
|
50
|
|
|
|
|
if (SvRMAGICAL(hv) && da_badmagic(aTHX_ (SV *) hv)) |
|
|
0
|
|
|
|
|
|
789
|
0
|
|
|
|
|
|
DIE(aTHX_ DA_TIED_ERR, "put", "into", "hash"); |
790
|
3
|
50
|
|
|
|
|
EXTEND(sp, i); |
|
|
50
|
|
|
|
|
|
791
|
3
|
|
|
|
|
|
src = SP; |
792
|
3
|
|
|
|
|
|
dst = SP += i; |
793
|
3
|
50
|
|
|
|
|
if (SvTYPE(hv) == SVt_PVHV) { |
794
|
9
|
100
|
|
|
|
|
while (MARK < src) { |
795
|
6
|
50
|
|
|
|
|
if (!(he = hv_fetch_ent(hv, key = *src--, TRUE, 0))) |
796
|
0
|
0
|
|
|
|
|
DIE(aTHX_ PL_no_helem, SvPV_nolen(key)); |
797
|
6
|
100
|
|
|
|
|
if (PL_op->op_private & OPpLVAL_INTRO) |
798
|
2
|
|
|
|
|
|
save_helem(hv, key, &HeVAL(he)); |
799
|
6
|
|
|
|
|
|
*dst-- = key; |
800
|
6
|
|
|
|
|
|
*dst-- = (SV *) hv; |
801
|
|
|
|
|
|
|
} |
802
|
|
|
|
|
|
|
} |
803
|
|
|
|
|
|
|
#if DA_FEATURE_AVHV |
804
|
|
|
|
|
|
|
else if (SvTYPE(hv) == SVt_PVAV && avhv_keys((AV *) hv)) { |
805
|
|
|
|
|
|
|
while (MARK < src) { |
806
|
|
|
|
|
|
|
i = da_avhv_index(aTHX_ (AV *) hv, key = *src--); |
807
|
|
|
|
|
|
|
if (PL_op->op_private & OPpLVAL_INTRO) |
808
|
|
|
|
|
|
|
save_aelem((AV *) hv, i, &AvARRAY(hv)[i]); |
809
|
|
|
|
|
|
|
*dst-- = (SV *) (Size_t) i; |
810
|
|
|
|
|
|
|
*dst-- = (SV *) hv; |
811
|
|
|
|
|
|
|
} |
812
|
|
|
|
|
|
|
} |
813
|
|
|
|
|
|
|
#endif |
814
|
|
|
|
|
|
|
else { |
815
|
0
|
|
|
|
|
|
DIE(aTHX_ "Not a hash"); |
816
|
|
|
|
|
|
|
} |
817
|
3
|
|
|
|
|
|
RETURN; |
818
|
|
|
|
|
|
|
} |
819
|
|
|
|
|
|
|
|
820
|
|
|
|
|
|
|
#if DA_HAVE_OP_PADRANGE |
821
|
|
|
|
|
|
|
|
822
|
7
|
|
|
|
|
|
STATIC OP *DataAlias_pp_padrange_generic(pTHX_ bool is_single) { |
823
|
7
|
|
|
|
|
|
dSP; |
824
|
7
|
|
|
|
|
|
IV start = PL_op->op_targ; |
825
|
7
|
|
|
|
|
|
IV count = PL_op->op_private & OPpPADRANGE_COUNTMASK; |
826
|
|
|
|
|
|
|
IV index; |
827
|
7
|
100
|
|
|
|
|
if (PL_op->op_flags & OPf_SPECIAL) { |
828
|
5
|
50
|
|
|
|
|
AV *av = GvAVn(PL_defgv); |
829
|
5
|
50
|
|
|
|
|
PUSHMARK(SP); |
830
|
5
|
100
|
|
|
|
|
if (is_single) { |
831
|
1
|
50
|
|
|
|
|
XPUSHs((SV*)av); |
832
|
|
|
|
|
|
|
} else { |
833
|
4
|
50
|
|
|
|
|
const I32 maxarg = AvFILL(av) + 1; |
834
|
4
|
50
|
|
|
|
|
EXTEND(SP, maxarg); |
|
|
50
|
|
|
|
|
|
835
|
4
|
50
|
|
|
|
|
if (SvRMAGICAL(av)) { |
836
|
|
|
|
|
|
|
U32 i; |
837
|
0
|
0
|
|
|
|
|
for (i=0; i < (U32)maxarg; i++) { |
838
|
0
|
|
|
|
|
|
SV ** const svp = |
839
|
0
|
|
|
|
|
|
av_fetch(av, i, FALSE); |
840
|
0
|
|
|
|
|
|
SP[i+1] = svp ? |
841
|
0
|
|
|
|
|
|
SvGMAGICAL(*svp) ? |
842
|
0
|
0
|
|
|
|
|
(mg_get(*svp), *svp) : |
843
|
0
|
0
|
|
|
|
|
*svp : |
844
|
|
|
|
|
|
|
&PL_sv_undef; |
845
|
|
|
|
|
|
|
} |
846
|
|
|
|
|
|
|
} else { |
847
|
4
|
50
|
|
|
|
|
Copy(AvARRAY(av), SP+1, maxarg, SV*); |
848
|
|
|
|
|
|
|
} |
849
|
4
|
|
|
|
|
|
SP += maxarg; |
850
|
|
|
|
|
|
|
} |
851
|
|
|
|
|
|
|
} |
852
|
7
|
50
|
|
|
|
|
if ((PL_op->op_flags & OPf_WANT) != OPf_WANT_VOID) { |
853
|
7
|
50
|
|
|
|
|
PUSHMARK(SP); |
854
|
7
|
50
|
|
|
|
|
EXTEND(SP, count << 1); |
|
|
50
|
|
|
|
|
|
855
|
|
|
|
|
|
|
} |
856
|
17
|
100
|
|
|
|
|
for(index = start; index != start+count; index++) { |
857
|
|
|
|
|
|
|
Size_t da_type; |
858
|
10
|
100
|
|
|
|
|
if (is_single) { |
859
|
1
|
|
|
|
|
|
da_type = DA_ALIAS_PAD; |
860
|
|
|
|
|
|
|
} else { |
861
|
9
|
|
|
|
|
|
switch(SvTYPE(PAD_SVl(index))) { |
862
|
3
|
|
|
|
|
|
case SVt_PVAV: da_type = DA_ALIAS_AV; break; |
863
|
0
|
|
|
|
|
|
case SVt_PVHV: da_type = DA_ALIAS_HV; break; |
864
|
6
|
|
|
|
|
|
default: da_type = DA_ALIAS_PAD; break; |
865
|
|
|
|
|
|
|
} |
866
|
|
|
|
|
|
|
} |
867
|
10
|
50
|
|
|
|
|
if ((PL_op->op_private & (OPpLVAL_INTRO|OPpPAD_STATE)) == OPpLVAL_INTRO) { |
868
|
10
|
100
|
|
|
|
|
if (da_type == DA_ALIAS_PAD) { |
869
|
7
|
|
|
|
|
|
SAVEGENERICSV(PAD_SVl(index)); |
870
|
7
|
|
|
|
|
|
PAD_SVl(index) = &PL_sv_undef; |
871
|
|
|
|
|
|
|
} else { |
872
|
3
|
|
|
|
|
|
SAVECLEARSV(PAD_SVl(index)); |
873
|
|
|
|
|
|
|
} |
874
|
|
|
|
|
|
|
} |
875
|
10
|
50
|
|
|
|
|
if ((PL_op->op_flags & OPf_WANT) != OPf_WANT_VOID) |
876
|
10
|
100
|
|
|
|
|
PUSHaa(da_type, da_type == DA_ALIAS_PAD ? |
877
|
|
|
|
|
|
|
(Size_t)index : |
878
|
|
|
|
|
|
|
(Size_t)PAD_SVl(index)); |
879
|
|
|
|
|
|
|
} |
880
|
7
|
|
|
|
|
|
RETURN; |
881
|
|
|
|
|
|
|
} |
882
|
|
|
|
|
|
|
|
883
|
6
|
|
|
|
|
|
STATIC OP *DataAlias_pp_padrange_list(pTHX) { |
884
|
6
|
|
|
|
|
|
return DataAlias_pp_padrange_generic(aTHX_ 0); |
885
|
|
|
|
|
|
|
} |
886
|
|
|
|
|
|
|
|
887
|
1
|
|
|
|
|
|
STATIC OP *DataAlias_pp_padrange_single(pTHX) { |
888
|
1
|
|
|
|
|
|
return DataAlias_pp_padrange_generic(aTHX_ 1); |
889
|
|
|
|
|
|
|
} |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
#endif |
892
|
|
|
|
|
|
|
|
893
|
|
|
|
|
|
|
#if DA_HAVE_OP_PADSV_STORE |
894
|
|
|
|
|
|
|
STATIC OP *DataAlias_pp_padsv_store(pTHX) { |
895
|
|
|
|
|
|
|
dSP; |
896
|
|
|
|
|
|
|
PADOFFSET index = PL_op->op_targ; |
897
|
|
|
|
|
|
|
if ((PL_op->op_private & (OPpLVAL_INTRO|OPpPAD_STATE)) == OPpLVAL_INTRO) { |
898
|
|
|
|
|
|
|
SAVEGENERICSV(PAD_SVl(index)); |
899
|
|
|
|
|
|
|
PAD_SVl(index) = &PL_sv_undef; |
900
|
|
|
|
|
|
|
} |
901
|
|
|
|
|
|
|
da_alias_pad(aTHX_ index, TOPs); |
902
|
|
|
|
|
|
|
RETURN; |
903
|
|
|
|
|
|
|
} |
904
|
|
|
|
|
|
|
#endif |
905
|
|
|
|
|
|
|
|
906
|
23
|
|
|
|
|
|
STATIC OP *DataAlias_pp_padsv(pTHX) { |
907
|
23
|
|
|
|
|
|
dSP; |
908
|
23
|
|
|
|
|
|
PADOFFSET index = PL_op->op_targ; |
909
|
23
|
100
|
|
|
|
|
if ((PL_op->op_private & (OPpLVAL_INTRO|OPpPAD_STATE)) == OPpLVAL_INTRO) { |
910
|
7
|
|
|
|
|
|
SAVEGENERICSV(PAD_SVl(index)); |
911
|
7
|
|
|
|
|
|
PAD_SVl(index) = &PL_sv_undef; |
912
|
|
|
|
|
|
|
} |
913
|
23
|
50
|
|
|
|
|
XPUSHaa(DA_ALIAS_PAD, index); |
914
|
23
|
|
|
|
|
|
RETURN; |
915
|
|
|
|
|
|
|
} |
916
|
|
|
|
|
|
|
|
917
|
1
|
|
|
|
|
|
STATIC OP *DataAlias_pp_padav(pTHX) { |
918
|
1
|
|
|
|
|
|
dSP; dTARGET; |
919
|
1
|
50
|
|
|
|
|
if ((PL_op->op_private & (OPpLVAL_INTRO|OPpPAD_STATE)) == OPpLVAL_INTRO) |
920
|
1
|
|
|
|
|
|
SAVECLEARSV(PAD_SVl(PL_op->op_targ)); |
921
|
1
|
50
|
|
|
|
|
XPUSHaa(DA_ALIAS_AV, TARG); |
922
|
1
|
|
|
|
|
|
RETURN; |
923
|
|
|
|
|
|
|
} |
924
|
|
|
|
|
|
|
|
925
|
0
|
|
|
|
|
|
STATIC OP *DataAlias_pp_padhv(pTHX) { |
926
|
0
|
|
|
|
|
|
dSP; dTARGET; |
927
|
0
|
0
|
|
|
|
|
if ((PL_op->op_private & (OPpLVAL_INTRO|OPpPAD_STATE)) == OPpLVAL_INTRO) |
928
|
0
|
|
|
|
|
|
SAVECLEARSV(PAD_SVl(PL_op->op_targ)); |
929
|
0
|
0
|
|
|
|
|
XPUSHaa(DA_ALIAS_HV, TARG); |
930
|
0
|
|
|
|
|
|
RETURN; |
931
|
|
|
|
|
|
|
} |
932
|
|
|
|
|
|
|
|
933
|
70
|
|
|
|
|
|
STATIC OP *DataAlias_pp_gvsv(pTHX) { |
934
|
70
|
|
|
|
|
|
dSP; |
935
|
70
|
|
|
|
|
|
GV *gv = cGVOP_gv; |
936
|
70
|
100
|
|
|
|
|
if (PL_op->op_private & OPpLVAL_INTRO) { |
937
|
4
|
|
|
|
|
|
da_localize_gvar(aTHX_ GvGP(gv), &GvSV(gv)); |
938
|
4
|
|
|
|
|
|
GvSV(gv) = newSV(0); |
939
|
|
|
|
|
|
|
} |
940
|
70
|
50
|
|
|
|
|
XPUSHaa(DA_ALIAS_RV, gv); |
941
|
70
|
|
|
|
|
|
RETURN; |
942
|
|
|
|
|
|
|
} |
943
|
|
|
|
|
|
|
|
944
|
1
|
|
|
|
|
|
STATIC OP *DataAlias_pp_gvsv_r(pTHX) { |
945
|
1
|
|
|
|
|
|
dSP; |
946
|
1
|
|
|
|
|
|
GV *gv = cGVOP_gv; |
947
|
1
|
50
|
|
|
|
|
if (PL_op->op_private & OPpLVAL_INTRO) { |
948
|
1
|
|
|
|
|
|
da_localize_gvar(aTHX_ GvGP(gv), &GvSV(gv)); |
949
|
1
|
|
|
|
|
|
GvSV(gv) = newSV(0); |
950
|
|
|
|
|
|
|
} |
951
|
1
|
50
|
|
|
|
|
XPUSHs(GvSV(gv)); |
952
|
1
|
|
|
|
|
|
RETURN; |
953
|
|
|
|
|
|
|
} |
954
|
|
|
|
|
|
|
|
955
|
10
|
|
|
|
|
|
STATIC GV *fixglob(pTHX_ GV *gv) { |
956
|
10
|
|
|
|
|
|
SV **svp = hv_fetch(GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv), FALSE); |
957
|
|
|
|
|
|
|
GV *egv; |
958
|
10
|
50
|
|
|
|
|
if (!svp || !(egv = (GV *) *svp) || GvGP(egv) != GvGP(gv)) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
959
|
0
|
|
|
|
|
|
return gv; |
960
|
10
|
|
|
|
|
|
GvEGV(gv) = egv; |
961
|
10
|
|
|
|
|
|
return egv; |
962
|
|
|
|
|
|
|
} |
963
|
|
|
|
|
|
|
|
964
|
39
|
|
|
|
|
|
STATIC OP *DataAlias_pp_rv2sv(pTHX) { |
965
|
39
|
|
|
|
|
|
dSP; dPOPss; |
966
|
39
|
100
|
|
|
|
|
if (!SvROK(sv) && SvTYPE(sv) != SVt_PVGV) do { |
|
|
100
|
|
|
|
|
|
967
|
|
|
|
|
|
|
const char *tname; |
968
|
|
|
|
|
|
|
U32 type; |
969
|
2
|
|
|
|
|
|
switch (PL_op->op_type) { |
970
|
0
|
|
|
|
|
|
case OP_RV2AV: type = SVt_PVAV; tname = "an ARRAY"; break; |
971
|
0
|
|
|
|
|
|
case OP_RV2HV: type = SVt_PVHV; tname = "a HASH"; break; |
972
|
2
|
|
|
|
|
|
default: type = SVt_PV; tname = "a SCALAR"; |
973
|
|
|
|
|
|
|
} |
974
|
2
|
50
|
|
|
|
|
if (SvGMAGICAL(sv)) { |
975
|
0
|
|
|
|
|
|
mg_get(sv); |
976
|
0
|
0
|
|
|
|
|
if (SvROK(sv)) |
977
|
0
|
|
|
|
|
|
break; |
978
|
|
|
|
|
|
|
} |
979
|
2
|
50
|
|
|
|
|
if (!SvOK(sv)) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
980
|
0
|
|
|
|
|
|
break; |
981
|
2
|
100
|
|
|
|
|
if (PL_op->op_private & HINT_STRICT_REFS) |
982
|
1
|
50
|
|
|
|
|
DIE(aTHX_ msg_no_symref, SvPV_nolen(sv), tname); |
983
|
1
|
50
|
|
|
|
|
sv = (SV *) gv_fetchpv(SvPV_nolen(sv), TRUE, type); |
984
|
|
|
|
|
|
|
} while (0); |
985
|
38
|
100
|
|
|
|
|
if (SvTYPE(sv) == SVt_PVGV) |
986
|
28
|
100
|
|
|
|
|
sv = (SV *) (GvEGV(sv) ? GvEGV(sv) : fixglob(aTHX_ (GV *) sv)); |
987
|
38
|
100
|
|
|
|
|
if (PL_op->op_private & OPpLVAL_INTRO) { |
988
|
12
|
100
|
|
|
|
|
if (SvTYPE(sv) != SVt_PVGV || SvFAKE(sv)) |
|
|
50
|
|
|
|
|
|
989
|
3
|
|
|
|
|
|
DIE(aTHX_ "%s", PL_no_localize_ref); |
990
|
9
|
|
|
|
|
|
switch (PL_op->op_type) { |
991
|
|
|
|
|
|
|
case OP_RV2AV: |
992
|
4
|
|
|
|
|
|
da_localize_gvar(aTHX_ GvGP(sv), (SV **) &GvAV(sv)); |
993
|
4
|
|
|
|
|
|
break; |
994
|
|
|
|
|
|
|
case OP_RV2HV: |
995
|
4
|
|
|
|
|
|
da_localize_gvar(aTHX_ GvGP(sv), (SV **) &GvHV(sv)); |
996
|
4
|
|
|
|
|
|
break; |
997
|
|
|
|
|
|
|
default: |
998
|
1
|
|
|
|
|
|
da_localize_gvar(aTHX_ GvGP(sv), &GvSV(sv)); |
999
|
1
|
|
|
|
|
|
GvSV(sv) = newSV(0); |
1000
|
|
|
|
|
|
|
} |
1001
|
|
|
|
|
|
|
} |
1002
|
35
|
50
|
|
|
|
|
XPUSHaa(DA_ALIAS_RV, sv); |
1003
|
35
|
|
|
|
|
|
RETURN; |
1004
|
|
|
|
|
|
|
} |
1005
|
|
|
|
|
|
|
|
1006
|
2
|
|
|
|
|
|
STATIC OP *DataAlias_pp_rv2sv_r(pTHX) { |
1007
|
|
|
|
|
|
|
U8 savedflags; |
1008
|
2
|
|
|
|
|
|
OP *op = PL_op, *ret; |
1009
|
|
|
|
|
|
|
|
1010
|
2
|
|
|
|
|
|
DataAlias_pp_rv2sv(aTHX); |
1011
|
2
|
|
|
|
|
|
PL_stack_sp[-1] = PL_stack_sp[0]; |
1012
|
2
|
|
|
|
|
|
--PL_stack_sp; |
1013
|
|
|
|
|
|
|
|
1014
|
2
|
|
|
|
|
|
savedflags = op->op_private; |
1015
|
2
|
|
|
|
|
|
op->op_private = savedflags & ~OPpLVAL_INTRO; |
1016
|
|
|
|
|
|
|
|
1017
|
2
|
|
|
|
|
|
ret = PL_ppaddr[op->op_type](aTHX); |
1018
|
|
|
|
|
|
|
|
1019
|
2
|
|
|
|
|
|
op->op_private = savedflags; |
1020
|
|
|
|
|
|
|
|
1021
|
2
|
|
|
|
|
|
return ret; |
1022
|
|
|
|
|
|
|
} |
1023
|
|
|
|
|
|
|
|
1024
|
15
|
|
|
|
|
|
STATIC OP *DataAlias_pp_rv2gv(pTHX) { |
1025
|
15
|
|
|
|
|
|
dSP; dPOPss; |
1026
|
15
|
100
|
|
|
|
|
if (SvROK(sv)) { |
1027
|
2
|
|
|
|
|
|
wasref: sv = SvRV(sv); |
1028
|
2
|
50
|
|
|
|
|
if (SvTYPE(sv) != SVt_PVGV) |
1029
|
0
|
|
|
|
|
|
DIE(aTHX_ "Not a GLOB reference"); |
1030
|
13
|
100
|
|
|
|
|
} else if (SvTYPE(sv) != SVt_PVGV) { |
1031
|
2
|
50
|
|
|
|
|
if (SvGMAGICAL(sv)) { |
1032
|
0
|
|
|
|
|
|
mg_get(sv); |
1033
|
0
|
0
|
|
|
|
|
if (SvROK(sv)) |
1034
|
0
|
|
|
|
|
|
goto wasref; |
1035
|
|
|
|
|
|
|
} |
1036
|
2
|
50
|
|
|
|
|
if (!SvOK(sv)) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1037
|
0
|
|
|
|
|
|
DIE(aTHX_ PL_no_usym, "a symbol"); |
1038
|
2
|
100
|
|
|
|
|
if (PL_op->op_private & HINT_STRICT_REFS) |
1039
|
1
|
50
|
|
|
|
|
DIE(aTHX_ msg_no_symref, SvPV_nolen(sv), "a symbol"); |
1040
|
1
|
50
|
|
|
|
|
sv = (SV *) gv_fetchpv(SvPV_nolen(sv), TRUE, SVt_PVGV); |
1041
|
|
|
|
|
|
|
} |
1042
|
14
|
50
|
|
|
|
|
if (SvTYPE(sv) == SVt_PVGV) |
1043
|
14
|
100
|
|
|
|
|
sv = (SV *) (GvEGV(sv) ? GvEGV(sv) : fixglob(aTHX_ (GV *) sv)); |
1044
|
14
|
100
|
|
|
|
|
if (PL_op->op_private & OPpLVAL_INTRO) |
1045
|
11
|
|
|
|
|
|
save_gp((GV *) sv, !(PL_op->op_flags & OPf_SPECIAL)); |
1046
|
14
|
50
|
|
|
|
|
XPUSHaa(DA_ALIAS_GV, sv); |
1047
|
14
|
|
|
|
|
|
RETURN; |
1048
|
|
|
|
|
|
|
} |
1049
|
|
|
|
|
|
|
|
1050
|
5
|
|
|
|
|
|
STATIC OP *DataAlias_pp_rv2av(pTHX) { |
1051
|
5
|
|
|
|
|
|
OP *ret = PL_ppaddr[OP_RV2AV](aTHX); |
1052
|
5
|
|
|
|
|
|
dSP; |
1053
|
5
|
|
|
|
|
|
SV *av = POPs; |
1054
|
5
|
50
|
|
|
|
|
XPUSHaa(DA_ALIAS_AV, av); |
1055
|
5
|
|
|
|
|
|
PUTBACK; |
1056
|
5
|
|
|
|
|
|
return ret; |
1057
|
|
|
|
|
|
|
} |
1058
|
|
|
|
|
|
|
|
1059
|
10
|
|
|
|
|
|
STATIC OP *DataAlias_pp_rv2hv(pTHX) { |
1060
|
10
|
|
|
|
|
|
OP *ret = PL_ppaddr[OP_RV2HV](aTHX); |
1061
|
10
|
|
|
|
|
|
dSP; |
1062
|
10
|
|
|
|
|
|
SV *hv = POPs; |
1063
|
10
|
50
|
|
|
|
|
XPUSHaa(DA_ALIAS_HV, hv); |
1064
|
10
|
|
|
|
|
|
PUTBACK; |
1065
|
10
|
|
|
|
|
|
return ret; |
1066
|
|
|
|
|
|
|
} |
1067
|
|
|
|
|
|
|
|
1068
|
78
|
|
|
|
|
|
STATIC OP *DataAlias_pp_sassign(pTHX) { |
1069
|
78
|
|
|
|
|
|
dSP; |
1070
|
|
|
|
|
|
|
SV *a1, *a2, *value; |
1071
|
78
|
100
|
|
|
|
|
if (PL_op->op_private & OPpASSIGN_BACKWARDS) { |
1072
|
17
|
|
|
|
|
|
value = POPs, a2 = POPs, a1 = TOPs; |
1073
|
17
|
|
|
|
|
|
SETs(value); |
1074
|
|
|
|
|
|
|
} else { |
1075
|
61
|
|
|
|
|
|
a2 = POPs, a1 = POPs, value = TOPs; |
1076
|
|
|
|
|
|
|
} |
1077
|
78
|
|
|
|
|
|
da_alias(aTHX_ a1, a2, value); |
1078
|
78
|
|
|
|
|
|
RETURN; |
1079
|
|
|
|
|
|
|
} |
1080
|
|
|
|
|
|
|
|
1081
|
72
|
|
|
|
|
|
STATIC OP *DataAlias_pp_aassign(pTHX) { |
1082
|
72
|
|
|
|
|
|
dSP; |
1083
|
|
|
|
|
|
|
SV **left, **llast, **right, **rlast; |
1084
|
72
|
100
|
|
|
|
|
I32 gimme = GIMME_V; |
1085
|
72
|
|
|
|
|
|
I32 done = FALSE; |
1086
|
72
|
50
|
|
|
|
|
EXTEND(sp, 1); |
1087
|
72
|
|
|
|
|
|
left = POPMARK + PL_stack_base + 1; |
1088
|
72
|
|
|
|
|
|
llast = SP; |
1089
|
72
|
|
|
|
|
|
right = POPMARK + PL_stack_base + 1; |
1090
|
72
|
|
|
|
|
|
rlast = left - 1; |
1091
|
72
|
100
|
|
|
|
|
if (PL_op->op_private & OPpALIAS) { |
1092
|
29
|
|
|
|
|
|
U32 hash = (PL_op->op_private & OPpALIASHV); |
1093
|
29
|
100
|
|
|
|
|
U32 type = hash ? SVt_PVHV : SVt_PVAV; |
1094
|
29
|
|
|
|
|
|
SV *a2 = POPs; |
1095
|
29
|
|
|
|
|
|
SV *a1 = POPs; |
1096
|
|
|
|
|
|
|
OPCODE savedop; |
1097
|
29
|
50
|
|
|
|
|
if (SP != rlast) |
1098
|
0
|
|
|
|
|
|
DIE(aTHX_ "Panic: unexpected number of lvalues"); |
1099
|
29
|
|
|
|
|
|
PUTBACK; |
1100
|
29
|
100
|
|
|
|
|
if (right != rlast || SvTYPE(*right) != type) { |
|
|
100
|
|
|
|
|
|
1101
|
8
|
50
|
|
|
|
|
PUSHMARK(right - 1); |
1102
|
8
|
100
|
|
|
|
|
hash ? DataAlias_pp_anonhash(aTHX) : DataAlias_pp_anonlist(aTHX); |
1103
|
8
|
|
|
|
|
|
SPAGAIN; |
1104
|
|
|
|
|
|
|
} |
1105
|
29
|
|
|
|
|
|
da_alias(aTHX_ a1, a2, TOPs); |
1106
|
29
|
|
|
|
|
|
savedop = PL_op->op_type; |
1107
|
29
|
100
|
|
|
|
|
PL_op->op_type = hash ? OP_RV2HV : OP_RV2AV; |
1108
|
29
|
|
|
|
|
|
PL_ppaddr[PL_op->op_type](aTHX); |
1109
|
29
|
|
|
|
|
|
PL_op->op_type = savedop; |
1110
|
29
|
|
|
|
|
|
return NORMAL; |
1111
|
|
|
|
|
|
|
} |
1112
|
43
|
|
|
|
|
|
SP = right - 1; |
1113
|
159
|
100
|
|
|
|
|
while (SP < rlast) |
1114
|
116
|
100
|
|
|
|
|
if (!SvTEMP(*++SP)) |
1115
|
105
|
|
|
|
|
|
sv_2mortal(SvREFCNT_inc_NN(*SP)); |
1116
|
43
|
|
|
|
|
|
SP = right - 1; |
1117
|
132
|
100
|
|
|
|
|
while (left <= llast) { |
1118
|
90
|
|
|
|
|
|
SV *a1 = *left++, *a2; |
1119
|
90
|
100
|
|
|
|
|
if (a1 == &PL_sv_undef) { |
1120
|
3
|
|
|
|
|
|
right++; |
1121
|
3
|
|
|
|
|
|
continue; |
1122
|
|
|
|
|
|
|
} |
1123
|
87
|
|
|
|
|
|
a2 = *left++; |
1124
|
87
|
|
|
|
|
|
switch ((Size_t) a1) { |
1125
|
|
|
|
|
|
|
case DA_ALIAS_AV: { |
1126
|
|
|
|
|
|
|
SV **svp; |
1127
|
9
|
50
|
|
|
|
|
if (SvRMAGICAL(a2) && da_badmagic(aTHX_ a2)) |
|
|
0
|
|
|
|
|
|
1128
|
0
|
|
|
|
|
|
DIE(aTHX_ DA_TIED_ERR, "put", "into", "array"); |
1129
|
9
|
|
|
|
|
|
av_clear((AV *) a2); |
1130
|
9
|
50
|
|
|
|
|
if (done || right > rlast) |
|
|
100
|
|
|
|
|
|
1131
|
|
|
|
|
|
|
break; |
1132
|
7
|
|
|
|
|
|
av_extend((AV *) a2, rlast - right); |
1133
|
7
|
|
|
|
|
|
AvFILLp((AV *) a2) = rlast - right; |
1134
|
7
|
|
|
|
|
|
svp = AvARRAY((AV *) a2); |
1135
|
27
|
100
|
|
|
|
|
while (right <= rlast) |
1136
|
20
|
|
|
|
|
|
SvTEMP_off(*svp++ = SvREFCNT_inc_NN(*right++)); |
1137
|
7
|
|
|
|
|
|
break; |
1138
|
|
|
|
|
|
|
} case DA_ALIAS_HV: { |
1139
|
10
|
|
|
|
|
|
SV *tmp, *val, **svp = rlast; |
1140
|
10
|
|
|
|
|
|
U32 dups = 0, nils = 0; |
1141
|
|
|
|
|
|
|
HE *he; |
1142
|
|
|
|
|
|
|
#if DA_FEATURE_AVHV |
1143
|
|
|
|
|
|
|
if (SvTYPE(a2) == SVt_PVAV) |
1144
|
|
|
|
|
|
|
goto phash; |
1145
|
|
|
|
|
|
|
#endif |
1146
|
10
|
100
|
|
|
|
|
if (SvRMAGICAL(a2) && da_badmagic(aTHX_ a2)) |
|
|
50
|
|
|
|
|
|
1147
|
0
|
|
|
|
|
|
DIE(aTHX_ DA_TIED_ERR, "put", "into", "hash"); |
1148
|
10
|
|
|
|
|
|
hv_clear((HV *) a2); |
1149
|
10
|
50
|
|
|
|
|
if (done || right > rlast) |
|
|
100
|
|
|
|
|
|
1150
|
|
|
|
|
|
|
break; |
1151
|
8
|
|
|
|
|
|
done = TRUE; |
1152
|
8
|
|
|
|
|
|
hv_ksplit((HV *) a2, (rlast - right + 2) >> 1); |
1153
|
8
|
100
|
|
|
|
|
if (1 & ~(rlast - right)) { |
|
|
100
|
|
|
|
|
|
1154
|
3
|
100
|
|
|
|
|
if (ckWARN(WARN_MISC)) |
1155
|
1
|
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_MISC), |
1156
|
|
|
|
|
|
|
DA_ODD_HASH_ERR); |
1157
|
2
|
|
|
|
|
|
*++svp = &PL_sv_undef; |
1158
|
|
|
|
|
|
|
} |
1159
|
27
|
100
|
|
|
|
|
while (svp > right) { |
1160
|
20
|
|
|
|
|
|
val = *svp--; tmp = *svp--; |
1161
|
20
|
|
|
|
|
|
he = hv_fetch_ent((HV *) a2, tmp, TRUE, 0); |
1162
|
20
|
50
|
|
|
|
|
if (!he) /* is this possible? */ |
1163
|
0
|
0
|
|
|
|
|
DIE(aTHX_ PL_no_helem, SvPV_nolen(tmp)); |
1164
|
20
|
|
|
|
|
|
tmp = HeVAL(he); |
1165
|
20
|
100
|
|
|
|
|
if (SvREFCNT(tmp) > 1) { /* existing element */ |
1166
|
6
|
|
|
|
|
|
svp[1] = svp[2] = NULL; |
1167
|
6
|
|
|
|
|
|
dups += 2; |
1168
|
6
|
|
|
|
|
|
continue; |
1169
|
|
|
|
|
|
|
} |
1170
|
14
|
100
|
|
|
|
|
if (val == &PL_sv_undef) |
1171
|
5
|
|
|
|
|
|
nils++; |
1172
|
14
|
|
|
|
|
|
SvREFCNT_dec(tmp); |
1173
|
14
|
|
|
|
|
|
SvTEMP_off(HeVAL(he) = |
1174
|
|
|
|
|
|
|
SvREFCNT_inc_simple_NN(val)); |
1175
|
|
|
|
|
|
|
} |
1176
|
15
|
100
|
|
|
|
|
while (nils && (he = hv_iternext((HV *) a2))) { |
|
|
50
|
|
|
|
|
|
1177
|
8
|
100
|
|
|
|
|
if (HeVAL(he) == &PL_sv_undef) { |
1178
|
5
|
|
|
|
|
|
HeVAL(he) = &PL_sv_placeholder; |
1179
|
5
|
|
|
|
|
|
HvPLACEHOLDERS(a2)++; |
1180
|
5
|
|
|
|
|
|
nils--; |
1181
|
|
|
|
|
|
|
} |
1182
|
|
|
|
|
|
|
} |
1183
|
7
|
100
|
|
|
|
|
if (gimme != G_LIST || !dups) { |
|
|
100
|
|
|
|
|
|
1184
|
5
|
|
|
|
|
|
right = rlast - dups + 1; |
1185
|
5
|
|
|
|
|
|
break; |
1186
|
|
|
|
|
|
|
} |
1187
|
15
|
100
|
|
|
|
|
while (svp++ < rlast) { |
1188
|
13
|
100
|
|
|
|
|
if (*svp) |
1189
|
7
|
|
|
|
|
|
*right++ = *svp; |
1190
|
|
|
|
|
|
|
} |
1191
|
2
|
|
|
|
|
|
break; |
1192
|
|
|
|
|
|
|
} |
1193
|
|
|
|
|
|
|
#if DA_FEATURE_AVHV |
1194
|
|
|
|
|
|
|
phash: { |
1195
|
|
|
|
|
|
|
SV *key, *val, **svp = rlast, **he; |
1196
|
|
|
|
|
|
|
U32 dups = 0; |
1197
|
|
|
|
|
|
|
I32 i; |
1198
|
|
|
|
|
|
|
if (SvRMAGICAL(a2) && da_badmagic(aTHX_ a2)) |
1199
|
|
|
|
|
|
|
DIE(aTHX_ DA_TIED_ERR, "put", "into", "hash"); |
1200
|
|
|
|
|
|
|
avhv_keys((AV *) a2); |
1201
|
|
|
|
|
|
|
av_fill((AV *) a2, 0); |
1202
|
|
|
|
|
|
|
if (done || right > rlast) |
1203
|
|
|
|
|
|
|
break; |
1204
|
|
|
|
|
|
|
done = TRUE; |
1205
|
|
|
|
|
|
|
if (1 & ~(rlast - right)) { |
1206
|
|
|
|
|
|
|
if (ckWARN(WARN_MISC)) |
1207
|
|
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_MISC), |
1208
|
|
|
|
|
|
|
DA_ODD_HASH_ERR); |
1209
|
|
|
|
|
|
|
*++svp = &PL_sv_undef; |
1210
|
|
|
|
|
|
|
} |
1211
|
|
|
|
|
|
|
ENTER; |
1212
|
|
|
|
|
|
|
while (svp > right) { |
1213
|
|
|
|
|
|
|
val = *svp--; key = *svp--; |
1214
|
|
|
|
|
|
|
i = da_avhv_index(aTHX_ (AV *) a2, key); |
1215
|
|
|
|
|
|
|
he = &AvARRAY(a2)[i]; |
1216
|
|
|
|
|
|
|
if (*he != &PL_sv_undef) { |
1217
|
|
|
|
|
|
|
svp[1] = svp[2] = NULL; |
1218
|
|
|
|
|
|
|
dups += 2; |
1219
|
|
|
|
|
|
|
continue; |
1220
|
|
|
|
|
|
|
} |
1221
|
|
|
|
|
|
|
SvREFCNT_dec(*he); |
1222
|
|
|
|
|
|
|
if (val == &PL_sv_undef) { |
1223
|
|
|
|
|
|
|
SAVESPTR(*he); |
1224
|
|
|
|
|
|
|
*he = NULL; |
1225
|
|
|
|
|
|
|
} else { |
1226
|
|
|
|
|
|
|
if (i > AvFILLp(a2)) |
1227
|
|
|
|
|
|
|
AvFILLp(a2) = i; |
1228
|
|
|
|
|
|
|
SvTEMP_off(*he = |
1229
|
|
|
|
|
|
|
SvREFCNT_inc_simple_NN(val)); |
1230
|
|
|
|
|
|
|
} |
1231
|
|
|
|
|
|
|
} |
1232
|
|
|
|
|
|
|
LEAVE; |
1233
|
|
|
|
|
|
|
if (gimme != G_LIST || !dups) { |
1234
|
|
|
|
|
|
|
right = rlast - dups + 1; |
1235
|
|
|
|
|
|
|
break; |
1236
|
|
|
|
|
|
|
} |
1237
|
|
|
|
|
|
|
while (svp++ < rlast) { |
1238
|
|
|
|
|
|
|
if (*svp) |
1239
|
|
|
|
|
|
|
*right++ = *svp; |
1240
|
|
|
|
|
|
|
} |
1241
|
|
|
|
|
|
|
break; |
1242
|
|
|
|
|
|
|
} |
1243
|
|
|
|
|
|
|
#endif |
1244
|
|
|
|
|
|
|
default: |
1245
|
68
|
100
|
|
|
|
|
if (right > rlast) |
1246
|
14
|
|
|
|
|
|
da_alias(aTHX_ a1, a2, &PL_sv_undef); |
1247
|
54
|
100
|
|
|
|
|
else if (done) |
1248
|
4
|
|
|
|
|
|
da_alias(aTHX_ a1, a2, *right = &PL_sv_undef); |
1249
|
|
|
|
|
|
|
else |
1250
|
50
|
|
|
|
|
|
da_alias(aTHX_ a1, a2, *right); |
1251
|
68
|
|
|
|
|
|
right++; |
1252
|
68
|
|
|
|
|
|
break; |
1253
|
|
|
|
|
|
|
} |
1254
|
|
|
|
|
|
|
} |
1255
|
42
|
100
|
|
|
|
|
if (gimme == G_LIST) { |
1256
|
12
|
|
|
|
|
|
SP = right - 1; |
1257
|
12
|
50
|
|
|
|
|
EXTEND(SP, 0); |
1258
|
19
|
100
|
|
|
|
|
while (rlast < SP) |
1259
|
7
|
|
|
|
|
|
*++rlast = &PL_sv_undef; |
1260
|
12
|
|
|
|
|
|
RETURN; |
1261
|
30
|
100
|
|
|
|
|
} else if (gimme == G_SCALAR) { |
1262
|
12
|
|
|
|
|
|
dTARGET; |
1263
|
12
|
50
|
|
|
|
|
XPUSHi(rlast - SP); |
|
|
50
|
|
|
|
|
|
1264
|
|
|
|
|
|
|
} |
1265
|
30
|
|
|
|
|
|
RETURN; |
1266
|
|
|
|
|
|
|
} |
1267
|
|
|
|
|
|
|
|
1268
|
14
|
|
|
|
|
|
STATIC OP *DataAlias_pp_andassign(pTHX) { |
1269
|
14
|
|
|
|
|
|
dSP; |
1270
|
14
|
|
|
|
|
|
SV *a2 = POPs; |
1271
|
14
|
|
|
|
|
|
SV *sv = da_fetch(aTHX_ TOPs, a2); |
1272
|
14
|
50
|
|
|
|
|
if (SvTRUE(sv)) { |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1273
|
|
|
|
|
|
|
/* no PUTBACK */ |
1274
|
6
|
|
|
|
|
|
return cLOGOP->op_other; |
1275
|
|
|
|
|
|
|
} |
1276
|
8
|
|
|
|
|
|
SETs(sv); |
1277
|
8
|
|
|
|
|
|
RETURN; |
1278
|
|
|
|
|
|
|
} |
1279
|
|
|
|
|
|
|
|
1280
|
14
|
|
|
|
|
|
STATIC OP *DataAlias_pp_orassign(pTHX) { |
1281
|
14
|
|
|
|
|
|
dSP; |
1282
|
14
|
|
|
|
|
|
SV *a2 = POPs; |
1283
|
14
|
|
|
|
|
|
SV *sv = da_fetch(aTHX_ TOPs, a2); |
1284
|
14
|
50
|
|
|
|
|
if (!SvTRUE(sv)) { |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1285
|
|
|
|
|
|
|
/* no PUTBACK */ |
1286
|
8
|
|
|
|
|
|
return cLOGOP->op_other; |
1287
|
|
|
|
|
|
|
} |
1288
|
6
|
|
|
|
|
|
SETs(sv); |
1289
|
6
|
|
|
|
|
|
RETURN; |
1290
|
|
|
|
|
|
|
} |
1291
|
|
|
|
|
|
|
|
1292
|
|
|
|
|
|
|
#if DA_HAVE_OP_DORASSIGN |
1293
|
5
|
|
|
|
|
|
STATIC OP *DataAlias_pp_dorassign(pTHX) { |
1294
|
5
|
|
|
|
|
|
dSP; |
1295
|
5
|
|
|
|
|
|
SV *a2 = POPs; |
1296
|
5
|
|
|
|
|
|
SV *sv = da_fetch(aTHX_ TOPs, a2); |
1297
|
5
|
100
|
|
|
|
|
if (!SvOK(sv)) { |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
/* no PUTBACK */ |
1299
|
3
|
|
|
|
|
|
return cLOGOP->op_other; |
1300
|
|
|
|
|
|
|
} |
1301
|
2
|
|
|
|
|
|
SETs(sv); |
1302
|
2
|
|
|
|
|
|
RETURN; |
1303
|
|
|
|
|
|
|
} |
1304
|
|
|
|
|
|
|
#endif |
1305
|
|
|
|
|
|
|
|
1306
|
5
|
|
|
|
|
|
STATIC OP *DataAlias_pp_push(pTHX) { |
1307
|
5
|
|
|
|
|
|
dSP; dMARK; dORIGMARK; dTARGET; |
1308
|
5
|
|
|
|
|
|
AV *av = (AV *) *++MARK; |
1309
|
|
|
|
|
|
|
I32 i; |
1310
|
5
|
100
|
|
|
|
|
if (SvRMAGICAL(av) && da_badmagic(aTHX_ (SV *) av)) |
|
|
50
|
|
|
|
|
|
1311
|
0
|
|
|
|
|
|
DIE(aTHX_ DA_TIED_ERR, "push", "onto", "array"); |
1312
|
5
|
100
|
|
|
|
|
i = AvFILL(av); |
1313
|
5
|
|
|
|
|
|
av_extend(av, i + (SP - MARK)); |
1314
|
12
|
100
|
|
|
|
|
while (MARK < SP) |
1315
|
7
|
|
|
|
|
|
av_store(av, ++i, SvREFCNT_inc_NN(*++MARK)); |
1316
|
5
|
|
|
|
|
|
SP = ORIGMARK; |
1317
|
5
|
50
|
|
|
|
|
PUSHi(i + 1); |
1318
|
5
|
|
|
|
|
|
RETURN; |
1319
|
|
|
|
|
|
|
} |
1320
|
|
|
|
|
|
|
|
1321
|
4
|
|
|
|
|
|
STATIC OP *DataAlias_pp_unshift(pTHX) { |
1322
|
4
|
|
|
|
|
|
dSP; dMARK; dORIGMARK; dTARGET; |
1323
|
4
|
|
|
|
|
|
AV *av = (AV *) *++MARK; |
1324
|
4
|
|
|
|
|
|
I32 i = 0; |
1325
|
4
|
50
|
|
|
|
|
if (SvRMAGICAL(av) && da_badmagic(aTHX_ (SV *) av)) |
|
|
0
|
|
|
|
|
|
1326
|
0
|
|
|
|
|
|
DIE(aTHX_ DA_TIED_ERR, "unshift", "onto", "array"); |
1327
|
4
|
|
|
|
|
|
av_unshift(av, SP - MARK); |
1328
|
10
|
100
|
|
|
|
|
while (MARK < SP) |
1329
|
6
|
|
|
|
|
|
av_store(av, i++, SvREFCNT_inc_NN(*++MARK)); |
1330
|
4
|
|
|
|
|
|
SP = ORIGMARK; |
1331
|
4
|
50
|
|
|
|
|
PUSHi(AvFILL(av) + 1); |
|
|
50
|
|
|
|
|
|
1332
|
4
|
|
|
|
|
|
RETURN; |
1333
|
|
|
|
|
|
|
} |
1334
|
|
|
|
|
|
|
|
1335
|
15
|
|
|
|
|
|
STATIC OP *DataAlias_pp_splice(pTHX) { |
1336
|
15
|
|
|
|
|
|
dSP; dMARK; dORIGMARK; |
1337
|
15
|
|
|
|
|
|
I32 ins = SP - MARK - 3; |
1338
|
15
|
|
|
|
|
|
AV *av = (AV *) MARK[1]; |
1339
|
|
|
|
|
|
|
I32 off, del, count, i; |
1340
|
|
|
|
|
|
|
SV **svp, *tmp; |
1341
|
15
|
50
|
|
|
|
|
if (ins < 0) /* ?! */ |
1342
|
0
|
|
|
|
|
|
DIE(aTHX_ "Too few arguments for DataAlias_pp_splice"); |
1343
|
15
|
50
|
|
|
|
|
if (SvRMAGICAL(av) && da_badmagic(aTHX_ (SV *) av)) |
|
|
0
|
|
|
|
|
|
1344
|
0
|
|
|
|
|
|
DIE(aTHX_ DA_TIED_ERR, "splice", "onto", "array"); |
1345
|
15
|
|
|
|
|
|
count = AvFILLp(av) + 1; |
1346
|
15
|
50
|
|
|
|
|
off = SvIV(MARK[2]); |
1347
|
15
|
100
|
|
|
|
|
if (off < 0 && (off += count) < 0) |
|
|
50
|
|
|
|
|
|
1348
|
0
|
|
|
|
|
|
DIE(aTHX_ PL_no_aelem, off - count); |
1349
|
15
|
50
|
|
|
|
|
del = SvIV(ORIGMARK[3]); |
1350
|
15
|
100
|
|
|
|
|
if (del < 0 && (del += count - off) < 0) |
|
|
100
|
|
|
|
|
|
1351
|
1
|
|
|
|
|
|
del = 0; |
1352
|
15
|
100
|
|
|
|
|
if (off > count) { |
1353
|
2
|
100
|
|
|
|
|
if (ckWARN(WARN_MISC)) |
1354
|
1
|
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_MISC), |
1355
|
|
|
|
|
|
|
"splice() offset past end of array"); |
1356
|
1
|
|
|
|
|
|
off = count; |
1357
|
|
|
|
|
|
|
} |
1358
|
14
|
100
|
|
|
|
|
if ((count -= off + del) < 0) /* count of trailing elems */ |
1359
|
1
|
|
|
|
|
|
del += count, count = 0; |
1360
|
14
|
|
|
|
|
|
i = off + ins + count - 1; |
1361
|
14
|
100
|
|
|
|
|
if (i > AvMAX(av)) |
1362
|
4
|
|
|
|
|
|
av_extend(av, i); |
1363
|
14
|
50
|
|
|
|
|
if (!AvREAL(av) && AvREIFY(av)) |
|
|
0
|
|
|
|
|
|
1364
|
0
|
|
|
|
|
|
av_reify(av); |
1365
|
14
|
|
|
|
|
|
AvFILLp(av) = i; |
1366
|
14
|
|
|
|
|
|
MARK = ORIGMARK + 4; |
1367
|
14
|
|
|
|
|
|
svp = AvARRAY(av) + off; |
1368
|
35
|
100
|
|
|
|
|
for (i = 0; i < ins; i++) |
1369
|
21
|
|
|
|
|
|
SvTEMP_off(SvREFCNT_inc_NN(MARK[i])); |
1370
|
14
|
100
|
|
|
|
|
if (ins > del) { |
1371
|
7
|
50
|
|
|
|
|
Move(svp+del, svp+ins, INT2SIZE(count), SV *); |
1372
|
9
|
100
|
|
|
|
|
for (i = 0; i < del; i++) |
1373
|
2
|
|
|
|
|
|
tmp = MARK[i], MARK[i-3] = svp[i], svp[i] = tmp; |
1374
|
7
|
50
|
|
|
|
|
Copy(MARK+del, svp+del, INT2SIZE(ins-del), SV *); |
1375
|
|
|
|
|
|
|
} else { |
1376
|
16
|
100
|
|
|
|
|
for (i = 0; i < ins; i++) |
1377
|
9
|
|
|
|
|
|
tmp = MARK[i], MARK[i-3] = svp[i], svp[i] = tmp; |
1378
|
7
|
100
|
|
|
|
|
if (ins != del) |
1379
|
3
|
50
|
|
|
|
|
Copy(svp+ins, MARK-3+ins, INT2SIZE(del-ins), SV *); |
1380
|
7
|
50
|
|
|
|
|
Move(svp+del, svp+ins, INT2SIZE(count), SV *); |
1381
|
|
|
|
|
|
|
} |
1382
|
14
|
|
|
|
|
|
MARK -= 3; |
1383
|
28
|
100
|
|
|
|
|
for (i = 0; i < del; i++) |
1384
|
14
|
|
|
|
|
|
sv_2mortal(MARK[i]); |
1385
|
14
|
|
|
|
|
|
SP = MARK + del - 1; |
1386
|
14
|
|
|
|
|
|
RETURN; |
1387
|
|
|
|
|
|
|
} |
1388
|
|
|
|
|
|
|
|
1389
|
58
|
|
|
|
|
|
STATIC OP *DataAlias_pp_leave(pTHX) { |
1390
|
58
|
|
|
|
|
|
dSP; |
1391
|
|
|
|
|
|
|
SV **newsp; |
1392
|
|
|
|
|
|
|
#ifdef POPBLOCK |
1393
|
|
|
|
|
|
|
PMOP *newpm; |
1394
|
|
|
|
|
|
|
#endif |
1395
|
|
|
|
|
|
|
I32 gimme; |
1396
|
|
|
|
|
|
|
PERL_CONTEXT *cx; |
1397
|
|
|
|
|
|
|
SV *sv; |
1398
|
|
|
|
|
|
|
|
1399
|
58
|
100
|
|
|
|
|
if (PL_op->op_flags & OPf_SPECIAL) |
1400
|
2
|
|
|
|
|
|
cxstack[cxstack_ix].blk_oldpm = PL_curpm; |
1401
|
|
|
|
|
|
|
|
1402
|
|
|
|
|
|
|
#ifdef POPBLOCK |
1403
|
|
|
|
|
|
|
POPBLOCK(cx, newpm); |
1404
|
|
|
|
|
|
|
gimme = OP_GIMME(PL_op, (cxstack_ix >= 0) ? gimme : G_SCALAR); |
1405
|
|
|
|
|
|
|
#else |
1406
|
58
|
|
|
|
|
|
cx = CX_CUR(); |
1407
|
|
|
|
|
|
|
assert(CxTYPE(cx) == CXt_BLOCK); |
1408
|
58
|
|
|
|
|
|
gimme = cx->blk_gimme; |
1409
|
58
|
|
|
|
|
|
newsp = PL_stack_base + cx->blk_oldsp; |
1410
|
|
|
|
|
|
|
#endif |
1411
|
|
|
|
|
|
|
|
1412
|
58
|
100
|
|
|
|
|
if (gimme == G_SCALAR) { |
1413
|
18
|
50
|
|
|
|
|
if (newsp == SP) { |
1414
|
0
|
|
|
|
|
|
*++newsp = &PL_sv_undef; |
1415
|
|
|
|
|
|
|
} else { |
1416
|
18
|
|
|
|
|
|
sv = SvREFCNT_inc_NN(TOPs); |
1417
|
18
|
100
|
|
|
|
|
FREETMPS; |
1418
|
18
|
|
|
|
|
|
*++newsp = sv_2mortal(sv); |
1419
|
|
|
|
|
|
|
} |
1420
|
40
|
100
|
|
|
|
|
} else if (gimme == G_LIST) { |
1421
|
45
|
100
|
|
|
|
|
while (newsp < SP) |
1422
|
27
|
100
|
|
|
|
|
if (!SvTEMP(sv = *++newsp)) |
1423
|
19
|
|
|
|
|
|
sv_2mortal(SvREFCNT_inc_simple_NN(sv)); |
1424
|
|
|
|
|
|
|
} |
1425
|
58
|
|
|
|
|
|
PL_stack_sp = newsp; |
1426
|
|
|
|
|
|
|
#ifdef POPBLOCK |
1427
|
|
|
|
|
|
|
PL_curpm = newpm; |
1428
|
|
|
|
|
|
|
LEAVE; |
1429
|
|
|
|
|
|
|
#else |
1430
|
58
|
100
|
|
|
|
|
CX_LEAVE_SCOPE(cx); |
1431
|
58
|
|
|
|
|
|
cx_popblock(cx); |
1432
|
58
|
|
|
|
|
|
CX_POP(cx); |
1433
|
|
|
|
|
|
|
#endif |
1434
|
58
|
|
|
|
|
|
return NORMAL; |
1435
|
|
|
|
|
|
|
} |
1436
|
|
|
|
|
|
|
|
1437
|
37
|
|
|
|
|
|
STATIC OP *DataAlias_pp_return(pTHX) { |
1438
|
37
|
|
|
|
|
|
dSP; dMARK; |
1439
|
|
|
|
|
|
|
I32 cxix; |
1440
|
|
|
|
|
|
|
PERL_CONTEXT *cx; |
1441
|
37
|
|
|
|
|
|
bool clearerr = FALSE; |
1442
|
|
|
|
|
|
|
I32 gimme; |
1443
|
|
|
|
|
|
|
SV **newsp; |
1444
|
|
|
|
|
|
|
#ifdef POPBLOCK |
1445
|
|
|
|
|
|
|
PMOP *newpm; |
1446
|
|
|
|
|
|
|
#endif |
1447
|
37
|
|
|
|
|
|
I32 optype = 0, type = 0; |
1448
|
37
|
100
|
|
|
|
|
SV *sv = (MARK < SP) ? TOPs : &PL_sv_undef; |
1449
|
|
|
|
|
|
|
OP *retop; |
1450
|
|
|
|
|
|
|
|
1451
|
37
|
|
|
|
|
|
cxix = cxstack_ix; |
1452
|
38
|
50
|
|
|
|
|
while (cxix >= 0) { |
1453
|
38
|
|
|
|
|
|
cx = &cxstack[cxix]; |
1454
|
38
|
|
|
|
|
|
type = CxTYPE(cx); |
1455
|
38
|
100
|
|
|
|
|
if (type == CXt_EVAL || type == CXt_SUB || type == CXt_FORMAT) |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1456
|
|
|
|
|
|
|
break; |
1457
|
1
|
|
|
|
|
|
cxix--; |
1458
|
|
|
|
|
|
|
} |
1459
|
|
|
|
|
|
|
|
1460
|
|
|
|
|
|
|
#if DA_FEATURE_MULTICALL |
1461
|
37
|
50
|
|
|
|
|
if (cxix < 0) { |
1462
|
0
|
0
|
|
|
|
|
if (CxMULTICALL(cxstack)) { /* sort block */ |
1463
|
0
|
|
|
|
|
|
dounwind(0); |
1464
|
0
|
|
|
|
|
|
*(PL_stack_sp = PL_stack_base + 1) = sv; |
1465
|
0
|
|
|
|
|
|
return 0; |
1466
|
|
|
|
|
|
|
} |
1467
|
0
|
|
|
|
|
|
DIE(aTHX_ "Can't return outside a subroutine"); |
1468
|
|
|
|
|
|
|
} |
1469
|
|
|
|
|
|
|
#else |
1470
|
|
|
|
|
|
|
if (PL_curstackinfo->si_type == PERLSI_SORT && cxix <= PL_sortcxix) { |
1471
|
|
|
|
|
|
|
if (cxstack_ix > PL_sortcxix) |
1472
|
|
|
|
|
|
|
dounwind(PL_sortcxix); |
1473
|
|
|
|
|
|
|
*(PL_stack_sp = PL_stack_base + 1) = sv; |
1474
|
|
|
|
|
|
|
return 0; |
1475
|
|
|
|
|
|
|
} |
1476
|
|
|
|
|
|
|
if (cxix < 0) |
1477
|
|
|
|
|
|
|
DIE(aTHX_ "Can't return outside a subroutine"); |
1478
|
|
|
|
|
|
|
#endif |
1479
|
|
|
|
|
|
|
|
1480
|
|
|
|
|
|
|
|
1481
|
37
|
100
|
|
|
|
|
if (cxix < cxstack_ix) |
1482
|
1
|
|
|
|
|
|
dounwind(cxix); |
1483
|
|
|
|
|
|
|
|
1484
|
|
|
|
|
|
|
#if DA_FEATURE_MULTICALL |
1485
|
37
|
50
|
|
|
|
|
if (CxMULTICALL(&cxstack[cxix])) { |
1486
|
0
|
|
|
|
|
|
gimme = cxstack[cxix].blk_gimme; |
1487
|
0
|
0
|
|
|
|
|
if (gimme == G_VOID) |
1488
|
0
|
|
|
|
|
|
PL_stack_sp = PL_stack_base; |
1489
|
0
|
0
|
|
|
|
|
else if (gimme == G_SCALAR) |
1490
|
0
|
|
|
|
|
|
*(PL_stack_sp = PL_stack_base + 1) = sv; |
1491
|
0
|
|
|
|
|
|
return 0; |
1492
|
|
|
|
|
|
|
} |
1493
|
|
|
|
|
|
|
#endif |
1494
|
|
|
|
|
|
|
|
1495
|
|
|
|
|
|
|
#ifdef POPBLOCK |
1496
|
|
|
|
|
|
|
POPBLOCK(cx, newpm); |
1497
|
|
|
|
|
|
|
#else |
1498
|
37
|
|
|
|
|
|
cx = CX_CUR(); |
1499
|
37
|
|
|
|
|
|
gimme = cx->blk_gimme; |
1500
|
37
|
|
|
|
|
|
newsp = PL_stack_base + cx->blk_oldsp; |
1501
|
|
|
|
|
|
|
#endif |
1502
|
37
|
|
|
|
|
|
switch (type) { |
1503
|
|
|
|
|
|
|
case CXt_SUB: |
1504
|
|
|
|
|
|
|
#if DA_FEATURE_RETOP |
1505
|
25
|
|
|
|
|
|
retop = cx->blk_sub.retop; |
1506
|
|
|
|
|
|
|
#endif |
1507
|
|
|
|
|
|
|
#ifdef POPBLOCK |
1508
|
|
|
|
|
|
|
cxstack_ix++; /* temporarily protect top context */ |
1509
|
|
|
|
|
|
|
#endif |
1510
|
25
|
|
|
|
|
|
break; |
1511
|
|
|
|
|
|
|
case CXt_EVAL: |
1512
|
12
|
|
|
|
|
|
clearerr = !(PL_in_eval & EVAL_KEEPERR); |
1513
|
|
|
|
|
|
|
#ifdef POPBLOCK |
1514
|
|
|
|
|
|
|
POPEVAL(cx); |
1515
|
|
|
|
|
|
|
#else |
1516
|
12
|
|
|
|
|
|
cx_popeval(cx); |
1517
|
|
|
|
|
|
|
#endif |
1518
|
|
|
|
|
|
|
#if DA_FEATURE_RETOP |
1519
|
12
|
|
|
|
|
|
retop = cx->blk_eval.retop; |
1520
|
|
|
|
|
|
|
#endif |
1521
|
12
|
100
|
|
|
|
|
if (CxTRYBLOCK(cx)) |
1522
|
5
|
|
|
|
|
|
break; |
1523
|
|
|
|
|
|
|
lex_end(); |
1524
|
7
|
50
|
|
|
|
|
if (optype == OP_REQUIRE && !SvTRUE(sv) |
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1525
|
0
|
0
|
|
|
|
|
&& (gimme == G_SCALAR || MARK == SP)) { |
|
|
0
|
|
|
|
|
|
1526
|
0
|
|
|
|
|
|
sv = cx->blk_eval.old_namesv; |
1527
|
0
|
0
|
|
|
|
|
(void) hv_delete(GvHVn(PL_incgv), SvPVX_const(sv), |
1528
|
|
|
|
|
|
|
SvCUR(sv), G_DISCARD); |
1529
|
0
|
|
|
|
|
|
DIE(aTHX_ "%"SVf" did not return a true value", sv); |
1530
|
|
|
|
|
|
|
} |
1531
|
7
|
|
|
|
|
|
break; |
1532
|
|
|
|
|
|
|
case CXt_FORMAT: |
1533
|
|
|
|
|
|
|
#ifdef POPBLOCK |
1534
|
|
|
|
|
|
|
POPFORMAT(cx); |
1535
|
|
|
|
|
|
|
#else |
1536
|
0
|
|
|
|
|
|
cx_popformat(cx); |
1537
|
|
|
|
|
|
|
#endif |
1538
|
|
|
|
|
|
|
#if DA_FEATURE_RETOP |
1539
|
0
|
|
|
|
|
|
retop = cx->blk_sub.retop; |
1540
|
|
|
|
|
|
|
#endif |
1541
|
0
|
|
|
|
|
|
break; |
1542
|
|
|
|
|
|
|
default: |
1543
|
0
|
|
|
|
|
|
DIE(aTHX_ "panic: return"); |
1544
|
|
|
|
|
|
|
retop = NULL; /* suppress "uninitialized" warning */ |
1545
|
|
|
|
|
|
|
} |
1546
|
|
|
|
|
|
|
|
1547
|
37
|
|
|
|
|
|
TAINT_NOT; |
1548
|
37
|
100
|
|
|
|
|
if (gimme == G_SCALAR) { |
1549
|
3
|
50
|
|
|
|
|
if (MARK == SP) { |
1550
|
0
|
|
|
|
|
|
*++newsp = &PL_sv_undef; |
1551
|
|
|
|
|
|
|
} else { |
1552
|
3
|
|
|
|
|
|
sv = SvREFCNT_inc_NN(TOPs); |
1553
|
3
|
50
|
|
|
|
|
FREETMPS; |
1554
|
3
|
|
|
|
|
|
*++newsp = sv_2mortal(sv); |
1555
|
|
|
|
|
|
|
} |
1556
|
34
|
100
|
|
|
|
|
} else if (gimme == G_LIST) { |
1557
|
67
|
100
|
|
|
|
|
while (MARK < SP) { |
1558
|
43
|
|
|
|
|
|
*++newsp = sv = *++MARK; |
1559
|
43
|
100
|
|
|
|
|
if (!SvTEMP(sv) && !(SvREADONLY(sv) && SvIMMORTAL(sv))) |
|
|
50
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
1560
|
39
|
|
|
|
|
|
sv_2mortal(SvREFCNT_inc_simple_NN(sv)); |
1561
|
43
|
|
|
|
|
|
TAINT_NOT; |
1562
|
|
|
|
|
|
|
} |
1563
|
|
|
|
|
|
|
} |
1564
|
37
|
|
|
|
|
|
PL_stack_sp = newsp; |
1565
|
|
|
|
|
|
|
#ifdef POPBLOCK |
1566
|
|
|
|
|
|
|
LEAVE; |
1567
|
|
|
|
|
|
|
if (type == CXt_SUB) { |
1568
|
|
|
|
|
|
|
cxstack_ix--; |
1569
|
|
|
|
|
|
|
POPSUB(cx, sv); |
1570
|
|
|
|
|
|
|
LEAVESUB(sv); |
1571
|
|
|
|
|
|
|
} |
1572
|
|
|
|
|
|
|
PL_curpm = newpm; |
1573
|
|
|
|
|
|
|
#else |
1574
|
37
|
100
|
|
|
|
|
if (type == CXt_SUB) { |
1575
|
25
|
|
|
|
|
|
cx_popsub(cx); |
1576
|
|
|
|
|
|
|
} |
1577
|
37
|
100
|
|
|
|
|
CX_LEAVE_SCOPE(cx); |
1578
|
37
|
|
|
|
|
|
cx_popblock(cx); |
1579
|
37
|
|
|
|
|
|
CX_POP(cx); |
1580
|
|
|
|
|
|
|
#endif |
1581
|
37
|
100
|
|
|
|
|
if (clearerr) |
1582
|
12
|
50
|
|
|
|
|
sv_setpvn(ERRSV, "", 0); |
1583
|
|
|
|
|
|
|
#if (!DA_FEATURE_RETOP) |
1584
|
|
|
|
|
|
|
retop = pop_return(); |
1585
|
|
|
|
|
|
|
#endif |
1586
|
37
|
|
|
|
|
|
return retop; |
1587
|
|
|
|
|
|
|
} |
1588
|
|
|
|
|
|
|
|
1589
|
28
|
|
|
|
|
|
STATIC OP *DataAlias_pp_leavesub(pTHX) { |
1590
|
28
|
50
|
|
|
|
|
if (++PL_markstack_ptr == PL_markstack_max) |
1591
|
0
|
|
|
|
|
|
markstack_grow(); |
1592
|
28
|
|
|
|
|
|
*PL_markstack_ptr = cxstack[cxstack_ix].blk_oldsp; |
1593
|
28
|
|
|
|
|
|
return DataAlias_pp_return(aTHX); |
1594
|
|
|
|
|
|
|
} |
1595
|
|
|
|
|
|
|
|
1596
|
5
|
|
|
|
|
|
STATIC OP *DataAlias_pp_entereval(pTHX) { |
1597
|
|
|
|
|
|
|
dDAforce; |
1598
|
5
|
|
|
|
|
|
PERL_CONTEXT *iscope = da_iscope; |
1599
|
5
|
|
|
|
|
|
I32 inside = da_inside; |
1600
|
5
|
50
|
|
|
|
|
I32 cxi = (cxstack_ix < cxstack_max) ? cxstack_ix + 1 : cxinc(); |
1601
|
|
|
|
|
|
|
OP *ret; |
1602
|
5
|
|
|
|
|
|
da_iscope = &cxstack[cxi]; |
1603
|
5
|
|
|
|
|
|
da_inside = 1; |
1604
|
5
|
|
|
|
|
|
ret = PL_ppaddr[OP_ENTEREVAL](aTHX); |
1605
|
5
|
|
|
|
|
|
da_iscope = iscope; |
1606
|
5
|
|
|
|
|
|
da_inside = inside; |
1607
|
5
|
|
|
|
|
|
return ret; |
1608
|
|
|
|
|
|
|
} |
1609
|
|
|
|
|
|
|
|
1610
|
15
|
|
|
|
|
|
STATIC OP *DataAlias_pp_copy(pTHX) { |
1611
|
15
|
|
|
|
|
|
dSP; dMARK; |
1612
|
|
|
|
|
|
|
SV *sv; |
1613
|
15
|
50
|
|
|
|
|
switch (GIMME_V) { |
1614
|
|
|
|
|
|
|
case G_VOID: |
1615
|
2
|
|
|
|
|
|
SP = MARK; |
1616
|
2
|
|
|
|
|
|
break; |
1617
|
|
|
|
|
|
|
case G_SCALAR: |
1618
|
7
|
100
|
|
|
|
|
if (MARK == SP) { |
1619
|
1
|
|
|
|
|
|
sv = sv_newmortal(); |
1620
|
1
|
50
|
|
|
|
|
EXTEND(SP, 1); |
1621
|
|
|
|
|
|
|
} else { |
1622
|
6
|
|
|
|
|
|
sv = TOPs; |
1623
|
6
|
100
|
|
|
|
|
if (!SvTEMP(sv) || SvREFCNT(sv) != 1) |
|
|
50
|
|
|
|
|
|
1624
|
5
|
|
|
|
|
|
sv = sv_mortalcopy(sv); |
1625
|
|
|
|
|
|
|
} |
1626
|
7
|
|
|
|
|
|
*(SP = MARK + 1) = sv; |
1627
|
7
|
|
|
|
|
|
break; |
1628
|
|
|
|
|
|
|
default: |
1629
|
16
|
100
|
|
|
|
|
while (MARK < SP) { |
1630
|
10
|
100
|
|
|
|
|
if (!SvTEMP(sv = *++MARK) || SvREFCNT(sv) != 1) |
|
|
50
|
|
|
|
|
|
1631
|
8
|
|
|
|
|
|
*MARK = sv_mortalcopy(sv); |
1632
|
|
|
|
|
|
|
} |
1633
|
|
|
|
|
|
|
} |
1634
|
15
|
|
|
|
|
|
RETURN; |
1635
|
|
|
|
|
|
|
} |
1636
|
|
|
|
|
|
|
|
1637
|
551
|
|
|
|
|
|
STATIC void da_lvalue(pTHX_ OP *op, int list) { |
1638
|
551
|
|
|
|
|
|
switch (op->op_type) { |
1639
|
25
|
|
|
|
|
|
case OP_PADSV: op->op_ppaddr = DataAlias_pp_padsv; |
1640
|
25
|
100
|
|
|
|
|
if (PadnameOUTER( |
1641
|
|
|
|
|
|
|
PadnamelistARRAY(PL_comppad_name)[op->op_targ]) |
1642
|
2
|
100
|
|
|
|
|
&& ckWARN(WARN_CLOSURE)) |
1643
|
1
|
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_CLOSURE), |
1644
|
|
|
|
|
|
|
DA_OUTER_ERR); |
1645
|
24
|
|
|
|
|
|
break; |
1646
|
|
|
|
|
|
|
#if DA_HAVE_OP_PADRANGE |
1647
|
|
|
|
|
|
|
case OP_PADRANGE: { |
1648
|
8
|
|
|
|
|
|
int start = op->op_targ; |
1649
|
8
|
|
|
|
|
|
int count = op->op_private & OPpPADRANGE_COUNTMASK; |
1650
|
|
|
|
|
|
|
int i; |
1651
|
8
|
50
|
|
|
|
|
if (!list) goto bad; |
1652
|
19
|
100
|
|
|
|
|
for(i = start; i != start+count; i++) { |
1653
|
11
|
50
|
|
|
|
|
if (PadnameOUTER( |
1654
|
|
|
|
|
|
|
PadnamelistARRAY(PL_comppad_name)[i]) |
1655
|
0
|
0
|
|
|
|
|
&& ckWARN(WARN_CLOSURE)) |
1656
|
0
|
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_CLOSURE), |
1657
|
|
|
|
|
|
|
DA_OUTER_ERR); |
1658
|
|
|
|
|
|
|
} |
1659
|
8
|
100
|
|
|
|
|
if (op->op_ppaddr != DataAlias_pp_padrange_single) |
1660
|
7
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_padrange_list; |
1661
|
8
|
|
|
|
|
|
} break; |
1662
|
|
|
|
|
|
|
#endif |
1663
|
3
|
|
|
|
|
|
case OP_AELEM: op->op_ppaddr = DataAlias_pp_aelem; break; |
1664
|
|
|
|
|
|
|
#if DA_HAVE_OP_AELEMFAST_LEX |
1665
|
|
|
|
|
|
|
case OP_AELEMFAST_LEX: |
1666
|
|
|
|
|
|
|
#endif |
1667
|
17
|
|
|
|
|
|
case OP_AELEMFAST: op->op_ppaddr = DataAlias_pp_aelemfast; break; |
1668
|
21
|
|
|
|
|
|
case OP_HELEM: op->op_ppaddr = DataAlias_pp_helem; break; |
1669
|
3
|
|
|
|
|
|
case OP_ASLICE: op->op_ppaddr = DataAlias_pp_aslice; break; |
1670
|
6
|
|
|
|
|
|
case OP_HSLICE: op->op_ppaddr = DataAlias_pp_hslice; break; |
1671
|
88
|
|
|
|
|
|
case OP_GVSV: op->op_ppaddr = DataAlias_pp_gvsv; break; |
1672
|
15
|
|
|
|
|
|
case OP_RV2SV: op->op_ppaddr = DataAlias_pp_rv2sv; break; |
1673
|
15
|
|
|
|
|
|
case OP_RV2GV: op->op_ppaddr = DataAlias_pp_rv2gv; break; |
1674
|
|
|
|
|
|
|
case OP_LIST: |
1675
|
0
|
0
|
|
|
|
|
if (!list) |
1676
|
0
|
|
|
|
|
|
goto bad; |
1677
|
|
|
|
|
|
|
case OP_NULL: |
1678
|
215
|
100
|
|
|
|
|
op = (op->op_flags & OPf_KIDS) ? cUNOPx(op)->op_first : NULL; |
1679
|
571
|
100
|
|
|
|
|
while (op) { |
1680
|
356
|
|
|
|
|
|
da_lvalue(aTHX_ op, list); |
1681
|
356
|
100
|
|
|
|
|
op = OpSIBLING(op); |
1682
|
|
|
|
|
|
|
} |
1683
|
215
|
|
|
|
|
|
break; |
1684
|
|
|
|
|
|
|
case OP_COND_EXPR: |
1685
|
1
|
|
|
|
|
|
op = cUNOPx(op)->op_first; |
1686
|
3
|
100
|
|
|
|
|
while ((op = OpSIBLING(op))) |
|
|
100
|
|
|
|
|
|
1687
|
2
|
|
|
|
|
|
da_lvalue(aTHX_ op, list); |
1688
|
1
|
|
|
|
|
|
break; |
1689
|
|
|
|
|
|
|
case OP_SCOPE: |
1690
|
|
|
|
|
|
|
case OP_LEAVE: |
1691
|
|
|
|
|
|
|
case OP_LINESEQ: |
1692
|
0
|
0
|
|
|
|
|
op = (op->op_flags & OPf_KIDS) ? cUNOPx(op)->op_first : NULL; |
1693
|
0
|
0
|
|
|
|
|
while (OpHAS_SIBLING(op)) |
1694
|
0
|
0
|
|
|
|
|
op = OpSIBLING(op); |
1695
|
0
|
|
|
|
|
|
da_lvalue(aTHX_ op, list); |
1696
|
0
|
|
|
|
|
|
break; |
1697
|
|
|
|
|
|
|
case OP_PUSHMARK: |
1698
|
81
|
50
|
|
|
|
|
if (!list) goto bad; |
1699
|
81
|
|
|
|
|
|
break; |
1700
|
|
|
|
|
|
|
case OP_PADAV: |
1701
|
2
|
50
|
|
|
|
|
if (!list) goto bad; |
1702
|
2
|
50
|
|
|
|
|
if (op->op_ppaddr != DataAlias_pp_padsv) |
1703
|
2
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_padav; |
1704
|
2
|
|
|
|
|
|
break; |
1705
|
|
|
|
|
|
|
case OP_PADHV: |
1706
|
0
|
0
|
|
|
|
|
if (!list) goto bad; |
1707
|
0
|
0
|
|
|
|
|
if (op->op_ppaddr != DataAlias_pp_padsv) |
1708
|
0
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_padhv; |
1709
|
0
|
|
|
|
|
|
break; |
1710
|
|
|
|
|
|
|
case OP_RV2AV: |
1711
|
16
|
50
|
|
|
|
|
if (!list) goto bad; |
1712
|
16
|
100
|
|
|
|
|
if (op->op_ppaddr != DataAlias_pp_rv2sv) |
1713
|
5
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_rv2av; |
1714
|
16
|
|
|
|
|
|
break; |
1715
|
|
|
|
|
|
|
case OP_RV2HV: |
1716
|
31
|
50
|
|
|
|
|
if (!list) goto bad; |
1717
|
31
|
100
|
|
|
|
|
if (op->op_ppaddr != DataAlias_pp_rv2sv) |
1718
|
20
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_rv2hv; |
1719
|
31
|
|
|
|
|
|
break; |
1720
|
|
|
|
|
|
|
case OP_UNDEF: |
1721
|
3
|
50
|
|
|
|
|
if (!list || (op->op_flags & OPf_KIDS)) |
|
|
50
|
|
|
|
|
|
1722
|
|
|
|
|
|
|
goto bad; |
1723
|
3
|
|
|
|
|
|
break; |
1724
|
|
|
|
|
|
|
default: |
1725
|
1
|
50
|
|
|
|
|
bad: qerror(Perl_mess(aTHX_ DA_TARGET_ERR_AT, OutCopFILE(PL_curcop), |
1726
|
|
|
|
|
|
|
(UV) CopLINE(PL_curcop))); |
1727
|
|
|
|
|
|
|
} |
1728
|
550
|
|
|
|
|
|
} |
1729
|
|
|
|
|
|
|
|
1730
|
89
|
|
|
|
|
|
STATIC void da_aassign(OP *op, OP *right) { |
1731
|
|
|
|
|
|
|
OP *left, *la, *ra; |
1732
|
89
|
|
|
|
|
|
int hash = FALSE, pad; |
1733
|
|
|
|
|
|
|
|
1734
|
|
|
|
|
|
|
/* make sure it fits the model exactly */ |
1735
|
89
|
50
|
|
|
|
|
if (!right || !(left = OpSIBLING(right)) || OpHAS_SIBLING(left)) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1736
|
0
|
|
|
|
|
|
return; |
1737
|
89
|
50
|
|
|
|
|
if (left->op_type || !(left->op_flags & OPf_KIDS)) |
|
|
50
|
|
|
|
|
|
1738
|
0
|
|
|
|
|
|
return; |
1739
|
89
|
50
|
|
|
|
|
if (!(left = cUNOPx(left)->op_first) || !IS_PUSHMARK_OR_PADRANGE(left)) |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
1740
|
0
|
|
|
|
|
|
return; |
1741
|
89
|
50
|
|
|
|
|
if (!(la = OpSIBLING(left)) || OpHAS_SIBLING(la)) |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1742
|
33
|
|
|
|
|
|
return; |
1743
|
56
|
100
|
|
|
|
|
if (la->op_flags & OPf_PARENS) |
1744
|
19
|
|
|
|
|
|
return; |
1745
|
37
|
|
|
|
|
|
switch (la->op_type) { |
1746
|
9
|
|
|
|
|
|
case OP_PADHV: hash = TRUE; case OP_PADAV: pad = TRUE; break; |
1747
|
22
|
|
|
|
|
|
case OP_RV2HV: hash = TRUE; case OP_RV2AV: pad = FALSE; break; |
1748
|
6
|
|
|
|
|
|
default: return; |
1749
|
|
|
|
|
|
|
} |
1750
|
31
|
50
|
|
|
|
|
if (right->op_type || !(right->op_flags & OPf_KIDS)) |
|
|
50
|
|
|
|
|
|
1751
|
0
|
|
|
|
|
|
return; |
1752
|
31
|
50
|
|
|
|
|
if (!(right = cUNOPx(right)->op_first) || |
|
|
100
|
|
|
|
|
|
1753
|
1
|
50
|
|
|
|
|
!IS_PUSHMARK_OR_PADRANGE(right)) |
1754
|
0
|
|
|
|
|
|
return; |
1755
|
31
|
100
|
|
|
|
|
op->op_private = hash ? OPpALIASHV : OPpALIASAV; |
1756
|
31
|
100
|
|
|
|
|
la->op_ppaddr = pad ? DataAlias_pp_padsv : DataAlias_pp_rv2sv; |
1757
|
31
|
100
|
|
|
|
|
if (pad) { |
1758
|
9
|
|
|
|
|
|
la->op_type = OP_PADSV; |
1759
|
|
|
|
|
|
|
#if DA_HAVE_OP_PADRANGE |
1760
|
9
|
50
|
|
|
|
|
if (left->op_type == OP_PADRANGE) |
1761
|
0
|
|
|
|
|
|
left->op_ppaddr = DataAlias_pp_padrange_single; |
1762
|
9
|
100
|
|
|
|
|
else if (right->op_type == OP_PADRANGE && |
|
|
50
|
|
|
|
|
|
1763
|
1
|
|
|
|
|
|
(right->op_flags & OPf_SPECIAL)) |
1764
|
1
|
|
|
|
|
|
right->op_ppaddr = DataAlias_pp_padrange_single; |
1765
|
|
|
|
|
|
|
#endif |
1766
|
|
|
|
|
|
|
} |
1767
|
31
|
50
|
|
|
|
|
if (!(ra = OpSIBLING(right)) || OpHAS_SIBLING(ra)) |
|
|
50
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
1768
|
1
|
|
|
|
|
|
return; |
1769
|
30
|
100
|
|
|
|
|
if (ra->op_flags & OPf_PARENS) |
1770
|
6
|
|
|
|
|
|
return; |
1771
|
24
|
100
|
|
|
|
|
if (hash) { |
1772
|
11
|
100
|
|
|
|
|
if (ra->op_type != OP_PADHV && ra->op_type != OP_RV2HV) |
|
|
50
|
|
|
|
|
|
1773
|
0
|
|
|
|
|
|
return; |
1774
|
|
|
|
|
|
|
} else { |
1775
|
13
|
100
|
|
|
|
|
if (ra->op_type != OP_PADAV && ra->op_type != OP_RV2AV) |
|
|
100
|
|
|
|
|
|
1776
|
1
|
|
|
|
|
|
return; |
1777
|
|
|
|
|
|
|
} |
1778
|
23
|
|
|
|
|
|
ra->op_flags &= -2; |
1779
|
23
|
|
|
|
|
|
ra->op_flags |= OPf_REF; |
1780
|
|
|
|
|
|
|
} |
1781
|
|
|
|
|
|
|
|
1782
|
989
|
|
|
|
|
|
STATIC int da_transform(pTHX_ OP *op, int sib) { |
1783
|
989
|
|
|
|
|
|
int hits = 0; |
1784
|
|
|
|
|
|
|
|
1785
|
4676
|
100
|
|
|
|
|
while (op) { |
1786
|
3693
|
|
|
|
|
|
OP *kid = Nullop, *tmp; |
1787
|
3693
|
|
|
|
|
|
int ksib = TRUE; |
1788
|
|
|
|
|
|
|
OPCODE optype; |
1789
|
|
|
|
|
|
|
|
1790
|
3693
|
100
|
|
|
|
|
if (op->op_flags & OPf_KIDS) |
1791
|
1840
|
|
|
|
|
|
kid = cUNOPx(op)->op_first; |
1792
|
|
|
|
|
|
|
|
1793
|
3693
|
|
|
|
|
|
++hits; |
1794
|
3693
|
|
|
|
|
|
switch ((optype = op->op_type)) { |
1795
|
|
|
|
|
|
|
case OP_NULL: |
1796
|
775
|
|
|
|
|
|
optype = (OPCODE) op->op_targ; |
1797
|
|
|
|
|
|
|
default: |
1798
|
2616
|
|
|
|
|
|
--hits; |
1799
|
2616
|
|
|
|
|
|
switch (optype) { |
1800
|
|
|
|
|
|
|
case_OP_SETSTATE_ |
1801
|
|
|
|
|
|
|
case OP_NEXTSTATE: |
1802
|
|
|
|
|
|
|
case OP_DBSTATE: |
1803
|
133
|
|
|
|
|
|
PL_curcop = (COP *) op; |
1804
|
133
|
|
|
|
|
|
break; |
1805
|
|
|
|
|
|
|
case OP_LIST: |
1806
|
256
|
100
|
|
|
|
|
if (op->op_ppaddr == da_tag_list) { |
1807
|
5
|
|
|
|
|
|
da_peep2(aTHX_ op); |
1808
|
5
|
|
|
|
|
|
return hits; |
1809
|
|
|
|
|
|
|
} |
1810
|
251
|
|
|
|
|
|
break; |
1811
|
|
|
|
|
|
|
} |
1812
|
2611
|
|
|
|
|
|
break; |
1813
|
|
|
|
|
|
|
case OP_LEAVE: |
1814
|
65
|
100
|
|
|
|
|
if (op->op_ppaddr != da_tag_entersub) |
1815
|
62
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_leave; |
1816
|
|
|
|
|
|
|
else |
1817
|
3
|
|
|
|
|
|
hits--; |
1818
|
65
|
|
|
|
|
|
break; |
1819
|
|
|
|
|
|
|
case OP_LEAVESUB: |
1820
|
|
|
|
|
|
|
case OP_LEAVESUBLV: |
1821
|
|
|
|
|
|
|
case OP_LEAVEEVAL: |
1822
|
|
|
|
|
|
|
case OP_LEAVETRY: |
1823
|
29
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_leavesub; |
1824
|
29
|
|
|
|
|
|
break; |
1825
|
|
|
|
|
|
|
case OP_RETURN: |
1826
|
9
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_return; |
1827
|
9
|
|
|
|
|
|
break; |
1828
|
|
|
|
|
|
|
case OP_ENTEREVAL: |
1829
|
5
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_entereval; |
1830
|
5
|
|
|
|
|
|
break; |
1831
|
|
|
|
|
|
|
case OP_CONST: |
1832
|
154
|
|
|
|
|
|
--hits; |
1833
|
|
|
|
|
|
|
{ |
1834
|
154
|
|
|
|
|
|
SV *sv = cSVOPx_sv(op); |
1835
|
154
|
|
|
|
|
|
SvPADTMP_off(sv); |
1836
|
154
|
|
|
|
|
|
SvREADONLY_on(sv); |
1837
|
|
|
|
|
|
|
} |
1838
|
154
|
|
|
|
|
|
break; |
1839
|
|
|
|
|
|
|
case OP_GVSV: |
1840
|
307
|
100
|
|
|
|
|
if (op->op_private & OPpLVAL_INTRO) |
1841
|
1
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_gvsv_r; |
1842
|
|
|
|
|
|
|
else |
1843
|
306
|
|
|
|
|
|
hits--; |
1844
|
307
|
|
|
|
|
|
break; |
1845
|
|
|
|
|
|
|
case OP_RV2SV: |
1846
|
|
|
|
|
|
|
case OP_RV2AV: |
1847
|
|
|
|
|
|
|
case OP_RV2HV: |
1848
|
137
|
100
|
|
|
|
|
if (op->op_private & OPpLVAL_INTRO) |
1849
|
2
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_rv2sv_r; |
1850
|
|
|
|
|
|
|
else |
1851
|
135
|
|
|
|
|
|
hits--; |
1852
|
137
|
|
|
|
|
|
break; |
1853
|
|
|
|
|
|
|
case OP_SREFGEN: |
1854
|
77
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_srefgen; |
1855
|
77
|
|
|
|
|
|
break; |
1856
|
|
|
|
|
|
|
case OP_REFGEN: |
1857
|
4
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_refgen; |
1858
|
4
|
|
|
|
|
|
break; |
1859
|
|
|
|
|
|
|
#if DA_HAVE_OP_PADSV_STORE |
1860
|
|
|
|
|
|
|
case OP_PADSV_STORE: |
1861
|
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_padsv_store; |
1862
|
|
|
|
|
|
|
MOD(kid); |
1863
|
|
|
|
|
|
|
ksib = FALSE; |
1864
|
|
|
|
|
|
|
if (PadnameOUTER(PadnamelistARRAY(PL_comppad_name)[op->op_targ]) |
1865
|
|
|
|
|
|
|
&& ckWARN(WARN_CLOSURE)) |
1866
|
|
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_CLOSURE), DA_OUTER_ERR); |
1867
|
|
|
|
|
|
|
break; |
1868
|
|
|
|
|
|
|
#endif |
1869
|
|
|
|
|
|
|
#if DA_HAVE_OP_AELEMFASTLEX_STORE |
1870
|
|
|
|
|
|
|
case OP_AELEMFASTLEX_STORE: |
1871
|
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_aelemfastlex_store; |
1872
|
|
|
|
|
|
|
MOD(kid); |
1873
|
|
|
|
|
|
|
ksib = FALSE; |
1874
|
|
|
|
|
|
|
break; |
1875
|
|
|
|
|
|
|
#endif |
1876
|
|
|
|
|
|
|
case OP_AASSIGN: |
1877
|
89
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_aassign; |
1878
|
89
|
|
|
|
|
|
op->op_private = 0; |
1879
|
89
|
|
|
|
|
|
da_aassign(op, kid); |
1880
|
89
|
|
|
|
|
|
MOD(kid); |
1881
|
89
|
|
|
|
|
|
ksib = FALSE; |
1882
|
|
|
|
|
|
|
#if DA_HAVE_OP_PADRANGE |
1883
|
178
|
100
|
|
|
|
|
for (tmp = kid; tmp->op_type == OP_NULL && |
|
|
50
|
|
|
|
|
|
1884
|
89
|
|
|
|
|
|
(tmp->op_flags & OPf_KIDS); ) |
1885
|
89
|
|
|
|
|
|
tmp = cUNOPx(tmp)->op_first; |
1886
|
89
|
100
|
|
|
|
|
if (tmp->op_type == OP_PADRANGE && |
|
|
100
|
|
|
|
|
|
1887
|
7
|
|
|
|
|
|
(tmp->op_flags & OPf_SPECIAL)) |
1888
|
6
|
|
|
|
|
|
da_lvalue(aTHX_ tmp, TRUE); |
1889
|
|
|
|
|
|
|
else |
1890
|
|
|
|
|
|
|
#endif |
1891
|
83
|
50
|
|
|
|
|
da_lvalue(aTHX_ OpSIBLING(kid), TRUE); |
1892
|
89
|
|
|
|
|
|
break; |
1893
|
|
|
|
|
|
|
case OP_SASSIGN: |
1894
|
|
|
|
|
|
|
|
1895
|
104
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_sassign; |
1896
|
104
|
|
|
|
|
|
MOD(kid); |
1897
|
104
|
|
|
|
|
|
ksib = FALSE; |
1898
|
104
|
100
|
|
|
|
|
if (!(op->op_private & OPpASSIGN_BACKWARDS)) |
1899
|
69
|
50
|
|
|
|
|
da_lvalue(aTHX_ OpSIBLING(kid), FALSE); |
1900
|
103
|
|
|
|
|
|
break; |
1901
|
|
|
|
|
|
|
case OP_ANDASSIGN: |
1902
|
15
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_andassign; |
1903
|
|
|
|
|
|
|
if (0) |
1904
|
|
|
|
|
|
|
case OP_ORASSIGN: |
1905
|
30
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_orassign; |
1906
|
|
|
|
|
|
|
#if DA_HAVE_OP_DORASSIGN |
1907
|
|
|
|
|
|
|
if (0) |
1908
|
|
|
|
|
|
|
case OP_DORASSIGN: |
1909
|
5
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_dorassign; |
1910
|
|
|
|
|
|
|
#endif |
1911
|
35
|
|
|
|
|
|
da_lvalue(aTHX_ kid, FALSE); |
1912
|
35
|
50
|
|
|
|
|
kid = OpSIBLING(kid); |
1913
|
35
|
|
|
|
|
|
break; |
1914
|
|
|
|
|
|
|
case OP_UNSHIFT: |
1915
|
6
|
50
|
|
|
|
|
if (!(tmp = OpSIBLING(kid))) break; /* array */ |
|
|
50
|
|
|
|
|
|
1916
|
6
|
100
|
|
|
|
|
if (!(tmp = OpSIBLING(tmp))) break; /* first elem */ |
|
|
100
|
|
|
|
|
|
1917
|
4
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_unshift; |
1918
|
4
|
|
|
|
|
|
goto mod; |
1919
|
|
|
|
|
|
|
case OP_PUSH: |
1920
|
7
|
50
|
|
|
|
|
if (!(tmp = OpSIBLING(kid))) break; /* array */ |
|
|
50
|
|
|
|
|
|
1921
|
7
|
100
|
|
|
|
|
if (!(tmp = OpSIBLING(tmp))) break; /* first elem */ |
|
|
100
|
|
|
|
|
|
1922
|
5
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_push; |
1923
|
5
|
|
|
|
|
|
goto mod; |
1924
|
|
|
|
|
|
|
case OP_SPLICE: |
1925
|
21
|
50
|
|
|
|
|
if (!(tmp = OpSIBLING(kid))) break; /* array */ |
|
|
50
|
|
|
|
|
|
1926
|
21
|
100
|
|
|
|
|
if (!(tmp = OpSIBLING(tmp))) break; /* offset */ |
|
|
100
|
|
|
|
|
|
1927
|
20
|
100
|
|
|
|
|
if (!(tmp = OpSIBLING(tmp))) break; /* length */ |
|
|
100
|
|
|
|
|
|
1928
|
19
|
100
|
|
|
|
|
if (!(tmp = OpSIBLING(tmp))) break; /* first elem */ |
|
|
100
|
|
|
|
|
|
1929
|
15
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_splice; |
1930
|
15
|
|
|
|
|
|
goto mod; |
1931
|
|
|
|
|
|
|
case OP_ANONLIST: |
1932
|
8
|
100
|
|
|
|
|
if (!(tmp = OpSIBLING(kid))) break; /* first elem */ |
|
|
100
|
|
|
|
|
|
1933
|
7
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_anonlist; |
1934
|
7
|
|
|
|
|
|
goto mod; |
1935
|
|
|
|
|
|
|
case OP_ANONHASH: |
1936
|
20
|
100
|
|
|
|
|
if (!(tmp = OpSIBLING(kid))) break; /* first elem */ |
|
|
100
|
|
|
|
|
|
1937
|
16
|
|
|
|
|
|
op->op_ppaddr = DataAlias_pp_anonhash; |
1938
|
96
|
100
|
|
|
|
|
mod: do MOD(tmp); while ((tmp = OpSIBLING(tmp))); |
|
|
100
|
|
|
|
|
|
1939
|
47
|
|
|
|
|
|
break; |
1940
|
|
|
|
|
|
|
#if DA_HAVE_OP_EMPTYAVHV |
1941
|
|
|
|
|
|
|
case OP_EMPTYAVHV: |
1942
|
|
|
|
|
|
|
break; |
1943
|
|
|
|
|
|
|
#endif |
1944
|
|
|
|
|
|
|
} |
1945
|
|
|
|
|
|
|
|
1946
|
3687
|
100
|
|
|
|
|
if (sib && OpHAS_SIBLING(op)) { |
|
|
100
|
|
|
|
|
|
1947
|
1516
|
100
|
|
|
|
|
if (kid) |
1948
|
642
|
|
|
|
|
|
hits += da_transform(aTHX_ kid, ksib); |
1949
|
1516
|
50
|
|
|
|
|
op = OpSIBLING(op); |
1950
|
|
|
|
|
|
|
} else { |
1951
|
2171
|
|
|
|
|
|
op = kid; |
1952
|
2171
|
|
|
|
|
|
sib = ksib; |
1953
|
|
|
|
|
|
|
} |
1954
|
|
|
|
|
|
|
} |
1955
|
|
|
|
|
|
|
|
1956
|
983
|
|
|
|
|
|
return hits; |
1957
|
|
|
|
|
|
|
} |
1958
|
|
|
|
|
|
|
|
1959
|
50596
|
|
|
|
|
|
STATIC void da_peep2(pTHX_ OP *o) { |
1960
|
|
|
|
|
|
|
OP *k, *lsop, *pmop, *argop, *cvop, *esop; |
1961
|
|
|
|
|
|
|
int useful; |
1962
|
106725
|
100
|
|
|
|
|
while (o->op_ppaddr != da_tag_list |
1963
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5031002) |
1964
|
|
|
|
|
|
|
&& o->op_ppaddr != da_tag_enter |
1965
|
|
|
|
|
|
|
#endif |
1966
|
|
|
|
|
|
|
) { |
1967
|
227716
|
100
|
|
|
|
|
while (OpHAS_SIBLING(o)) { |
1968
|
121328
|
100
|
|
|
|
|
if ((o->op_flags & OPf_KIDS) && (k = cUNOPo->op_first)){ |
|
|
100
|
|
|
|
|
|
1969
|
46039
|
|
|
|
|
|
da_peep2(aTHX_ k); |
1970
|
75289
|
100
|
|
|
|
|
} else switch (o->op_type ? o->op_type : o->op_targ) { |
|
|
100
|
|
|
|
|
|
1971
|
|
|
|
|
|
|
case_OP_SETSTATE_ |
1972
|
|
|
|
|
|
|
case OP_NEXTSTATE: |
1973
|
|
|
|
|
|
|
case OP_DBSTATE: |
1974
|
23597
|
|
|
|
|
|
PL_curcop = (COP *) o; |
1975
|
|
|
|
|
|
|
} |
1976
|
121326
|
50
|
|
|
|
|
o = OpSIBLING(o); |
1977
|
|
|
|
|
|
|
} |
1978
|
106388
|
100
|
|
|
|
|
if (!(o->op_flags & OPf_KIDS) || !(o = cUNOPo->op_first)) |
|
|
50
|
|
|
|
|
|
1979
|
50259
|
|
|
|
|
|
return; |
1980
|
|
|
|
|
|
|
} |
1981
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5031002) |
1982
|
|
|
|
|
|
|
if (o->op_ppaddr == da_tag_enter) { |
1983
|
|
|
|
|
|
|
o = OpSIBLING(o); |
1984
|
|
|
|
|
|
|
assert(o); |
1985
|
|
|
|
|
|
|
} |
1986
|
|
|
|
|
|
|
#endif |
1987
|
335
|
|
|
|
|
|
lsop = o; |
1988
|
335
|
|
|
|
|
|
useful = lsop->op_private & OPpUSEFUL; |
1989
|
335
|
|
|
|
|
|
op_null(lsop); |
1990
|
335
|
|
|
|
|
|
lsop->op_ppaddr = PL_ppaddr[OP_NULL]; |
1991
|
335
|
|
|
|
|
|
pmop = cLISTOPx(lsop)->op_first; |
1992
|
335
|
|
|
|
|
|
argop = cLISTOPx(lsop)->op_last; |
1993
|
335
|
50
|
|
|
|
|
if (!(cvop = cUNOPx(pmop)->op_first) || |
|
|
50
|
|
|
|
|
|
1994
|
335
|
|
|
|
|
|
cvop->op_ppaddr != da_tag_rv2cv) { |
1995
|
0
|
|
|
|
|
|
Perl_warn(aTHX_ "da peep weirdness 1"); |
1996
|
0
|
|
|
|
|
|
return; |
1997
|
|
|
|
|
|
|
} |
1998
|
335
|
|
|
|
|
|
OpMORESIB_set(argop, cvop); |
1999
|
335
|
|
|
|
|
|
OpLASTSIB_set(cvop, lsop); |
2000
|
335
|
|
|
|
|
|
cLISTOPx(lsop)->op_last = cvop; |
2001
|
335
|
50
|
|
|
|
|
if (!(esop = cvop->op_next) || esop->op_ppaddr != da_tag_entersub) { |
|
|
50
|
|
|
|
|
|
2002
|
0
|
|
|
|
|
|
Perl_warn(aTHX_ "da peep weirdness 2"); |
2003
|
0
|
|
|
|
|
|
return; |
2004
|
|
|
|
|
|
|
} |
2005
|
335
|
|
|
|
|
|
esop->op_type = OP_ENTERSUB; |
2006
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5031002) |
2007
|
|
|
|
|
|
|
if (cLISTOPx(esop)->op_first->op_ppaddr == da_tag_enter) { |
2008
|
|
|
|
|
|
|
/* the first is a dummy op we inserted to satisfy Perl_scalar/list. |
2009
|
|
|
|
|
|
|
we can't remove it since an op_next points at it, so null it out. |
2010
|
|
|
|
|
|
|
*/ |
2011
|
|
|
|
|
|
|
OP *nullop = cLISTOPx(esop)->op_first; |
2012
|
|
|
|
|
|
|
assert(nullop->op_type == OP_ENTER); |
2013
|
|
|
|
|
|
|
assert(OpSIBLING(nullop)); |
2014
|
|
|
|
|
|
|
nullop->op_type = OP_NULL; |
2015
|
|
|
|
|
|
|
nullop->op_ppaddr = PL_ppaddr[OP_NULL]; |
2016
|
|
|
|
|
|
|
} |
2017
|
|
|
|
|
|
|
#endif |
2018
|
335
|
100
|
|
|
|
|
if (cvop->op_flags & OPf_SPECIAL) { |
2019
|
13
|
|
|
|
|
|
esop->op_ppaddr = DataAlias_pp_copy; |
2020
|
13
|
|
|
|
|
|
da_peep2(aTHX_ pmop); |
2021
|
322
|
100
|
|
|
|
|
} else if (!da_transform(aTHX_ pmop, TRUE) |
2022
|
15
|
50
|
|
|
|
|
&& !useful && ckWARN(WARN_VOID)) { |
|
|
100
|
|
|
|
|
|
2023
|
1
|
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_VOID), |
2024
|
|
|
|
|
|
|
"Useless use of alias"); |
2025
|
|
|
|
|
|
|
} |
2026
|
|
|
|
|
|
|
} |
2027
|
|
|
|
|
|
|
|
2028
|
4564
|
|
|
|
|
|
STATIC void da_peep(pTHX_ OP *o) { |
2029
|
|
|
|
|
|
|
dDAforce; |
2030
|
4564
|
|
|
|
|
|
da_old_peepp(aTHX_ o); |
2031
|
4564
|
|
|
|
|
|
ENTER; |
2032
|
4564
|
|
|
|
|
|
SAVEVPTR(PL_curcop); |
2033
|
4564
|
50
|
|
|
|
|
if (da_inside < 0) |
2034
|
0
|
|
|
|
|
|
Perl_croak(aTHX_ "Data::Alias confused in da_peep (da_inside < 0)"); |
2035
|
4589
|
100
|
|
|
|
|
if (da_inside && da_iscope == &cxstack[cxstack_ix]) { |
|
|
100
|
|
|
|
|
|
2036
|
|
|
|
|
|
|
OP *tmp; |
2037
|
141
|
100
|
|
|
|
|
while ((tmp = o->op_next)) |
2038
|
116
|
|
|
|
|
|
o = tmp; |
2039
|
25
|
50
|
|
|
|
|
if (da_transform(aTHX_ o, FALSE)) |
2040
|
25
|
|
|
|
|
|
da_inside = 2; |
2041
|
|
|
|
|
|
|
} else { |
2042
|
4539
|
|
|
|
|
|
da_peep2(aTHX_ o); |
2043
|
|
|
|
|
|
|
} |
2044
|
4562
|
|
|
|
|
|
LEAVE; |
2045
|
4562
|
|
|
|
|
|
} |
2046
|
|
|
|
|
|
|
|
2047
|
|
|
|
|
|
|
#define LEX_NORMAL 10 |
2048
|
|
|
|
|
|
|
#define LEX_INTERPNORMAL 9 |
2049
|
|
|
|
|
|
|
#if DA_HAVE_LEX_KNOWNEXT |
2050
|
|
|
|
|
|
|
#define LEX_KNOWNEXT 0 |
2051
|
|
|
|
|
|
|
#endif |
2052
|
|
|
|
|
|
|
|
2053
|
6825
|
|
|
|
|
|
STATIC OP *da_ck_rv2cv(pTHX_ OP *o) { |
2054
|
|
|
|
|
|
|
dDA; |
2055
|
|
|
|
|
|
|
SV **sp, *gvsv; |
2056
|
|
|
|
|
|
|
OP *kid; |
2057
|
|
|
|
|
|
|
char *s, *start_s; |
2058
|
|
|
|
|
|
|
CV *cv; |
2059
|
|
|
|
|
|
|
I32 inside; |
2060
|
6825
|
|
|
|
|
|
o = da_old_ck_rv2cv(aTHX_ o); |
2061
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5009005) |
2062
|
6825
|
50
|
|
|
|
|
if (!PL_parser) |
2063
|
0
|
|
|
|
|
|
return o; |
2064
|
|
|
|
|
|
|
#endif |
2065
|
6825
|
50
|
|
|
|
|
if (PL_lex_state != LEX_NORMAL && PL_lex_state != LEX_INTERPNORMAL) |
|
|
0
|
|
|
|
|
|
2066
|
0
|
|
|
|
|
|
return o; /* not lexing? */ |
2067
|
6825
|
|
|
|
|
|
kid = cUNOPo->op_first; |
2068
|
6825
|
100
|
|
|
|
|
if (kid->op_type != OP_GV || !DA_ACTIVE) |
2069
|
642
|
|
|
|
|
|
return o; |
2070
|
6183
|
|
|
|
|
|
gvsv = (SV*)kGVOP_gv; |
2071
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5021004) |
2072
|
6183
|
100
|
|
|
|
|
cv = SvROK(gvsv) ? (CV*)SvRV(gvsv) : GvCV((GV*)gvsv); |
2073
|
|
|
|
|
|
|
#else |
2074
|
|
|
|
|
|
|
cv = GvCV((GV*)gvsv); |
2075
|
|
|
|
|
|
|
#endif |
2076
|
6183
|
100
|
|
|
|
|
if (cv == da_cv) /* Data::Alias::alias */ |
2077
|
461
|
|
|
|
|
|
inside = 1; |
2078
|
5722
|
100
|
|
|
|
|
else if (cv == da_cvc) /* Data::Alias::copy */ |
2079
|
17
|
|
|
|
|
|
inside = 0; |
2080
|
|
|
|
|
|
|
else |
2081
|
5705
|
|
|
|
|
|
return o; |
2082
|
478
|
100
|
|
|
|
|
if (o->op_private & OPpENTERSUB_AMPER) |
2083
|
2
|
|
|
|
|
|
return o; |
2084
|
|
|
|
|
|
|
|
2085
|
|
|
|
|
|
|
/* make sure the temporary ($) prototype for the parser hack is removed */ |
2086
|
476
|
|
|
|
|
|
SvPOK_off(cv); |
2087
|
|
|
|
|
|
|
|
2088
|
|
|
|
|
|
|
/* tag the op for later recognition */ |
2089
|
476
|
|
|
|
|
|
o->op_ppaddr = da_tag_rv2cv; |
2090
|
476
|
100
|
|
|
|
|
if (inside) |
2091
|
459
|
|
|
|
|
|
o->op_flags &= ~OPf_SPECIAL; |
2092
|
|
|
|
|
|
|
else |
2093
|
17
|
|
|
|
|
|
o->op_flags |= OPf_SPECIAL; |
2094
|
|
|
|
|
|
|
|
2095
|
476
|
|
|
|
|
|
start_s = s = PL_oldbufptr; |
2096
|
524
|
50
|
|
|
|
|
while (s < PL_bufend && isSPACE(*s)) s++; |
|
|
100
|
|
|
|
|
|
2097
|
|
|
|
|
|
|
|
2098
|
476
|
50
|
|
|
|
|
if (memEQ(s, PL_tokenbuf, strlen(PL_tokenbuf))) { |
2099
|
476
|
|
|
|
|
|
s += strlen(PL_tokenbuf); |
2100
|
476
|
100
|
|
|
|
|
if (PL_bufptr > s) s = PL_bufptr; |
2101
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5011002) |
2102
|
|
|
|
|
|
|
{ |
2103
|
476
|
|
|
|
|
|
char *old_buf = SvPVX(PL_linestr); |
2104
|
476
|
|
|
|
|
|
char *old_bufptr = PL_bufptr; |
2105
|
476
|
|
|
|
|
|
PL_bufptr = s; |
2106
|
476
|
|
|
|
|
|
lex_read_space(LEX_KEEP_PREVIOUS); |
2107
|
476
|
50
|
|
|
|
|
if (SvPVX(PL_linestr) != old_buf) |
2108
|
0
|
|
|
|
|
|
Perl_croak(aTHX_ "Data::Alias can't handle " |
2109
|
|
|
|
|
|
|
"lexer buffer reallocation"); |
2110
|
476
|
|
|
|
|
|
s = PL_bufptr; |
2111
|
476
|
|
|
|
|
|
PL_bufptr = old_bufptr; |
2112
|
|
|
|
|
|
|
} |
2113
|
|
|
|
|
|
|
#else |
2114
|
|
|
|
|
|
|
while (s < PL_bufend && isSPACE(*s)) s++; |
2115
|
|
|
|
|
|
|
#endif |
2116
|
|
|
|
|
|
|
} else { |
2117
|
0
|
|
|
|
|
|
s = ""; |
2118
|
|
|
|
|
|
|
} |
2119
|
|
|
|
|
|
|
|
2120
|
|
|
|
|
|
|
/* if not already done, localize da_inside to this compilation scope. */ |
2121
|
|
|
|
|
|
|
/* this ensures it will get restored if we bail out with a compile error. */ |
2122
|
476
|
100
|
|
|
|
|
if (da_iscope != &cxstack[cxstack_ix]) { |
2123
|
38
|
|
|
|
|
|
SAVEVPTR(da_iscope); |
2124
|
38
|
|
|
|
|
|
SAVEI32(da_inside); |
2125
|
38
|
|
|
|
|
|
da_iscope = &cxstack[cxstack_ix]; |
2126
|
|
|
|
|
|
|
} |
2127
|
|
|
|
|
|
|
|
2128
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5011002) |
2129
|
|
|
|
|
|
|
/* since perl 5.11.2, when a sub is called with parenthesized argument the */ |
2130
|
|
|
|
|
|
|
/* initial rv2cv op gets destroyed and a new one is created. deal with that. */ |
2131
|
476
|
100
|
|
|
|
|
if (da_inside < 0) { |
2132
|
141
|
50
|
|
|
|
|
if (*s != '(' || da_inside != ~inside) |
|
|
50
|
|
|
|
|
|
2133
|
0
|
|
|
|
|
|
Perl_croak(aTHX_ "Data::Alias confused in da_ck_rv2cv"); |
2134
|
|
|
|
|
|
|
} else |
2135
|
|
|
|
|
|
|
#endif |
2136
|
|
|
|
|
|
|
{ |
2137
|
|
|
|
|
|
|
/* save da_inside on stack, restored in da_ck_entersub */ |
2138
|
335
|
|
|
|
|
|
SPAGAIN; |
2139
|
335
|
50
|
|
|
|
|
XPUSHs(da_inside ? &PL_sv_yes : &PL_sv_no); |
|
|
100
|
|
|
|
|
|
2140
|
335
|
|
|
|
|
|
PUTBACK; |
2141
|
|
|
|
|
|
|
} |
2142
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5011002) |
2143
|
476
|
100
|
|
|
|
|
if (*s == '(' && da_inside >= 0) { |
|
|
100
|
|
|
|
|
|
2144
|
141
|
|
|
|
|
|
da_inside = ~inside; /* first rv2cv op (will be discarded) */ |
2145
|
141
|
|
|
|
|
|
return o; |
2146
|
|
|
|
|
|
|
} |
2147
|
|
|
|
|
|
|
#endif |
2148
|
335
|
|
|
|
|
|
da_inside = inside; |
2149
|
|
|
|
|
|
|
|
2150
|
335
|
100
|
|
|
|
|
if (*s == '{') { /* disgusting parser hack for alias BLOCK (and copy BLOCK) */ |
2151
|
|
|
|
|
|
|
I32 shift; |
2152
|
|
|
|
|
|
|
int tok; |
2153
|
73
|
|
|
|
|
|
YYSTYPE yylval = PL_yylval; |
2154
|
73
|
|
|
|
|
|
PL_bufptr = s; |
2155
|
73
|
|
|
|
|
|
PL_expect = XSTATE; |
2156
|
73
|
|
|
|
|
|
tok = yylex(); |
2157
|
73
|
|
|
|
|
|
PL_nexttype[PL_nexttoke++] = tok; |
2158
|
73
|
100
|
|
|
|
|
if (tok == '{' |
2159
|
|
|
|
|
|
|
#if PERL_COMBI_VERSION >= 5033006 |
2160
|
|
|
|
|
|
|
|| tok == PERLY_BRACE_OPEN |
2161
|
|
|
|
|
|
|
#endif |
2162
|
|
|
|
|
|
|
) { |
2163
|
61
|
|
|
|
|
|
PL_nexttype[PL_nexttoke++] = KW_DO; |
2164
|
61
|
|
|
|
|
|
sv_setpv((SV *) cv, "$"); |
2165
|
|
|
|
|
|
|
if ((PERL_COMBI_VERSION >= 5021004) || |
2166
|
|
|
|
|
|
|
(PERL_COMBI_VERSION >= 5011002 && |
2167
|
|
|
|
|
|
|
*PL_bufptr == '(')) { |
2168
|
|
|
|
|
|
|
/* |
2169
|
|
|
|
|
|
|
* On 5.21.4+, PL_expect can't be |
2170
|
|
|
|
|
|
|
* directly set as we'd like, and ends |
2171
|
|
|
|
|
|
|
* up wrong for parsing the interior of |
2172
|
|
|
|
|
|
|
* the block. Rectify it by injecting |
2173
|
|
|
|
|
|
|
* a semicolon, lexing of which sets |
2174
|
|
|
|
|
|
|
* PL_expect appropriately. On 5.11.2+, |
2175
|
|
|
|
|
|
|
* a paren here triggers special lexer |
2176
|
|
|
|
|
|
|
* behaviour for a parenthesised argument |
2177
|
|
|
|
|
|
|
* list, which screws up the normal |
2178
|
|
|
|
|
|
|
* parsing that we want to continue. |
2179
|
|
|
|
|
|
|
* Suppress it by injecting a semicolon. |
2180
|
|
|
|
|
|
|
* Either way, apart from this tweaking of |
2181
|
|
|
|
|
|
|
* the lexer the semicolon is a no-op, |
2182
|
|
|
|
|
|
|
* coming as it does just after the |
2183
|
|
|
|
|
|
|
* opening brace of a block. |
2184
|
|
|
|
|
|
|
*/ |
2185
|
61
|
|
|
|
|
|
Move(PL_bufptr, PL_bufptr+1, |
2186
|
|
|
|
|
|
|
PL_bufend+1-PL_bufptr, char); |
2187
|
61
|
|
|
|
|
|
*PL_bufptr = ';'; |
2188
|
61
|
|
|
|
|
|
PL_bufend++; |
2189
|
61
|
|
|
|
|
|
SvCUR_set(PL_linestr, SvCUR(PL_linestr)+1); |
2190
|
|
|
|
|
|
|
} |
2191
|
|
|
|
|
|
|
} |
2192
|
|
|
|
|
|
|
#if DA_HAVE_LEX_KNOWNEXT |
2193
|
|
|
|
|
|
|
if(PL_lex_state != LEX_KNOWNEXT) { |
2194
|
|
|
|
|
|
|
PL_lex_defer = PL_lex_state; |
2195
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION < 5021004) |
2196
|
|
|
|
|
|
|
PL_lex_expect = PL_expect; |
2197
|
|
|
|
|
|
|
#endif |
2198
|
|
|
|
|
|
|
PL_lex_state = LEX_KNOWNEXT; |
2199
|
|
|
|
|
|
|
} |
2200
|
|
|
|
|
|
|
#endif |
2201
|
73
|
|
|
|
|
|
PL_yylval = yylval; |
2202
|
73
|
50
|
|
|
|
|
if ((shift = s - PL_bufptr)) { /* here comes deeper magic */ |
2203
|
73
|
|
|
|
|
|
s = SvPVX(PL_linestr); |
2204
|
73
|
|
|
|
|
|
PL_bufptr += shift; |
2205
|
73
|
50
|
|
|
|
|
if ((PL_oldbufptr += shift) < s) |
2206
|
0
|
|
|
|
|
|
PL_oldbufptr = s; |
2207
|
73
|
100
|
|
|
|
|
if ((PL_oldoldbufptr += shift) < s) |
2208
|
27
|
|
|
|
|
|
PL_oldbufptr = s; |
2209
|
73
|
100
|
|
|
|
|
if (PL_last_uni && (PL_last_uni += shift) < s) |
|
|
50
|
|
|
|
|
|
2210
|
0
|
|
|
|
|
|
PL_last_uni = s; |
2211
|
73
|
100
|
|
|
|
|
if (PL_last_lop && (PL_last_lop += shift) < s) |
|
|
100
|
|
|
|
|
|
2212
|
36
|
|
|
|
|
|
PL_last_lop = s; |
2213
|
73
|
50
|
|
|
|
|
if (shift > 0) { |
2214
|
0
|
|
|
|
|
|
STRLEN len = SvCUR(PL_linestr) + 1; |
2215
|
0
|
0
|
|
|
|
|
if (len + shift > SvLEN(PL_linestr)) |
2216
|
0
|
|
|
|
|
|
len = SvLEN(PL_linestr) - shift; |
2217
|
0
|
|
|
|
|
|
Move(s, s + shift, len, char); |
2218
|
0
|
|
|
|
|
|
SvCUR_set(PL_linestr, len + shift - 1); |
2219
|
|
|
|
|
|
|
} else { |
2220
|
73
|
|
|
|
|
|
STRLEN len = SvCUR(PL_linestr) + shift + 1; |
2221
|
73
|
|
|
|
|
|
Move(s - shift, s, len, char); |
2222
|
73
|
|
|
|
|
|
SvCUR_set(PL_linestr, SvCUR(PL_linestr) + shift); |
2223
|
|
|
|
|
|
|
} |
2224
|
73
|
|
|
|
|
|
*(PL_bufend = s + SvCUR(PL_linestr)) = '\0'; |
2225
|
73
|
50
|
|
|
|
|
if (start_s < PL_bufptr) |
2226
|
73
|
|
|
|
|
|
memset(start_s, ' ', PL_bufptr-start_s); |
2227
|
|
|
|
|
|
|
} |
2228
|
|
|
|
|
|
|
} |
2229
|
335
|
|
|
|
|
|
return o; |
2230
|
|
|
|
|
|
|
} |
2231
|
|
|
|
|
|
|
|
2232
|
6100
|
|
|
|
|
|
STATIC OP *da_ck_entersub(pTHX_ OP *esop) { |
2233
|
|
|
|
|
|
|
dDA; |
2234
|
|
|
|
|
|
|
OP *lsop, *cvop, *pmop, *argop; |
2235
|
|
|
|
|
|
|
I32 inside; |
2236
|
6100
|
50
|
|
|
|
|
if (!(esop->op_flags & OPf_KIDS)) |
2237
|
0
|
|
|
|
|
|
return da_old_ck_entersub(aTHX_ esop); |
2238
|
6100
|
|
|
|
|
|
lsop = cUNOPx(esop)->op_first; |
2239
|
6100
|
50
|
|
|
|
|
if (!(lsop->op_type == OP_LIST || |
|
|
100
|
|
|
|
|
|
2240
|
4306
|
50
|
|
|
|
|
(lsop->op_type == OP_NULL && lsop->op_targ == OP_LIST)) |
2241
|
4306
|
50
|
|
|
|
|
|| OpHAS_SIBLING(lsop) || !(lsop->op_flags & OPf_KIDS)) |
|
|
50
|
|
|
|
|
|
2242
|
1794
|
|
|
|
|
|
return da_old_ck_entersub(aTHX_ esop); |
2243
|
4306
|
|
|
|
|
|
cvop = cLISTOPx(lsop)->op_last; |
2244
|
4306
|
100
|
|
|
|
|
if (!DA_ACTIVE || cvop->op_ppaddr != da_tag_rv2cv) |
2245
|
3971
|
|
|
|
|
|
return da_old_ck_entersub(aTHX_ esop); |
2246
|
335
|
|
|
|
|
|
inside = da_inside; |
2247
|
335
|
50
|
|
|
|
|
if (inside < 0) |
2248
|
0
|
|
|
|
|
|
Perl_croak(aTHX_ "Data::Alias confused in da_ck_entersub (da_inside < 0)"); |
2249
|
335
|
|
|
|
|
|
da_inside = SvIVX(*PL_stack_sp--); |
2250
|
335
|
100
|
|
|
|
|
SvPOK_off(inside ? da_cv : da_cvc); |
|
|
100
|
|
|
|
|
|
2251
|
335
|
|
|
|
|
|
op_clear(esop); |
2252
|
335
|
|
|
|
|
|
RenewOpc(0, esop, 1, LISTOP, OP); |
2253
|
335
|
|
|
|
|
|
OpLASTSIB_set(lsop, esop); |
2254
|
335
|
100
|
|
|
|
|
esop->op_type = inside ? OP_SCOPE : OP_LEAVE; |
2255
|
335
|
|
|
|
|
|
esop->op_ppaddr = da_tag_entersub; |
2256
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5031002) |
2257
|
|
|
|
|
|
|
if (!inside && !OpHAS_SIBLING(lsop)) { |
2258
|
|
|
|
|
|
|
/* esop is now a leave, and Perl_scalar/Perl_list expects at least two children. |
2259
|
|
|
|
|
|
|
we insert it in the middle (and null it later) since Perl_scalar() |
2260
|
|
|
|
|
|
|
tries to find the last non-(null/state) op *after* the expected enter. |
2261
|
|
|
|
|
|
|
*/ |
2262
|
|
|
|
|
|
|
OP *enterop; |
2263
|
|
|
|
|
|
|
NewOp(0, enterop, 1, OP); |
2264
|
|
|
|
|
|
|
enterop->op_type = OP_ENTER; |
2265
|
|
|
|
|
|
|
enterop->op_ppaddr = da_tag_enter; |
2266
|
|
|
|
|
|
|
cLISTOPx(esop)->op_first = enterop; |
2267
|
|
|
|
|
|
|
OpMORESIB_set(enterop, lsop); |
2268
|
|
|
|
|
|
|
OpLASTSIB_set(lsop, esop); |
2269
|
|
|
|
|
|
|
} |
2270
|
|
|
|
|
|
|
#endif |
2271
|
335
|
|
|
|
|
|
cLISTOPx(esop)->op_last = lsop; |
2272
|
335
|
|
|
|
|
|
lsop->op_type = OP_LIST; |
2273
|
335
|
|
|
|
|
|
lsop->op_targ = 0; |
2274
|
335
|
|
|
|
|
|
lsop->op_ppaddr = da_tag_list; |
2275
|
335
|
100
|
|
|
|
|
if (inside > 1) |
2276
|
20
|
|
|
|
|
|
lsop->op_private |= OPpUSEFUL; |
2277
|
|
|
|
|
|
|
else |
2278
|
315
|
|
|
|
|
|
lsop->op_private &= ~OPpUSEFUL; |
2279
|
335
|
|
|
|
|
|
pmop = cLISTOPx(lsop)->op_first; |
2280
|
335
|
100
|
|
|
|
|
if (inside) |
2281
|
322
|
|
|
|
|
|
op_null(pmop); |
2282
|
335
|
|
|
|
|
|
RenewOpc(0, pmop, 1, UNOP, OP); |
2283
|
335
|
|
|
|
|
|
cLISTOPx(lsop)->op_first = pmop; |
2284
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5021006) |
2285
|
335
|
|
|
|
|
|
pmop->op_type = OP_CUSTOM; |
2286
|
|
|
|
|
|
|
#endif |
2287
|
335
|
|
|
|
|
|
pmop->op_next = pmop; |
2288
|
335
|
|
|
|
|
|
cUNOPx(pmop)->op_first = cvop; |
2289
|
335
|
|
|
|
|
|
OpLASTSIB_set(cvop, pmop); |
2290
|
335
|
|
|
|
|
|
argop = pmop; |
2291
|
676
|
50
|
|
|
|
|
while (OpSIBLING(argop) != cvop) |
|
|
100
|
|
|
|
|
|
2292
|
341
|
50
|
|
|
|
|
argop = OpSIBLING(argop); |
2293
|
335
|
|
|
|
|
|
cLISTOPx(lsop)->op_last = argop; |
2294
|
335
|
|
|
|
|
|
OpLASTSIB_set(argop, lsop); |
2295
|
335
|
100
|
|
|
|
|
if (argop->op_type == OP_NULL && inside) |
|
|
100
|
|
|
|
|
|
2296
|
94
|
|
|
|
|
|
argop->op_flags &= ~OPf_SPECIAL; |
2297
|
335
|
|
|
|
|
|
cvop->op_next = esop; |
2298
|
335
|
|
|
|
|
|
return esop; |
2299
|
|
|
|
|
|
|
} |
2300
|
|
|
|
|
|
|
|
2301
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5021007) |
2302
|
3716
|
|
|
|
|
|
STATIC OP *da_ck_aelem(pTHX_ OP *o) { return da_old_ck_aelem(aTHX_ o); } |
2303
|
11718
|
|
|
|
|
|
STATIC OP *da_ck_helem(pTHX_ OP *o) { return da_old_ck_helem(aTHX_ o); } |
2304
|
|
|
|
|
|
|
#endif |
2305
|
|
|
|
|
|
|
|
2306
|
|
|
|
|
|
|
MODULE = Data::Alias PACKAGE = Data::Alias |
2307
|
|
|
|
|
|
|
|
2308
|
|
|
|
|
|
|
PROTOTYPES: DISABLE |
2309
|
|
|
|
|
|
|
|
2310
|
|
|
|
|
|
|
BOOT: |
2311
|
|
|
|
|
|
|
{ |
2312
|
|
|
|
|
|
|
dDA; |
2313
|
|
|
|
|
|
|
DA_INIT; |
2314
|
29
|
|
|
|
|
|
da_cv = get_cv("Data::Alias::alias", TRUE); |
2315
|
29
|
|
|
|
|
|
da_cvc = get_cv("Data::Alias::copy", TRUE); |
2316
|
29
|
|
|
|
|
|
wrap_op_checker(OP_RV2CV, da_ck_rv2cv, &da_old_ck_rv2cv); |
2317
|
29
|
|
|
|
|
|
wrap_op_checker(OP_ENTERSUB, da_ck_entersub, &da_old_ck_entersub); |
2318
|
|
|
|
|
|
|
#if (PERL_COMBI_VERSION >= 5021007) |
2319
|
|
|
|
|
|
|
{ |
2320
|
|
|
|
|
|
|
/* |
2321
|
|
|
|
|
|
|
* The multideref peep-time optimisation, introduced in |
2322
|
|
|
|
|
|
|
* Perl 5.21.7, is liable to incorporate into a multideref |
2323
|
|
|
|
|
|
|
* op aelem/helem ops that we need to modify. Because our |
2324
|
|
|
|
|
|
|
* modification of those ops gets applied late at peep |
2325
|
|
|
|
|
|
|
* time, after the main peeper, the specialness of the |
2326
|
|
|
|
|
|
|
* ops doesn't get a chance to inhibit incorporation |
2327
|
|
|
|
|
|
|
* into a multideref. As an ugly hack, we disable the |
2328
|
|
|
|
|
|
|
* multideref optimisation entirely for these op types |
2329
|
|
|
|
|
|
|
* by hooking their checking (and not actually doing |
2330
|
|
|
|
|
|
|
* anything in the checker). |
2331
|
|
|
|
|
|
|
* |
2332
|
|
|
|
|
|
|
* The multideref peep-time code has no logical |
2333
|
|
|
|
|
|
|
* reason to look at whether the op checking is in a |
2334
|
|
|
|
|
|
|
* non-default state. It deals with already-checked ops, |
2335
|
|
|
|
|
|
|
* so a check hook cannot make any difference to the |
2336
|
|
|
|
|
|
|
* future behaviour of those ops. Rather, it should, |
2337
|
|
|
|
|
|
|
* but currently (5.23.4) doesn't, check that op_ppaddr |
2338
|
|
|
|
|
|
|
* of the op to be incorporated has the standard value. |
2339
|
|
|
|
|
|
|
* If the superfluous PL_check[] check goes away, this |
2340
|
|
|
|
|
|
|
* hack will break. |
2341
|
|
|
|
|
|
|
* |
2342
|
|
|
|
|
|
|
* The proper fix for this problem would be to move our op |
2343
|
|
|
|
|
|
|
* munging from peep time to op check time. When ops are |
2344
|
|
|
|
|
|
|
* placed into an alias() wrapper they should be walked, |
2345
|
|
|
|
|
|
|
* and the contained assignments and lvalues modified. |
2346
|
|
|
|
|
|
|
* The modified lvalue aelem/helem ops would thereby be |
2347
|
|
|
|
|
|
|
* made visibly non-standard in plenty of time for the |
2348
|
|
|
|
|
|
|
* multideref peep-time code to avoid replacing them. |
2349
|
|
|
|
|
|
|
* If the multideref code is changed to look at op_ppaddr |
2350
|
|
|
|
|
|
|
* then that change alone will be sufficient; failing |
2351
|
|
|
|
|
|
|
* that the op_type can be changed to OP_CUSTOM. |
2352
|
|
|
|
|
|
|
*/ |
2353
|
29
|
|
|
|
|
|
wrap_op_checker(OP_AELEM, da_ck_aelem, &da_old_ck_aelem); |
2354
|
29
|
|
|
|
|
|
wrap_op_checker(OP_HELEM, da_ck_helem, &da_old_ck_helem); |
2355
|
|
|
|
|
|
|
} |
2356
|
|
|
|
|
|
|
#endif |
2357
|
29
|
|
|
|
|
|
CvLVALUE_on(get_cv("Data::Alias::deref", TRUE)); |
2358
|
29
|
|
|
|
|
|
da_old_peepp = PL_peepp; |
2359
|
29
|
|
|
|
|
|
PL_peepp = da_peep; |
2360
|
|
|
|
|
|
|
} |
2361
|
|
|
|
|
|
|
|
2362
|
|
|
|
|
|
|
void |
2363
|
|
|
|
|
|
|
deref(...) |
2364
|
|
|
|
|
|
|
PREINIT: |
2365
|
13
|
|
|
|
|
|
I32 i, n = 0; |
2366
|
|
|
|
|
|
|
SV *sv; |
2367
|
|
|
|
|
|
|
PPCODE: |
2368
|
35
|
100
|
|
|
|
|
for (i = 0; i < items; i++) { |
2369
|
27
|
100
|
|
|
|
|
if (!SvROK(ST(i))) { |
2370
|
|
|
|
|
|
|
STRLEN z; |
2371
|
3
|
100
|
|
|
|
|
if (SvOK(ST(i))) |
|
|
50
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
2372
|
1
|
50
|
|
|
|
|
Perl_croak(aTHX_ DA_DEREF_ERR, SvPV(ST(i), z)); |
2373
|
2
|
100
|
|
|
|
|
if (ckWARN(WARN_UNINITIALIZED)) |
2374
|
1
|
|
|
|
|
|
Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED), |
2375
|
|
|
|
|
|
|
"Use of uninitialized value in deref"); |
2376
|
1
|
|
|
|
|
|
continue; |
2377
|
|
|
|
|
|
|
} |
2378
|
24
|
|
|
|
|
|
sv = SvRV(ST(i)); |
2379
|
24
|
|
|
|
|
|
switch (SvTYPE(sv)) { |
2380
|
|
|
|
|
|
|
I32 x; |
2381
|
|
|
|
|
|
|
case SVt_PVAV: |
2382
|
4
|
100
|
|
|
|
|
if (!(x = av_len((AV *) sv) + 1)) |
2383
|
1
|
|
|
|
|
|
continue; |
2384
|
3
|
|
|
|
|
|
SP += x; |
2385
|
3
|
|
|
|
|
|
break; |
2386
|
|
|
|
|
|
|
case SVt_PVHV: |
2387
|
3
|
50
|
|
|
|
|
if (!(x = HvKEYS(sv))) |
|
|
100
|
|
|
|
|
|
2388
|
1
|
|
|
|
|
|
continue; |
2389
|
2
|
|
|
|
|
|
SP += x * 2; |
2390
|
2
|
|
|
|
|
|
break; |
2391
|
|
|
|
|
|
|
case SVt_PVCV: |
2392
|
1
|
|
|
|
|
|
Perl_croak(aTHX_ "Can't deref subroutine reference"); |
2393
|
|
|
|
|
|
|
case SVt_PVFM: |
2394
|
1
|
|
|
|
|
|
Perl_croak(aTHX_ "Can't deref format reference"); |
2395
|
|
|
|
|
|
|
case SVt_PVIO: |
2396
|
1
|
|
|
|
|
|
Perl_croak(aTHX_ "Can't deref filehandle reference"); |
2397
|
|
|
|
|
|
|
default: |
2398
|
14
|
|
|
|
|
|
SP++; |
2399
|
|
|
|
|
|
|
} |
2400
|
19
|
|
|
|
|
|
ST(n++) = ST(i); |
2401
|
|
|
|
|
|
|
} |
2402
|
8
|
50
|
|
|
|
|
EXTEND(SP, 0); |
2403
|
27
|
100
|
|
|
|
|
for (i = 0; n--; ) { |
2404
|
19
|
|
|
|
|
|
SV *sv = SvRV(ST(n)); |
2405
|
19
|
|
|
|
|
|
I32 x = SvTYPE(sv); |
2406
|
19
|
100
|
|
|
|
|
if (x == SVt_PVAV) { |
2407
|
3
|
50
|
|
|
|
|
i -= x = AvFILL((AV *) sv) + 1; |
2408
|
3
|
50
|
|
|
|
|
Copy(AvARRAY((AV *) sv), SP + i + 1, INT2SIZE(x), SV *); |
2409
|
16
|
100
|
|
|
|
|
} else if (x == SVt_PVHV) { |
2410
|
|
|
|
|
|
|
HE *entry; |
2411
|
2
|
|
|
|
|
|
HV *hv = (HV *) sv; |
2412
|
2
|
|
|
|
|
|
i -= x = hv_iterinit(hv) * 2; |
2413
|
2
|
|
|
|
|
|
PUTBACK; |
2414
|
6
|
100
|
|
|
|
|
while ((entry = hv_iternext(hv))) { |
2415
|
4
|
|
|
|
|
|
sv = hv_iterkeysv(entry); |
2416
|
4
|
|
|
|
|
|
SvREADONLY_on(sv); |
2417
|
4
|
|
|
|
|
|
SPAGAIN; |
2418
|
4
|
|
|
|
|
|
SP[++i] = sv; |
2419
|
4
|
|
|
|
|
|
sv = hv_iterval(hv, entry); |
2420
|
4
|
|
|
|
|
|
SPAGAIN; |
2421
|
4
|
|
|
|
|
|
SP[++i] = sv; |
2422
|
|
|
|
|
|
|
} |
2423
|
2
|
|
|
|
|
|
i -= x; |
2424
|
|
|
|
|
|
|
} else { |
2425
|
14
|
|
|
|
|
|
SP[i--] = sv; |
2426
|
|
|
|
|
|
|
} |
2427
|
|
|
|
|
|
|
} |