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