File Coverage

ext/Opcode/Opcode.xs
Criterion Covered Total %
statement 166 203 81.8
branch n/a
condition n/a
subroutine n/a
total 166 203 81.8


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