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