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 */ | |
b5134c56 | 15 | #ifdef OPCODE_DEBUG |
c5abc2c9 DD |
16 | int x_opcode_debug; /* unused warn() emitting debugging code */ |
17 | #endif | |
89ca4ac7 JH |
18 | } my_cxt_t; |
19 | ||
20 | START_MY_CXT | |
21 | ||
e6567a72 NC |
22 | /* length of opmasks in bytes */ |
23 | static const STRLEN opset_len = (PL_maxo + 7) / 8; | |
24 | ||
89ca4ac7 JH |
25 | #define op_named_bits (MY_CXT.x_op_named_bits) |
26 | #define opset_all (MY_CXT.x_opset_all) | |
b5134c56 | 27 | #ifdef OPCODE_DEBUG |
c5abc2c9 DD |
28 | # define opcode_debug (MY_CXT.x_opcode_debug) |
29 | #else | |
30 | /* no API to turn this on at runtime, so constant fold the code away */ | |
31 | # define opcode_debug 0 | |
32 | #endif | |
6badd1a5 | 33 | |
cea2e8a9 GS |
34 | static SV *new_opset (pTHX_ SV *old_opset); |
35 | static int verify_opset (pTHX_ SV *opset, int fatal); | |
5d7488b2 AL |
36 | static void set_opset_bits (pTHX_ char *bitmap, SV *bitspec, int on, const char *opname); |
37 | static void put_op_bitspec (pTHX_ const char *optag, STRLEN len, SV *opset); | |
38 | static SV *get_op_bitspec (pTHX_ const char *opname, STRLEN len, int fatal); | |
6badd1a5 | 39 | |
40 | ||
41 | /* Initialise our private op_named_bits HV. | |
42 | * It is first loaded with the name and number of each perl operator. | |
43 | * Then the builtin tags :none and :all are added. | |
44 | * Opcode.pm loads the standard optags from __DATA__ | |
4d8e9581 GS |
45 | * XXX leak-alert: data allocated here is never freed, call this |
46 | * at most once | |
6badd1a5 | 47 | */ |
48 | ||
49 | static void | |
cea2e8a9 | 50 | op_names_init(pTHX) |
6badd1a5 | 51 | { |
52 | int i; | |
53 | STRLEN len; | |
a2440b84 | 54 | const char *const *op_names; |
8432384f | 55 | U8 *bitmap; |
89ca4ac7 | 56 | dMY_CXT; |
6badd1a5 | 57 | |
58 | op_named_bits = newHV(); | |
25c7a49a | 59 | hv_ksplit(op_named_bits, PL_maxo); |
a2440b84 | 60 | op_names = PL_op_name; |
3280af22 | 61 | for(i=0; i < PL_maxo; ++i) { |
5d7488b2 | 62 | SV * const sv = newSViv(i); |
e858de61 | 63 | SvREADONLY_on(sv); |
c33e8be1 | 64 | (void) hv_store(op_named_bits, op_names[i], strlen(op_names[i]), sv, 0); |
6badd1a5 | 65 | } |
66 | ||
e7c4ace0 | 67 | put_op_bitspec(aTHX_ STR_WITH_LEN(":none"), sv_2mortal(new_opset(aTHX_ Nullsv))); |
6badd1a5 | 68 | |
cea2e8a9 | 69 | opset_all = new_opset(aTHX_ Nullsv); |
8432384f | 70 | bitmap = (U8*)SvPV(opset_all, len); |
e7c4ace0 | 71 | memset(bitmap, 0xFF, len-1); /* deal with last byte specially, see below */ |
6badd1a5 | 72 | /* Take care to set the right number of bits in the last byte */ |
0c10ec51 | 73 | bitmap[len-1] = (PL_maxo & 0x07) ? ((U8) (~(0xFF << (PL_maxo & 0x07)))) |
8432384f | 74 | : 0xFF; |
e7c4ace0 | 75 | put_op_bitspec(aTHX_ STR_WITH_LEN(":all"), opset_all); /* don't mortalise */ |
6badd1a5 | 76 | } |
77 | ||
78 | ||
79 | /* Store a new tag definition. Always a mask. | |
80 | * The tag must not already be defined. | |
81 | * SV *mask is copied not referenced. | |
82 | */ | |
83 | ||
84 | static void | |
5d7488b2 | 85 | put_op_bitspec(pTHX_ const char *optag, STRLEN len, SV *mask) |
6badd1a5 | 86 | { |
87 | SV **svp; | |
89ca4ac7 JH |
88 | dMY_CXT; |
89 | ||
cea2e8a9 | 90 | verify_opset(aTHX_ mask,1); |
6badd1a5 | 91 | svp = hv_fetch(op_named_bits, optag, len, 1); |
92 | if (SvOK(*svp)) | |
93 | croak("Opcode tag \"%s\" already defined", optag); | |
94 | sv_setsv(*svp, mask); | |
95 | SvREADONLY_on(*svp); | |
96 | } | |
97 | ||
98 | ||
99 | ||
100 | /* Fetch a 'bits' entry for an opname or optag (IV/PV). | |
101 | * Note that we return the actual entry for speed. | |
b7b1e41b | 102 | * Always sv_mortalcopy() if returning it to user code. |
6badd1a5 | 103 | */ |
104 | ||
105 | static SV * | |
5d7488b2 | 106 | get_op_bitspec(pTHX_ const char *opname, STRLEN len, int fatal) |
6badd1a5 | 107 | { |
108 | SV **svp; | |
89ca4ac7 JH |
109 | dMY_CXT; |
110 | ||
6badd1a5 | 111 | svp = hv_fetch(op_named_bits, opname, len, 0); |
112 | if (!svp || !SvOK(*svp)) { | |
113 | if (!fatal) | |
114 | return Nullsv; | |
115 | if (*opname == ':') | |
116 | croak("Unknown operator tag \"%s\"", opname); | |
117 | if (*opname == '!') /* XXX here later, or elsewhere? */ | |
118 | croak("Can't negate operators here (\"%s\")", opname); | |
119 | if (isALPHA(*opname)) | |
120 | croak("Unknown operator name \"%s\"", opname); | |
121 | croak("Unknown operator prefix \"%s\"", opname); | |
122 | } | |
123 | return *svp; | |
124 | } | |
125 | ||
126 | ||
127 | ||
128 | static SV * | |
cea2e8a9 | 129 | new_opset(pTHX_ SV *old_opset) |
6badd1a5 | 130 | { |
131 | SV *opset; | |
89ca4ac7 | 132 | |
6badd1a5 | 133 | if (old_opset) { |
cea2e8a9 | 134 | verify_opset(aTHX_ old_opset,1); |
6badd1a5 | 135 | opset = newSVsv(old_opset); |
136 | } | |
137 | else { | |
561b68a9 | 138 | opset = newSV(opset_len); |
aa07b2f6 | 139 | Zero(SvPVX_const(opset), opset_len + 1, char); |
6badd1a5 | 140 | SvCUR_set(opset, opset_len); |
141 | (void)SvPOK_only(opset); | |
142 | } | |
143 | /* not mortalised here */ | |
144 | return opset; | |
145 | } | |
146 | ||
147 | ||
148 | static int | |
cea2e8a9 | 149 | verify_opset(pTHX_ SV *opset, int fatal) |
6badd1a5 | 150 | { |
9849c14c | 151 | const char *err = NULL; |
89ca4ac7 | 152 | |
6badd1a5 | 153 | if (!SvOK(opset)) err = "undefined"; |
154 | else if (!SvPOK(opset)) err = "wrong type"; | |
e6567a72 | 155 | else if (SvCUR(opset) != opset_len) err = "wrong size"; |
6badd1a5 | 156 | if (err && fatal) { |
157 | croak("Invalid opset: %s", err); | |
158 | } | |
159 | return !err; | |
160 | } | |
161 | ||
162 | ||
163 | static void | |
5d7488b2 | 164 | set_opset_bits(pTHX_ char *bitmap, SV *bitspec, int on, const char *opname) |
6badd1a5 | 165 | { |
166 | if (SvIOK(bitspec)) { | |
5d7488b2 AL |
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 | } | |
e6567a72 | 180 | else if (SvPOK(bitspec) && SvCUR(bitspec) == 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 | { |
e6567a72 | 200 | int j; |
6badd1a5 | 201 | char *bitmask; |
202 | STRLEN len; | |
203 | int myopcode = 0; | |
204 | ||
cea2e8a9 | 205 | verify_opset(aTHX_ opset,1); /* croaks on bad opset */ |
6badd1a5 | 206 | |
3280af22 NIS |
207 | if (!PL_op_mask) /* caller must ensure PL_op_mask exists */ |
208 | croak("Can't add to uninitialised PL_op_mask"); | |
6badd1a5 | 209 | |
210 | /* OPCODES ALREADY MASKED ARE NEVER UNMASKED. See opmask_addlocal() */ | |
211 | ||
212 | bitmask = SvPV(opset, len); | |
e6567a72 | 213 | for (STRLEN i=0; i < opset_len; i++) { |
5d7488b2 | 214 | const U16 bits = bitmask[i]; |
6badd1a5 | 215 | if (!bits) { /* optimise for sparse masks */ |
216 | myopcode += 8; | |
217 | continue; | |
218 | } | |
3280af22 NIS |
219 | for (j=0; j < 8 && myopcode < PL_maxo; ) |
220 | PL_op_mask[myopcode++] |= bits & (1 << j++); | |
6badd1a5 | 221 | } |
222 | } | |
223 | ||
224 | static void | |
cea2e8a9 | 225 | opmask_addlocal(pTHX_ SV *opset, char *op_mask_buf) /* Localise PL_op_mask then opmask_add() */ |
6badd1a5 | 226 | { |
3280af22 | 227 | char *orig_op_mask = PL_op_mask; |
b5134c56 | 228 | #ifdef OPCODE_DEBUG |
89ca4ac7 | 229 | dMY_CXT; |
b5134c56 | 230 | #endif |
89ca4ac7 | 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) |
1380c4f3 DM |
237 | SAVEDESTRUCTOR((void(*)(void*))Perl_warn_nocontext, |
238 | "PL_op_mask restored"); | |
3280af22 | 239 | PL_op_mask = &op_mask_buf[0]; |
6badd1a5 | 240 | if (orig_op_mask) |
3280af22 | 241 | Copy(orig_op_mask, PL_op_mask, PL_maxo, char); |
6badd1a5 | 242 | else |
3280af22 | 243 | Zero(PL_op_mask, PL_maxo, char); |
cea2e8a9 | 244 | opmask_add(aTHX_ opset); |
6badd1a5 | 245 | } |
246 | ||
247 | ||
248 | ||
249 | MODULE = Opcode PACKAGE = Opcode | |
250 | ||
251 | PROTOTYPES: ENABLE | |
252 | ||
253 | BOOT: | |
89ca4ac7 JH |
254 | { |
255 | MY_CXT_INIT; | |
2362b21b | 256 | STATIC_ASSERT_STMT(PL_maxo < OP_MASK_BUF_SIZE); |
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) | |
352e1c09 | 264 | SV *Package |
8c7314f9 JH |
265 | PPCODE: |
266 | HV *hv; | |
e983bd7a | 267 | char *hvname; |
8c7314f9 JH |
268 | ENTER; |
269 | ||
352e1c09 | 270 | hv = gv_stashsv(Package, GV_ADDWARN); /* should exist already */ |
8c7314f9 | 271 | |
e983bd7a DM |
272 | hvname = HvNAME_get(hv); |
273 | if (!hvname || strNE(hvname, "main")) { | |
bfcb3514 | 274 | /* make it think it's in main:: */ |
51a37f80 | 275 | hv_name_set(hv, "main", 4, 0); |
c33e8be1 | 276 | (void) hv_store(hv,"_",1,(SV *)PL_defgv,0); /* connect _ to global */ |
8c7314f9 JH |
277 | SvREFCNT_inc((SV *)PL_defgv); /* want to keep _ around! */ |
278 | } | |
279 | LEAVE; | |
280 | ||
281 | ||
282 | ||
283 | ||
6badd1a5 | 284 | |
285 | void | |
9d8a25dc | 286 | _safe_call_sv(Package, mask, codesv) |
352e1c09 | 287 | SV * Package |
6badd1a5 | 288 | SV * mask |
289 | SV * codesv | |
4d8e9581 | 290 | PPCODE: |
6badd1a5 | 291 | char op_mask_buf[OP_MASK_BUF_SIZE]; |
292 | GV *gv; | |
4adfac04 | 293 | HV *dummy_hv; |
6badd1a5 | 294 | |
295 | ENTER; | |
296 | ||
cea2e8a9 | 297 | opmask_addlocal(aTHX_ mask, op_mask_buf); |
6badd1a5 | 298 | |
3280af22 NIS |
299 | save_aptr(&PL_endav); |
300 | PL_endav = (AV*)sv_2mortal((SV*)newAV()); /* ignore END blocks for now */ | |
6badd1a5 | 301 | |
e5125a24 | 302 | save_hptr(&PL_defstash); /* save current default stash */ |
6badd1a5 | 303 | /* the assignment to global defstash changes our sense of 'main' */ |
352e1c09 | 304 | PL_defstash = gv_stashsv(Package, GV_ADDWARN); /* should exist already */ |
8c7314f9 | 305 | |
03d9f026 FC |
306 | SAVEGENERICSV(PL_curstash); |
307 | PL_curstash = (HV *)SvREFCNT_inc_simple(PL_defstash); | |
6badd1a5 | 308 | |
309 | /* defstash must itself contain a main:: so we'll add that now */ | |
310 | /* take care with the ref counts (was cause of long standing bug) */ | |
311 | /* XXX I'm still not sure if this is right, GV_ADDWARN should warn! */ | |
352e1c09 | 312 | gv = gv_fetchpvs("main::", GV_ADDWARN, SVt_PVHV); |
6badd1a5 | 313 | sv_free((SV*)GvHV(gv)); |
3280af22 | 314 | GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash); |
6badd1a5 | 315 | |
e5125a24 | 316 | /* %INC must be clean for use/require in compartment */ |
4adfac04 | 317 | dummy_hv = save_hash(PL_incgv); |
352e1c09 | 318 | GvHV(PL_incgv) = (HV*)SvREFCNT_inc(GvHV(gv_HVadd(gv_fetchpvs("INC",GV_ADD,SVt_PVHV)))); |
e5125a24 | 319 | |
23c3e71c | 320 | /* Invalidate class and method caches */ |
4eb3f1b8 RGS |
321 | ++PL_sub_generation; |
322 | hv_clear(PL_stashcache); | |
323 | ||
924508f0 | 324 | PUSHMARK(SP); |
2e4af4cf FC |
325 | /* use caller’s context */ |
326 | perl_call_sv(codesv, GIMME_V|G_EVAL|G_KEEPERR); | |
57481f5a | 327 | sv_free( (SV *) dummy_hv); /* get rid of what save_hash gave us*/ |
6badd1a5 | 328 | SPAGAIN; /* for the PUTBACK added by xsubpp */ |
329 | LEAVE; | |
330 | ||
23c3e71c | 331 | /* Invalidate again */ |
332 | ++PL_sub_generation; | |
333 | hv_clear(PL_stashcache); | |
334 | ||
6badd1a5 | 335 | |
336 | int | |
337 | verify_opset(opset, fatal = 0) | |
338 | SV *opset | |
339 | int fatal | |
cea2e8a9 GS |
340 | CODE: |
341 | RETVAL = verify_opset(aTHX_ opset,fatal); | |
342 | OUTPUT: | |
343 | RETVAL | |
6badd1a5 | 344 | |
345 | void | |
346 | invert_opset(opset) | |
347 | SV *opset | |
4d8e9581 | 348 | CODE: |
6badd1a5 | 349 | { |
350 | char *bitmap; | |
351 | STRLEN len = opset_len; | |
89ca4ac7 | 352 | |
cea2e8a9 | 353 | opset = sv_2mortal(new_opset(aTHX_ opset)); /* verify and clone opset */ |
6badd1a5 | 354 | bitmap = SvPVX(opset); |
355 | while(len-- > 0) | |
356 | bitmap[len] = ~bitmap[len]; | |
3280af22 NIS |
357 | /* take care of extra bits beyond PL_maxo in last byte */ |
358 | if (PL_maxo & 07) | |
95b7e3a3 | 359 | bitmap[opset_len-1] &= ~(char)(0xFF << (PL_maxo & 0x07)); |
6badd1a5 | 360 | } |
361 | ST(0) = opset; | |
362 | ||
363 | ||
364 | void | |
365 | opset_to_ops(opset, desc = 0) | |
366 | SV *opset | |
367 | int desc | |
4d8e9581 | 368 | PPCODE: |
6badd1a5 | 369 | { |
370 | STRLEN len; | |
e6567a72 NC |
371 | STRLEN i; |
372 | int j, myopcode; | |
5d7488b2 | 373 | const char * const bitmap = SvPV(opset, len); |
a2440b84 | 374 | const char *const *names = (desc) ? PL_op_desc : PL_op_name; |
89ca4ac7 | 375 | |
cea2e8a9 | 376 | verify_opset(aTHX_ opset,1); |
6badd1a5 | 377 | for (myopcode=0, i=0; i < opset_len; i++) { |
5d7488b2 | 378 | const U16 bits = bitmap[i]; |
3280af22 | 379 | for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++) { |
6badd1a5 | 380 | if ( bits & (1 << j) ) |
d3d34884 NC |
381 | XPUSHs(newSVpvn_flags(names[myopcode], strlen(names[myopcode]), |
382 | SVs_TEMP)); | |
6badd1a5 | 383 | } |
384 | } | |
385 | } | |
386 | ||
387 | ||
388 | void | |
389 | opset(...) | |
4d8e9581 | 390 | CODE: |
8063af02 | 391 | int i; |
5d7488b2 | 392 | SV *bitspec; |
6badd1a5 | 393 | STRLEN len, on; |
89ca4ac7 | 394 | |
5d7488b2 AL |
395 | SV * const opset = sv_2mortal(new_opset(aTHX_ Nullsv)); |
396 | char * const bitmap = SvPVX(opset); | |
6badd1a5 | 397 | for (i = 0; i < items; i++) { |
5d7488b2 | 398 | const char *opname; |
6badd1a5 | 399 | on = 1; |
cea2e8a9 | 400 | if (verify_opset(aTHX_ ST(i),0)) { |
6badd1a5 | 401 | opname = "(opset)"; |
402 | bitspec = ST(i); | |
403 | } | |
404 | else { | |
405 | opname = SvPV(ST(i), len); | |
406 | if (*opname == '!') { on=0; ++opname;--len; } | |
cea2e8a9 | 407 | bitspec = get_op_bitspec(aTHX_ opname, len, 1); |
6badd1a5 | 408 | } |
cea2e8a9 | 409 | set_opset_bits(aTHX_ bitmap, bitspec, on, opname); |
6badd1a5 | 410 | } |
411 | ST(0) = opset; | |
412 | ||
413 | ||
414 | #define PERMITING (ix == 0 || ix == 1) | |
415 | #define ONLY_THESE (ix == 0 || ix == 2) | |
416 | ||
417 | void | |
418 | permit_only(safe, ...) | |
419 | SV *safe | |
4d8e9581 | 420 | ALIAS: |
6badd1a5 | 421 | permit = 1 |
422 | deny_only = 2 | |
423 | deny = 3 | |
4d8e9581 | 424 | CODE: |
5d7488b2 | 425 | int i; |
6badd1a5 | 426 | SV *bitspec, *mask; |
5d7488b2 | 427 | char *bitmap; |
6badd1a5 | 428 | STRLEN len; |
89ca4ac7 | 429 | dMY_CXT; |
6badd1a5 | 430 | |
431 | if (!SvROK(safe) || !SvOBJECT(SvRV(safe)) || SvTYPE(SvRV(safe))!=SVt_PVHV) | |
432 | croak("Not a Safe object"); | |
07e4dd7a | 433 | mask = *hv_fetchs((HV*)SvRV(safe), "Mask", 1); |
6badd1a5 | 434 | if (ONLY_THESE) /* *_only = new mask, else edit current */ |
cea2e8a9 | 435 | sv_setsv(mask, sv_2mortal(new_opset(aTHX_ PERMITING ? opset_all : Nullsv))); |
4d8e9581 | 436 | else |
cea2e8a9 | 437 | verify_opset(aTHX_ mask,1); /* croaks */ |
6badd1a5 | 438 | bitmap = SvPVX(mask); |
439 | for (i = 1; i < items; i++) { | |
5d7488b2 AL |
440 | const char *opname; |
441 | int on = PERMITING ? 0 : 1; /* deny = mask bit on */ | |
cea2e8a9 | 442 | if (verify_opset(aTHX_ ST(i),0)) { /* it's a valid mask */ |
6badd1a5 | 443 | opname = "(opset)"; |
444 | bitspec = ST(i); | |
445 | } | |
446 | else { /* it's an opname/optag */ | |
447 | opname = SvPV(ST(i), len); | |
448 | /* invert if op has ! prefix (only one allowed) */ | |
449 | if (*opname == '!') { on = !on; ++opname; --len; } | |
cea2e8a9 | 450 | bitspec = get_op_bitspec(aTHX_ opname, len, 1); /* croaks */ |
6badd1a5 | 451 | } |
cea2e8a9 | 452 | set_opset_bits(aTHX_ bitmap, bitspec, on, opname); |
6badd1a5 | 453 | } |
6b88bc9c | 454 | ST(0) = &PL_sv_yes; |
6badd1a5 | 455 | |
456 | ||
457 | ||
458 | void | |
459 | opdesc(...) | |
4d8e9581 | 460 | PPCODE: |
5d7488b2 | 461 | int i; |
6badd1a5 | 462 | STRLEN len; |
463 | SV **args; | |
a2440b84 | 464 | const char *const *op_desc = PL_op_desc; |
89ca4ac7 | 465 | |
6badd1a5 | 466 | /* copy args to a scratch area since we may push output values onto */ |
467 | /* the stack faster than we read values off it if masks are used. */ | |
d3d34884 | 468 | args = (SV**)SvPVX(newSVpvn_flags((char*)&ST(0), items*sizeof(SV*), SVs_TEMP)); |
6badd1a5 | 469 | for (i = 0; i < items; i++) { |
5d7488b2 | 470 | const char * const opname = SvPV(args[i], len); |
cea2e8a9 | 471 | SV *bitspec = get_op_bitspec(aTHX_ opname, len, 1); |
6badd1a5 | 472 | if (SvIOK(bitspec)) { |
5d7488b2 | 473 | const int myopcode = SvIV(bitspec); |
3280af22 | 474 | if (myopcode < 0 || myopcode >= PL_maxo) |
6badd1a5 | 475 | croak("panic: opcode %d (%s) out of range",myopcode,opname); |
d3d34884 NC |
476 | XPUSHs(newSVpvn_flags(op_desc[myopcode], strlen(op_desc[myopcode]), |
477 | SVs_TEMP)); | |
6badd1a5 | 478 | } |
e6567a72 NC |
479 | else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) { |
480 | STRLEN b; | |
481 | int j; | |
2596d9fe | 482 | const char * const bitmap = SvPV_nolen_const(bitspec); |
5d7488b2 | 483 | int myopcode = 0; |
6badd1a5 | 484 | for (b=0; b < opset_len; b++) { |
5d7488b2 | 485 | const U16 bits = bitmap[b]; |
3280af22 | 486 | for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++) |
6badd1a5 | 487 | if (bits & (1 << j)) |
d3d34884 NC |
488 | XPUSHs(newSVpvn_flags(op_desc[myopcode], |
489 | strlen(op_desc[myopcode]), | |
490 | SVs_TEMP)); | |
6badd1a5 | 491 | } |
492 | } | |
493 | else | |
ff0cee69 | 494 | croak("panic: invalid bitspec for \"%s\" (type %u)", |
495 | opname, (unsigned)SvTYPE(bitspec)); | |
6badd1a5 | 496 | } |
497 | ||
498 | ||
499 | void | |
500 | define_optag(optagsv, mask) | |
501 | SV *optagsv | |
502 | SV *mask | |
4d8e9581 | 503 | CODE: |
6badd1a5 | 504 | STRLEN len; |
5d7488b2 | 505 | const char *optag = SvPV(optagsv, len); |
89ca4ac7 | 506 | |
cea2e8a9 | 507 | put_op_bitspec(aTHX_ optag, len, mask); /* croaks */ |
6b88bc9c | 508 | ST(0) = &PL_sv_yes; |
6badd1a5 | 509 | |
510 | ||
511 | void | |
512 | empty_opset() | |
4d8e9581 | 513 | CODE: |
cea2e8a9 | 514 | ST(0) = sv_2mortal(new_opset(aTHX_ Nullsv)); |
6badd1a5 | 515 | |
516 | void | |
517 | full_opset() | |
4d8e9581 | 518 | CODE: |
89ca4ac7 | 519 | dMY_CXT; |
cea2e8a9 | 520 | ST(0) = sv_2mortal(new_opset(aTHX_ opset_all)); |
6badd1a5 | 521 | |
522 | void | |
523 | opmask_add(opset) | |
524 | SV *opset | |
4d8e9581 | 525 | PREINIT: |
3280af22 | 526 | if (!PL_op_mask) |
a02a5408 | 527 | Newxz(PL_op_mask, PL_maxo, char); |
cea2e8a9 GS |
528 | CODE: |
529 | opmask_add(aTHX_ opset); | |
6badd1a5 | 530 | |
531 | void | |
532 | opcodes() | |
4d8e9581 | 533 | PPCODE: |
eb7e169e | 534 | if (GIMME_V == G_LIST) { |
6badd1a5 | 535 | croak("opcodes in list context not yet implemented"); /* XXX */ |
536 | } | |
537 | else { | |
3280af22 | 538 | XPUSHs(sv_2mortal(newSViv(PL_maxo))); |
6badd1a5 | 539 | } |
540 | ||
541 | void | |
542 | opmask() | |
4d8e9581 | 543 | CODE: |
cea2e8a9 | 544 | ST(0) = sv_2mortal(new_opset(aTHX_ Nullsv)); |
3280af22 | 545 | if (PL_op_mask) { |
5d7488b2 | 546 | char * const bitmap = SvPVX(ST(0)); |
6badd1a5 | 547 | int myopcode; |
3280af22 NIS |
548 | for(myopcode=0; myopcode < PL_maxo; ++myopcode) { |
549 | if (PL_op_mask[myopcode]) | |
6badd1a5 | 550 | bitmap[myopcode >> 3] |= 1 << (myopcode & 0x07); |
551 | } | |
552 | } | |
553 |