line |
stmt |
bran |
cond |
sub |
time |
code |
1
|
|
|
|
|
|
#define PERL_NO_GET_CONTEXT |
2
|
|
|
|
|
|
#include "EXTERN.h" |
3
|
|
|
|
|
|
#include "perl.h" |
4
|
|
|
|
|
|
#include "XSUB.h" |
5
|
|
|
|
|
|
|
6
|
|
|
|
|
|
/* PL_maxo shouldn't differ from MAXO but leave room anyway (see BOOT:) */ |
7
|
|
|
|
|
|
#define OP_MASK_BUF_SIZE (MAXO + 100) |
8
|
|
|
|
|
|
|
9
|
|
|
|
|
|
/* XXX op_named_bits and opset_all are never freed */ |
10
|
|
|
|
|
|
#define MY_CXT_KEY "Opcode::_guts" XS_VERSION |
11
|
|
|
|
|
|
|
12
|
|
|
|
|
|
typedef struct { |
13
|
|
|
|
|
|
HV * x_op_named_bits; /* cache shared for whole process */ |
14
|
|
|
|
|
|
SV * x_opset_all; /* mask with all bits set */ |
15
|
|
|
|
|
|
IV x_opset_len; /* length of opmasks in bytes */ |
16
|
|
|
|
|
|
int x_opcode_debug; |
17
|
|
|
|
|
|
} my_cxt_t; |
18
|
|
|
|
|
|
|
19
|
|
|
|
|
|
START_MY_CXT |
20
|
|
|
|
|
|
|
21
|
|
|
|
|
|
#define op_named_bits (MY_CXT.x_op_named_bits) |
22
|
|
|
|
|
|
#define opset_all (MY_CXT.x_opset_all) |
23
|
|
|
|
|
|
#define opset_len (MY_CXT.x_opset_len) |
24
|
|
|
|
|
|
#define opcode_debug (MY_CXT.x_opcode_debug) |
25
|
|
|
|
|
|
|
26
|
|
|
|
|
|
static SV *new_opset (pTHX_ SV *old_opset); |
27
|
|
|
|
|
|
static int verify_opset (pTHX_ SV *opset, int fatal); |
28
|
|
|
|
|
|
static void set_opset_bits (pTHX_ char *bitmap, SV *bitspec, int on, const char *opname); |
29
|
|
|
|
|
|
static void put_op_bitspec (pTHX_ const char *optag, STRLEN len, SV *opset); |
30
|
|
|
|
|
|
static SV *get_op_bitspec (pTHX_ const char *opname, STRLEN len, int fatal); |
31
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
33
|
|
|
|
|
|
/* Initialise our private op_named_bits HV. |
34
|
|
|
|
|
|
* It is first loaded with the name and number of each perl operator. |
35
|
|
|
|
|
|
* Then the builtin tags :none and :all are added. |
36
|
|
|
|
|
|
* Opcode.pm loads the standard optags from __DATA__ |
37
|
|
|
|
|
|
* XXX leak-alert: data allocated here is never freed, call this |
38
|
|
|
|
|
|
* at most once |
39
|
|
|
|
|
|
*/ |
40
|
|
|
|
|
|
|
41
|
|
|
|
|
|
static void |
42
|
30
|
|
|
|
|
op_names_init(pTHX) |
43
|
|
|
|
|
|
{ |
44
|
|
|
|
|
|
int i; |
45
|
|
|
|
|
|
STRLEN len; |
46
|
|
|
|
|
|
char **op_names; |
47
|
|
|
|
|
|
char *bitmap; |
48
|
|
|
|
|
|
dMY_CXT; |
49
|
|
|
|
|
|
|
50
|
30
|
|
|
|
|
op_named_bits = newHV(); |
51
|
30
|
|
|
|
|
op_names = get_op_names(); |
52
|
11340
|
|
|
|
|
for(i=0; i < PL_maxo; ++i) { |
53
|
11310
|
|
|
|
|
SV * const sv = newSViv(i); |
54
|
11310
|
|
|
|
|
SvREADONLY_on(sv); |
55
|
11310
|
|
|
|
|
(void) hv_store(op_named_bits, op_names[i], strlen(op_names[i]), sv, 0); |
56
|
|
|
|
|
|
} |
57
|
|
|
|
|
|
|
58
|
30
|
|
|
|
|
put_op_bitspec(aTHX_ STR_WITH_LEN(":none"), sv_2mortal(new_opset(aTHX_ Nullsv))); |
59
|
|
|
|
|
|
|
60
|
30
|
|
|
|
|
opset_all = new_opset(aTHX_ Nullsv); |
61
|
30
|
|
|
|
|
bitmap = SvPV(opset_all, len); |
62
|
30
|
|
|
|
|
memset(bitmap, 0xFF, len-1); /* deal with last byte specially, see below */ |
63
|
|
|
|
|
|
/* Take care to set the right number of bits in the last byte */ |
64
|
30
|
|
|
|
|
bitmap[len-1] = (PL_maxo & 0x07) ? ~(0xFF << (PL_maxo & 0x07)) : 0xFF; |
65
|
30
|
|
|
|
|
put_op_bitspec(aTHX_ STR_WITH_LEN(":all"), opset_all); /* don't mortalise */ |
66
|
30
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
69
|
|
|
|
|
|
/* Store a new tag definition. Always a mask. |
70
|
|
|
|
|
|
* The tag must not already be defined. |
71
|
|
|
|
|
|
* SV *mask is copied not referenced. |
72
|
|
|
|
|
|
*/ |
73
|
|
|
|
|
|
|
74
|
|
|
|
|
|
static void |
75
|
632
|
|
|
|
|
put_op_bitspec(pTHX_ const char *optag, STRLEN len, SV *mask) |
76
|
|
|
|
|
|
{ |
77
|
|
|
|
|
|
SV **svp; |
78
|
|
|
|
|
|
dMY_CXT; |
79
|
|
|
|
|
|
|
80
|
632
|
|
|
|
|
verify_opset(aTHX_ mask,1); |
81
|
632
|
|
|
|
|
svp = hv_fetch(op_named_bits, optag, len, 1); |
82
|
632
|
|
|
|
|
if (SvOK(*svp)) |
83
|
0
|
|
|
|
|
croak("Opcode tag \"%s\" already defined", optag); |
84
|
632
|
|
|
|
|
sv_setsv(*svp, mask); |
85
|
632
|
|
|
|
|
SvREADONLY_on(*svp); |
86
|
632
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
90
|
|
|
|
|
|
/* Fetch a 'bits' entry for an opname or optag (IV/PV). |
91
|
|
|
|
|
|
* Note that we return the actual entry for speed. |
92
|
|
|
|
|
|
* Always sv_mortalcopy() if returning it to user code. |
93
|
|
|
|
|
|
*/ |
94
|
|
|
|
|
|
|
95
|
|
|
|
|
|
static SV * |
96
|
11946
|
|
|
|
|
get_op_bitspec(pTHX_ const char *opname, STRLEN len, int fatal) |
97
|
|
|
|
|
|
{ |
98
|
|
|
|
|
|
SV **svp; |
99
|
|
|
|
|
|
dMY_CXT; |
100
|
|
|
|
|
|
|
101
|
11946
|
|
|
|
|
svp = hv_fetch(op_named_bits, opname, len, 0); |
102
|
11946
|
|
|
|
|
if (!svp || !SvOK(*svp)) { |
103
|
4
|
|
|
|
|
if (!fatal) |
104
|
|
|
|
|
|
return Nullsv; |
105
|
4
|
|
|
|
|
if (*opname == ':') |
106
|
2
|
|
|
|
|
croak("Unknown operator tag \"%s\"", opname); |
107
|
2
|
|
|
|
|
if (*opname == '!') /* XXX here later, or elsewhere? */ |
108
|
0
|
|
|
|
|
croak("Can't negate operators here (\"%s\")", opname); |
109
|
2
|
|
|
|
|
if (isALPHA(*opname)) |
110
|
2
|
|
|
|
|
croak("Unknown operator name \"%s\"", opname); |
111
|
0
|
|
|
|
|
croak("Unknown operator prefix \"%s\"", opname); |
112
|
|
|
|
|
|
} |
113
|
11942
|
|
|
|
|
return *svp; |
114
|
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
118
|
|
|
|
|
|
static SV * |
119
|
824
|
|
|
|
|
new_opset(pTHX_ SV *old_opset) |
120
|
|
|
|
|
|
{ |
121
|
|
|
|
|
|
SV *opset; |
122
|
|
|
|
|
|
dMY_CXT; |
123
|
|
|
|
|
|
|
124
|
824
|
|
|
|
|
if (old_opset) { |
125
|
88
|
|
|
|
|
verify_opset(aTHX_ old_opset,1); |
126
|
88
|
|
|
|
|
opset = newSVsv(old_opset); |
127
|
|
|
|
|
|
} |
128
|
|
|
|
|
|
else { |
129
|
736
|
|
|
|
|
opset = newSV(opset_len); |
130
|
736
|
|
|
|
|
Zero(SvPVX_const(opset), opset_len + 1, char); |
131
|
736
|
|
|
|
|
SvCUR_set(opset, opset_len); |
132
|
736
|
|
|
|
|
(void)SvPOK_only(opset); |
133
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
/* not mortalised here */ |
135
|
824
|
|
|
|
|
return opset; |
136
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
139
|
|
|
|
|
|
static int |
140
|
12836
|
|
|
|
|
verify_opset(pTHX_ SV *opset, int fatal) |
141
|
|
|
|
|
|
{ |
142
|
|
|
|
|
|
const char *err = NULL; |
143
|
|
|
|
|
|
dMY_CXT; |
144
|
|
|
|
|
|
|
145
|
12836
|
|
|
|
|
if (!SvOK(opset)) err = "undefined"; |
146
|
12836
|
|
|
|
|
else if (!SvPOK(opset)) err = "wrong type"; |
147
|
12834
|
|
|
|
|
else if (SvCUR(opset) != (STRLEN)opset_len) err = "wrong size"; |
148
|
12836
|
|
|
|
|
if (err && fatal) { |
149
|
0
|
|
|
|
|
croak("Invalid opset: %s", err); |
150
|
|
|
|
|
|
} |
151
|
12836
|
|
|
|
|
return !err; |
152
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
155
|
|
|
|
|
|
static void |
156
|
11946
|
|
|
|
|
set_opset_bits(pTHX_ char *bitmap, SV *bitspec, int on, const char *opname) |
157
|
|
|
|
|
|
{ |
158
|
|
|
|
|
|
dMY_CXT; |
159
|
|
|
|
|
|
|
160
|
11946
|
|
|
|
|
if (SvIOK(bitspec)) { |
161
|
11638
|
|
|
|
|
const int myopcode = SvIV(bitspec); |
162
|
11638
|
|
|
|
|
const int offset = myopcode >> 3; |
163
|
11638
|
|
|
|
|
const int bit = myopcode & 0x07; |
164
|
11638
|
|
|
|
|
if (myopcode >= PL_maxo || myopcode < 0) |
165
|
0
|
|
|
|
|
croak("panic: opcode \"%s\" value %d is invalid", opname, myopcode); |
166
|
11638
|
|
|
|
|
if (opcode_debug >= 2) |
167
|
0
|
|
|
|
|
warn("set_opset_bits bit %2d (off=%d, bit=%d) %s %s\n", |
168
|
|
|
|
|
|
myopcode, offset, bit, opname, (on)?"on":"off"); |
169
|
11638
|
|
|
|
|
if (on) |
170
|
11636
|
|
|
|
|
bitmap[offset] |= 1 << bit; |
171
|
|
|
|
|
|
else |
172
|
2
|
|
|
|
|
bitmap[offset] &= ~(1 << bit); |
173
|
|
|
|
|
|
} |
174
|
308
|
|
|
|
|
else if (SvPOK(bitspec) && SvCUR(bitspec) == (STRLEN)opset_len) { |
175
|
|
|
|
|
|
|
176
|
|
|
|
|
|
STRLEN len; |
177
|
308
|
|
|
|
|
const char * const specbits = SvPV(bitspec, len); |
178
|
308
|
|
|
|
|
if (opcode_debug >= 2) |
179
|
0
|
|
|
|
|
warn("set_opset_bits opset %s %s\n", opname, (on)?"on":"off"); |
180
|
308
|
|
|
|
|
if (on) |
181
|
14784
|
|
|
|
|
while(len-- > 0) bitmap[len] |= specbits[len]; |
182
|
|
|
|
|
|
else |
183
|
0
|
|
|
|
|
while(len-- > 0) bitmap[len] &= ~specbits[len]; |
184
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
else |
186
|
0
|
|
|
|
|
croak("panic: invalid bitspec for \"%s\" (type %u)", |
187
|
0
|
|
|
|
|
opname, (unsigned)SvTYPE(bitspec)); |
188
|
11946
|
|
|
|
|
} |
189
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
191
|
|
|
|
|
|
static void |
192
|
116
|
|
|
|
|
opmask_add(pTHX_ SV *opset) /* THE ONLY FUNCTION TO EDIT PL_op_mask ITSELF */ |
193
|
|
|
|
|
|
{ |
194
|
|
|
|
|
|
int i,j; |
195
|
|
|
|
|
|
char *bitmask; |
196
|
|
|
|
|
|
STRLEN len; |
197
|
|
|
|
|
|
int myopcode = 0; |
198
|
|
|
|
|
|
dMY_CXT; |
199
|
|
|
|
|
|
|
200
|
116
|
|
|
|
|
verify_opset(aTHX_ opset,1); /* croaks on bad opset */ |
201
|
|
|
|
|
|
|
202
|
116
|
|
|
|
|
if (!PL_op_mask) /* caller must ensure PL_op_mask exists */ |
203
|
0
|
|
|
|
|
croak("Can't add to uninitialised PL_op_mask"); |
204
|
|
|
|
|
|
|
205
|
|
|
|
|
|
/* OPCODES ALREADY MASKED ARE NEVER UNMASKED. See opmask_addlocal() */ |
206
|
|
|
|
|
|
|
207
|
116
|
|
|
|
|
bitmask = SvPV(opset, len); |
208
|
5684
|
|
|
|
|
for (i=0; i < opset_len; i++) { |
209
|
5568
|
|
|
|
|
const U16 bits = bitmask[i]; |
210
|
5568
|
|
|
|
|
if (!bits) { /* optimise for sparse masks */ |
211
|
2316
|
|
|
|
|
myopcode += 8; |
212
|
2316
|
|
|
|
|
continue; |
213
|
|
|
|
|
|
} |
214
|
29268
|
|
|
|
|
for (j=0; j < 8 && myopcode < PL_maxo; ) |
215
|
26016
|
|
|
|
|
PL_op_mask[myopcode++] |= bits & (1 << j++); |
216
|
|
|
|
|
|
} |
217
|
116
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
219
|
|
|
|
|
|
static void |
220
|
|
|
|
|
|
opmask_addlocal(pTHX_ SV *opset, char *op_mask_buf) /* Localise PL_op_mask then opmask_add() */ |
221
|
|
|
|
|
|
{ |
222
|
110
|
|
|
|
|
char *orig_op_mask = PL_op_mask; |
223
|
|
|
|
|
|
dMY_CXT; |
224
|
|
|
|
|
|
|
225
|
110
|
|
|
|
|
SAVEVPTR(PL_op_mask); |
226
|
|
|
|
|
|
/* XXX casting to an ordinary function ptr from a member function ptr |
227
|
|
|
|
|
|
* is disallowed by Borland |
228
|
|
|
|
|
|
*/ |
229
|
110
|
|
|
|
|
if (opcode_debug >= 2) |
230
|
0
|
|
|
|
|
SAVEDESTRUCTOR((void(*)(void*))Perl_warn,"PL_op_mask restored"); |
231
|
110
|
|
|
|
|
PL_op_mask = &op_mask_buf[0]; |
232
|
110
|
|
|
|
|
if (orig_op_mask) |
233
|
0
|
|
|
|
|
Copy(orig_op_mask, PL_op_mask, PL_maxo, char); |
234
|
|
|
|
|
|
else |
235
|
110
|
|
|
|
|
Zero(PL_op_mask, PL_maxo, char); |
236
|
110
|
|
|
|
|
opmask_add(aTHX_ opset); |
237
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
241
|
|
|
|
|
|
MODULE = Opcode PACKAGE = Opcode |
242
|
|
|
|
|
|
|
243
|
|
|
|
|
|
PROTOTYPES: ENABLE |
244
|
|
|
|
|
|
|
245
|
|
|
|
|
|
BOOT: |
246
|
|
|
|
|
|
{ |
247
|
|
|
|
|
|
MY_CXT_INIT; |
248
|
|
|
|
|
|
assert(PL_maxo < OP_MASK_BUF_SIZE); |
249
|
30
|
|
|
|
|
opset_len = (PL_maxo + 7) / 8; |
250
|
30
|
|
|
|
|
if (opcode_debug >= 1) |
251
|
0
|
|
|
|
|
warn("opset_len %ld\n", (long)opset_len); |
252
|
30
|
|
|
|
|
op_names_init(aTHX); |
253
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
255
|
|
|
|
|
|
void |
256
|
|
|
|
|
|
_safe_pkg_prep(Package) |
257
|
|
|
|
|
|
SV *Package |
258
|
|
|
|
|
|
PPCODE: |
259
|
|
|
|
|
|
HV *hv; |
260
|
44
|
|
|
|
|
ENTER; |
261
|
|
|
|
|
|
|
262
|
44
|
|
|
|
|
hv = gv_stashsv(Package, GV_ADDWARN); /* should exist already */ |
263
|
|
|
|
|
|
|
264
|
44
|
|
|
|
|
if (strNE(HvNAME_get(hv),"main")) { |
265
|
|
|
|
|
|
/* make it think it's in main:: */ |
266
|
44
|
|
|
|
|
hv_name_set(hv, "main", 4, 0); |
267
|
44
|
|
|
|
|
(void) hv_store(hv,"_",1,(SV *)PL_defgv,0); /* connect _ to global */ |
268
|
44
|
|
|
|
|
SvREFCNT_inc((SV *)PL_defgv); /* want to keep _ around! */ |
269
|
|
|
|
|
|
} |
270
|
44
|
|
|
|
|
LEAVE; |
271
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
274
|
|
|
|
|
|
|
275
|
|
|
|
|
|
|
276
|
|
|
|
|
|
void |
277
|
|
|
|
|
|
_safe_call_sv(Package, mask, codesv) |
278
|
|
|
|
|
|
SV * Package |
279
|
|
|
|
|
|
SV * mask |
280
|
|
|
|
|
|
SV * codesv |
281
|
|
|
|
|
|
PPCODE: |
282
|
|
|
|
|
|
char op_mask_buf[OP_MASK_BUF_SIZE]; |
283
|
|
|
|
|
|
GV *gv; |
284
|
|
|
|
|
|
HV *dummy_hv; |
285
|
|
|
|
|
|
|
286
|
110
|
|
|
|
|
ENTER; |
287
|
|
|
|
|
|
|
288
|
|
|
|
|
|
opmask_addlocal(aTHX_ mask, op_mask_buf); |
289
|
|
|
|
|
|
|
290
|
110
|
|
|
|
|
save_aptr(&PL_endav); |
291
|
110
|
|
|
|
|
PL_endav = (AV*)sv_2mortal((SV*)newAV()); /* ignore END blocks for now */ |
292
|
|
|
|
|
|
|
293
|
110
|
|
|
|
|
save_hptr(&PL_defstash); /* save current default stash */ |
294
|
|
|
|
|
|
/* the assignment to global defstash changes our sense of 'main' */ |
295
|
110
|
|
|
|
|
PL_defstash = gv_stashsv(Package, GV_ADDWARN); /* should exist already */ |
296
|
|
|
|
|
|
|
297
|
110
|
|
|
|
|
SAVEGENERICSV(PL_curstash); |
298
|
220
|
|
|
|
|
PL_curstash = (HV *)SvREFCNT_inc_simple(PL_defstash); |
299
|
|
|
|
|
|
|
300
|
|
|
|
|
|
/* defstash must itself contain a main:: so we'll add that now */ |
301
|
|
|
|
|
|
/* take care with the ref counts (was cause of long standing bug) */ |
302
|
|
|
|
|
|
/* XXX I'm still not sure if this is right, GV_ADDWARN should warn! */ |
303
|
110
|
|
|
|
|
gv = gv_fetchpvs("main::", GV_ADDWARN, SVt_PVHV); |
304
|
110
|
|
|
|
|
sv_free((SV*)GvHV(gv)); |
305
|
220
|
|
|
|
|
GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash); |
306
|
|
|
|
|
|
|
307
|
|
|
|
|
|
/* %INC must be clean for use/require in compartment */ |
308
|
110
|
|
|
|
|
dummy_hv = save_hash(PL_incgv); |
309
|
220
|
|
|
|
|
GvHV(PL_incgv) = (HV*)SvREFCNT_inc(GvHV(gv_HVadd(gv_fetchpvs("INC",GV_ADD,SVt_PVHV)))); |
310
|
|
|
|
|
|
|
311
|
|
|
|
|
|
/* Invalidate ISA and method caches */ |
312
|
110
|
|
|
|
|
++PL_sub_generation; |
313
|
110
|
|
|
|
|
hv_clear(PL_stashcache); |
314
|
|
|
|
|
|
|
315
|
110
|
|
|
|
|
PUSHMARK(SP); |
316
|
110
|
|
|
|
|
perl_call_sv(codesv, GIMME|G_EVAL|G_KEEPERR); /* use callers context */ |
317
|
110
|
|
|
|
|
sv_free( (SV *) dummy_hv); /* get rid of what save_hash gave us*/ |
318
|
110
|
|
|
|
|
SPAGAIN; /* for the PUTBACK added by xsubpp */ |
319
|
110
|
|
|
|
|
LEAVE; |
320
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
322
|
|
|
|
|
|
int |
323
|
|
|
|
|
|
verify_opset(opset, fatal = 0) |
324
|
|
|
|
|
|
SV *opset |
325
|
|
|
|
|
|
int fatal |
326
|
|
|
|
|
|
CODE: |
327
|
4
|
|
|
|
|
RETVAL = verify_opset(aTHX_ opset,fatal); |
328
|
|
|
|
|
|
OUTPUT: |
329
|
|
|
|
|
|
RETVAL |
330
|
|
|
|
|
|
|
331
|
|
|
|
|
|
void |
332
|
|
|
|
|
|
invert_opset(opset) |
333
|
|
|
|
|
|
SV *opset |
334
|
|
|
|
|
|
CODE: |
335
|
|
|
|
|
|
{ |
336
|
|
|
|
|
|
char *bitmap; |
337
|
|
|
|
|
|
dMY_CXT; |
338
|
56
|
|
|
|
|
STRLEN len = opset_len; |
339
|
|
|
|
|
|
|
340
|
56
|
|
|
|
|
opset = sv_2mortal(new_opset(aTHX_ opset)); /* verify and clone opset */ |
341
|
56
|
|
|
|
|
bitmap = SvPVX(opset); |
342
|
2800
|
|
|
|
|
while(len-- > 0) |
343
|
2688
|
|
|
|
|
bitmap[len] = ~bitmap[len]; |
344
|
|
|
|
|
|
/* take care of extra bits beyond PL_maxo in last byte */ |
345
|
56
|
|
|
|
|
if (PL_maxo & 07) |
346
|
56
|
|
|
|
|
bitmap[opset_len-1] &= ~(0xFF << (PL_maxo & 0x07)); |
347
|
|
|
|
|
|
} |
348
|
56
|
|
|
|
|
ST(0) = opset; |
349
|
|
|
|
|
|
|
350
|
|
|
|
|
|
|
351
|
|
|
|
|
|
void |
352
|
|
|
|
|
|
opset_to_ops(opset, desc = 0) |
353
|
|
|
|
|
|
SV *opset |
354
|
|
|
|
|
|
int desc |
355
|
|
|
|
|
|
PPCODE: |
356
|
|
|
|
|
|
{ |
357
|
|
|
|
|
|
STRLEN len; |
358
|
|
|
|
|
|
int i, j, myopcode; |
359
|
46
|
|
|
|
|
const char * const bitmap = SvPV(opset, len); |
360
|
46
|
|
|
|
|
char **names = (desc) ? get_op_descs() : get_op_names(); |
361
|
|
|
|
|
|
dMY_CXT; |
362
|
|
|
|
|
|
|
363
|
46
|
|
|
|
|
verify_opset(aTHX_ opset,1); |
364
|
2254
|
|
|
|
|
for (myopcode=0, i=0; i < opset_len; i++) { |
365
|
2208
|
|
|
|
|
const U16 bits = bitmap[i]; |
366
|
19550
|
|
|
|
|
for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++) { |
367
|
17342
|
|
|
|
|
if ( bits & (1 << j) ) |
368
|
15342
|
|
|
|
|
XPUSHs(newSVpvn_flags(names[myopcode], strlen(names[myopcode]), |
369
|
|
|
|
|
|
SVs_TEMP)); |
370
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
375
|
|
|
|
|
|
void |
376
|
|
|
|
|
|
opset(...) |
377
|
|
|
|
|
|
CODE: |
378
|
|
|
|
|
|
int i; |
379
|
|
|
|
|
|
SV *bitspec; |
380
|
|
|
|
|
|
STRLEN len, on; |
381
|
|
|
|
|
|
|
382
|
668
|
|
|
|
|
SV * const opset = sv_2mortal(new_opset(aTHX_ Nullsv)); |
383
|
668
|
|
|
|
|
char * const bitmap = SvPVX(opset); |
384
|
12614
|
|
|
|
|
for (i = 0; i < items; i++) { |
385
|
|
|
|
|
|
const char *opname; |
386
|
|
|
|
|
|
on = 1; |
387
|
23900
|
|
|
|
|
if (verify_opset(aTHX_ ST(i),0)) { |
388
|
|
|
|
|
|
opname = "(opset)"; |
389
|
10
|
|
|
|
|
bitspec = ST(i); |
390
|
|
|
|
|
|
} |
391
|
|
|
|
|
|
else { |
392
|
11940
|
|
|
|
|
opname = SvPV(ST(i), len); |
393
|
11940
|
|
|
|
|
if (*opname == '!') { on=0; ++opname;--len; } |
394
|
11940
|
|
|
|
|
bitspec = get_op_bitspec(aTHX_ opname, len, 1); |
395
|
|
|
|
|
|
} |
396
|
11946
|
|
|
|
|
set_opset_bits(aTHX_ bitmap, bitspec, on, opname); |
397
|
|
|
|
|
|
} |
398
|
664
|
|
|
|
|
ST(0) = opset; |
399
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
401
|
|
|
|
|
|
#define PERMITING (ix == 0 || ix == 1) |
402
|
|
|
|
|
|
#define ONLY_THESE (ix == 0 || ix == 2) |
403
|
|
|
|
|
|
|
404
|
|
|
|
|
|
void |
405
|
|
|
|
|
|
permit_only(safe, ...) |
406
|
|
|
|
|
|
SV *safe |
407
|
|
|
|
|
|
ALIAS: |
408
|
|
|
|
|
|
permit = 1 |
409
|
|
|
|
|
|
deny_only = 2 |
410
|
|
|
|
|
|
deny = 3 |
411
|
|
|
|
|
|
CODE: |
412
|
|
|
|
|
|
int i; |
413
|
|
|
|
|
|
SV *bitspec, *mask; |
414
|
|
|
|
|
|
char *bitmap; |
415
|
|
|
|
|
|
STRLEN len; |
416
|
|
|
|
|
|
dMY_CXT; |
417
|
|
|
|
|
|
|
418
|
0
|
|
|
|
|
if (!SvROK(safe) || !SvOBJECT(SvRV(safe)) || SvTYPE(SvRV(safe))!=SVt_PVHV) |
419
|
0
|
|
|
|
|
croak("Not a Safe object"); |
420
|
0
|
|
|
|
|
mask = *hv_fetch((HV*)SvRV(safe), "Mask",4, 1); |
421
|
0
|
|
|
|
|
if (ONLY_THESE) /* *_only = new mask, else edit current */ |
422
|
0
|
|
|
|
|
sv_setsv(mask, sv_2mortal(new_opset(aTHX_ PERMITING ? opset_all : Nullsv))); |
423
|
|
|
|
|
|
else |
424
|
0
|
|
|
|
|
verify_opset(aTHX_ mask,1); /* croaks */ |
425
|
0
|
|
|
|
|
bitmap = SvPVX(mask); |
426
|
0
|
|
|
|
|
for (i = 1; i < items; i++) { |
427
|
|
|
|
|
|
const char *opname; |
428
|
0
|
|
|
|
|
int on = PERMITING ? 0 : 1; /* deny = mask bit on */ |
429
|
0
|
|
|
|
|
if (verify_opset(aTHX_ ST(i),0)) { /* it's a valid mask */ |
430
|
|
|
|
|
|
opname = "(opset)"; |
431
|
0
|
|
|
|
|
bitspec = ST(i); |
432
|
|
|
|
|
|
} |
433
|
|
|
|
|
|
else { /* it's an opname/optag */ |
434
|
0
|
|
|
|
|
opname = SvPV(ST(i), len); |
435
|
|
|
|
|
|
/* invert if op has ! prefix (only one allowed) */ |
436
|
0
|
|
|
|
|
if (*opname == '!') { on = !on; ++opname; --len; } |
437
|
0
|
|
|
|
|
bitspec = get_op_bitspec(aTHX_ opname, len, 1); /* croaks */ |
438
|
|
|
|
|
|
} |
439
|
0
|
|
|
|
|
set_opset_bits(aTHX_ bitmap, bitspec, on, opname); |
440
|
|
|
|
|
|
} |
441
|
0
|
|
|
|
|
ST(0) = &PL_sv_yes; |
442
|
|
|
|
|
|
|
443
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
445
|
|
|
|
|
|
void |
446
|
|
|
|
|
|
opdesc(...) |
447
|
|
|
|
|
|
PPCODE: |
448
|
|
|
|
|
|
int i; |
449
|
|
|
|
|
|
STRLEN len; |
450
|
|
|
|
|
|
SV **args; |
451
|
4
|
|
|
|
|
char **op_desc = get_op_descs(); |
452
|
|
|
|
|
|
dMY_CXT; |
453
|
|
|
|
|
|
|
454
|
|
|
|
|
|
/* copy args to a scratch area since we may push output values onto */ |
455
|
|
|
|
|
|
/* the stack faster than we read values off it if masks are used. */ |
456
|
4
|
|
|
|
|
args = (SV**)SvPVX(newSVpvn_flags((char*)&ST(0), items*sizeof(SV*), SVs_TEMP)); |
457
|
10
|
|
|
|
|
for (i = 0; i < items; i++) { |
458
|
6
|
|
|
|
|
const char * const opname = SvPV(args[i], len); |
459
|
6
|
|
|
|
|
SV *bitspec = get_op_bitspec(aTHX_ opname, len, 1); |
460
|
6
|
|
|
|
|
if (SvIOK(bitspec)) { |
461
|
4
|
|
|
|
|
const int myopcode = SvIV(bitspec); |
462
|
4
|
|
|
|
|
if (myopcode < 0 || myopcode >= PL_maxo) |
463
|
0
|
|
|
|
|
croak("panic: opcode %d (%s) out of range",myopcode,opname); |
464
|
4
|
|
|
|
|
XPUSHs(newSVpvn_flags(op_desc[myopcode], strlen(op_desc[myopcode]), |
465
|
|
|
|
|
|
SVs_TEMP)); |
466
|
|
|
|
|
|
} |
467
|
2
|
|
|
|
|
else if (SvPOK(bitspec) && SvCUR(bitspec) == (STRLEN)opset_len) { |
468
|
|
|
|
|
|
int b, j; |
469
|
2
|
|
|
|
|
const char * const bitmap = SvPV_nolen_const(bitspec); |
470
|
|
|
|
|
|
int myopcode = 0; |
471
|
98
|
|
|
|
|
for (b=0; b < opset_len; b++) { |
472
|
96
|
|
|
|
|
const U16 bits = bitmap[b]; |
473
|
850
|
|
|
|
|
for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++) |
474
|
754
|
|
|
|
|
if (bits & (1 << j)) |
475
|
6
|
|
|
|
|
XPUSHs(newSVpvn_flags(op_desc[myopcode], |
476
|
|
|
|
|
|
strlen(op_desc[myopcode]), |
477
|
|
|
|
|
|
SVs_TEMP)); |
478
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
} |
480
|
|
|
|
|
|
else |
481
|
0
|
|
|
|
|
croak("panic: invalid bitspec for \"%s\" (type %u)", |
482
|
0
|
|
|
|
|
opname, (unsigned)SvTYPE(bitspec)); |
483
|
|
|
|
|
|
} |
484
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
486
|
|
|
|
|
|
void |
487
|
|
|
|
|
|
define_optag(optagsv, mask) |
488
|
|
|
|
|
|
SV *optagsv |
489
|
|
|
|
|
|
SV *mask |
490
|
|
|
|
|
|
CODE: |
491
|
|
|
|
|
|
STRLEN len; |
492
|
572
|
|
|
|
|
const char *optag = SvPV(optagsv, len); |
493
|
|
|
|
|
|
|
494
|
572
|
|
|
|
|
put_op_bitspec(aTHX_ optag, len, mask); /* croaks */ |
495
|
572
|
|
|
|
|
ST(0) = &PL_sv_yes; |
496
|
|
|
|
|
|
|
497
|
|
|
|
|
|
|
498
|
|
|
|
|
|
void |
499
|
|
|
|
|
|
empty_opset() |
500
|
|
|
|
|
|
CODE: |
501
|
4
|
|
|
|
|
ST(0) = sv_2mortal(new_opset(aTHX_ Nullsv)); |
502
|
|
|
|
|
|
|
503
|
|
|
|
|
|
void |
504
|
|
|
|
|
|
full_opset() |
505
|
|
|
|
|
|
CODE: |
506
|
|
|
|
|
|
dMY_CXT; |
507
|
32
|
|
|
|
|
ST(0) = sv_2mortal(new_opset(aTHX_ opset_all)); |
508
|
|
|
|
|
|
|
509
|
|
|
|
|
|
void |
510
|
|
|
|
|
|
opmask_add(opset) |
511
|
|
|
|
|
|
SV *opset |
512
|
|
|
|
|
|
PREINIT: |
513
|
6
|
|
|
|
|
if (!PL_op_mask) |
514
|
4
|
|
|
|
|
Newxz(PL_op_mask, PL_maxo, char); |
515
|
|
|
|
|
|
CODE: |
516
|
6
|
|
|
|
|
opmask_add(aTHX_ opset); |
517
|
|
|
|
|
|
|
518
|
|
|
|
|
|
void |
519
|
|
|
|
|
|
opcodes() |
520
|
|
|
|
|
|
PPCODE: |
521
|
12
|
|
|
|
|
if (GIMME == G_ARRAY) { |
522
|
2
|
|
|
|
|
croak("opcodes in list context not yet implemented"); /* XXX */ |
523
|
|
|
|
|
|
} |
524
|
|
|
|
|
|
else { |
525
|
10
|
|
|
|
|
XPUSHs(sv_2mortal(newSViv(PL_maxo))); |
526
|
|
|
|
|
|
} |
527
|
|
|
|
|
|
|
528
|
|
|
|
|
|
void |
529
|
|
|
|
|
|
opmask() |
530
|
|
|
|
|
|
CODE: |
531
|
4
|
|
|
|
|
ST(0) = sv_2mortal(new_opset(aTHX_ Nullsv)); |
532
|
4
|
|
|
|
|
if (PL_op_mask) { |
533
|
0
|
|
|
|
|
char * const bitmap = SvPVX(ST(0)); |
534
|
|
|
|
|
|
int myopcode; |
535
|
0
|
|
|
|
|
for(myopcode=0; myopcode < PL_maxo; ++myopcode) { |
536
|
0
|
|
|
|
|
if (PL_op_mask[myopcode]) |
537
|
0
|
|
|
|
|
bitmap[myopcode >> 3] |= 1 << (myopcode & 0x07); |
538
|
|
|
|
|
|
} |
539
|
|
|
|
|
|
} |
540
|
|
|
|
|
|
|