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