| 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, 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); |
| 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 |
op_names_init(pTHX) |
| 43 |
{ |
| 44 |
int i; |
| 45 |
STRLEN len; |
| 46 |
char **op_names; |
| 47 |
char *bitmap; |
| 48 |
dMY_CXT; |
| 49 |
|
| 50 |
op_named_bits = newHV(); |
| 51 |
op_names = get_op_names(); |
| 52 |
for(i=0; i < PL_maxo; ++i) { |
| 53 |
SV *sv; |
| 54 |
sv = newSViv(i); |
| 55 |
SvREADONLY_on(sv); |
| 56 |
hv_store(op_named_bits, op_names[i], strlen(op_names[i]), sv, 0); |
| 57 |
} |
| 58 |
|
| 59 |
put_op_bitspec(aTHX_ ":none",0, sv_2mortal(new_opset(aTHX_ Nullsv))); |
| 60 |
|
| 61 |
opset_all = new_opset(aTHX_ Nullsv); |
| 62 |
bitmap = SvPV(opset_all, len); |
| 63 |
i = len-1; /* deal with last byte specially, see below */ |
| 64 |
while(i-- > 0) |
| 65 |
bitmap[i] = (char)0xFF; |
| 66 |
/* Take care to set the right number of bits in the last byte */ |
| 67 |
bitmap[len-1] = (PL_maxo & 0x07) ? ~(0xFF << (PL_maxo & 0x07)) : 0xFF; |
| 68 |
put_op_bitspec(aTHX_ ":all",0, opset_all); /* don't mortalise */ |
| 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 |
| 78 |
put_op_bitspec(pTHX_ char *optag, STRLEN len, SV *mask) |
| 79 |
{ |
| 80 |
SV **svp; |
| 81 |
dMY_CXT; |
| 82 |
|
| 83 |
verify_opset(aTHX_ mask,1); |
| 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 * |
| 101 |
get_op_bitspec(pTHX_ char *opname, STRLEN len, int fatal) |
| 102 |
{ |
| 103 |
SV **svp; |
| 104 |
dMY_CXT; |
| 105 |
|
| 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 * |
| 126 |
new_opset(pTHX_ SV *old_opset) |
| 127 |
{ |
| 128 |
SV *opset; |
| 129 |
dMY_CXT; |
| 130 |
|
| 131 |
if (old_opset) { |
| 132 |
verify_opset(aTHX_ old_opset,1); |
| 133 |
opset = newSVsv(old_opset); |
| 134 |
} |
| 135 |
else { |
| 136 |
opset = NEWSV(1156, opset_len); |
| 137 |
Zero(SvPVX(opset), opset_len + 1, char); |
| 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 |
| 147 |
verify_opset(pTHX_ SV *opset, int fatal) |
| 148 |
{ |
| 149 |
char *err = Nullch; |
| 150 |
dMY_CXT; |
| 151 |
|
| 152 |
if (!SvOK(opset)) err = "undefined"; |
| 153 |
else if (!SvPOK(opset)) err = "wrong type"; |
| 154 |
else if (SvCUR(opset) != (STRLEN)opset_len) err = "wrong size"; |
| 155 |
if (err && fatal) { |
| 156 |
croak("Invalid opset: %s", err); |
| 157 |
} |
| 158 |
return !err; |
| 159 |
} |
| 160 |
|
| 161 |
|
| 162 |
static void |
| 163 |
set_opset_bits(pTHX_ char *bitmap, SV *bitspec, int on, char *opname) |
| 164 |
{ |
| 165 |
dMY_CXT; |
| 166 |
|
| 167 |
if (SvIOK(bitspec)) { |
| 168 |
int myopcode = SvIV(bitspec); |
| 169 |
int offset = myopcode >> 3; |
| 170 |
int bit = myopcode & 0x07; |
| 171 |
if (myopcode >= PL_maxo || myopcode < 0) |
| 172 |
croak("panic: opcode \"%s\" value %d is invalid", opname, myopcode); |
| 173 |
if (opcode_debug >= 2) |
| 174 |
warn("set_opset_bits bit %2d (off=%d, bit=%d) %s %s\n", |
| 175 |
myopcode, offset, bit, opname, (on)?"on":"off"); |
| 176 |
if (on) |
| 177 |
bitmap[offset] |= 1 << bit; |
| 178 |
else |
| 179 |
bitmap[offset] &= ~(1 << bit); |
| 180 |
} |
| 181 |
else if (SvPOK(bitspec) && SvCUR(bitspec) == (STRLEN)opset_len) { |
| 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 |
| 193 |
croak("panic: invalid bitspec for \"%s\" (type %u)", |
| 194 |
opname, (unsigned)SvTYPE(bitspec)); |
| 195 |
} |
| 196 |
|
| 197 |
|
| 198 |
static void |
| 199 |
opmask_add(pTHX_ SV *opset) /* THE ONLY FUNCTION TO EDIT PL_op_mask ITSELF */ |
| 200 |
{ |
| 201 |
int i,j; |
| 202 |
char *bitmask; |
| 203 |
STRLEN len; |
| 204 |
int myopcode = 0; |
| 205 |
dMY_CXT; |
| 206 |
|
| 207 |
verify_opset(aTHX_ opset,1); /* croaks on bad opset */ |
| 208 |
|
| 209 |
if (!PL_op_mask) /* caller must ensure PL_op_mask exists */ |
| 210 |
croak("Can't add to uninitialised PL_op_mask"); |
| 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 |
} |
| 221 |
for (j=0; j < 8 && myopcode < PL_maxo; ) |
| 222 |
PL_op_mask[myopcode++] |= bits & (1 << j++); |
| 223 |
} |
| 224 |
} |
| 225 |
|
| 226 |
static void |
| 227 |
opmask_addlocal(pTHX_ SV *opset, char *op_mask_buf) /* Localise PL_op_mask then opmask_add() */ |
| 228 |
{ |
| 229 |
char *orig_op_mask = PL_op_mask; |
| 230 |
dMY_CXT; |
| 231 |
|
| 232 |
SAVEVPTR(PL_op_mask); |
| 233 |
/* XXX casting to an ordinary function ptr from a member function ptr |
| 234 |
* is disallowed by Borland |
| 235 |
*/ |
| 236 |
if (opcode_debug >= 2) |
| 237 |
SAVEDESTRUCTOR((void(*)(void*))Perl_warn,"PL_op_mask restored"); |
| 238 |
PL_op_mask = &op_mask_buf[0]; |
| 239 |
if (orig_op_mask) |
| 240 |
Copy(orig_op_mask, PL_op_mask, PL_maxo, char); |
| 241 |
else |
| 242 |
Zero(PL_op_mask, PL_maxo, char); |
| 243 |
opmask_add(aTHX_ opset); |
| 244 |
} |
| 245 |
|
| 246 |
|
| 247 |
|
| 248 |
MODULE = Opcode PACKAGE = Opcode |
| 249 |
|
| 250 |
PROTOTYPES: ENABLE |
| 251 |
|
| 252 |
BOOT: |
| 253 |
{ |
| 254 |
MY_CXT_INIT; |
| 255 |
assert(PL_maxo < OP_MASK_BUF_SIZE); |
| 256 |
opset_len = (PL_maxo + 7) / 8; |
| 257 |
if (opcode_debug >= 1) |
| 258 |
warn("opset_len %ld\n", (long)opset_len); |
| 259 |
op_names_init(aTHX); |
| 260 |
} |
| 261 |
|
| 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 |
|
| 271 |
if (strNE(HvNAME(hv),"main")) { |
| 272 |
Safefree(HvNAME(hv)); |
| 273 |
HvNAME(hv) = savepv("main"); /* make it think it's in main:: */ |
| 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 |
|
| 282 |
|
| 283 |
void |
| 284 |
_safe_call_sv(Package, mask, codesv) |
| 285 |
char * Package |
| 286 |
SV * mask |
| 287 |
SV * codesv |
| 288 |
PPCODE: |
| 289 |
char op_mask_buf[OP_MASK_BUF_SIZE]; |
| 290 |
GV *gv; |
| 291 |
HV *dummy_hv; |
| 292 |
|
| 293 |
ENTER; |
| 294 |
|
| 295 |
opmask_addlocal(aTHX_ mask, op_mask_buf); |
| 296 |
|
| 297 |
save_aptr(&PL_endav); |
| 298 |
PL_endav = (AV*)sv_2mortal((SV*)newAV()); /* ignore END blocks for now */ |
| 299 |
|
| 300 |
save_hptr(&PL_defstash); /* save current default stash */ |
| 301 |
/* the assignment to global defstash changes our sense of 'main' */ |
| 302 |
PL_defstash = gv_stashpv(Package, GV_ADDWARN); /* should exist already */ |
| 303 |
|
| 304 |
save_hptr(&PL_curstash); |
| 305 |
PL_curstash = PL_defstash; |
| 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)); |
| 312 |
GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash); |
| 313 |
|
| 314 |
/* %INC must be clean for use/require in compartment */ |
| 315 |
dummy_hv = save_hash(PL_incgv); |
| 316 |
GvHV(PL_incgv) = (HV*)SvREFCNT_inc(GvHV(gv_HVadd(gv_fetchpv("INC",TRUE,SVt_PVHV)))); |
| 317 |
|
| 318 |
PUSHMARK(SP); |
| 319 |
perl_call_sv(codesv, GIMME|G_EVAL|G_KEEPERR); /* use callers context */ |
| 320 |
sv_free( (SV *) dummy_hv); /* get rid of what save_hash gave us*/ |
| 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 |
| 329 |
CODE: |
| 330 |
RETVAL = verify_opset(aTHX_ opset,fatal); |
| 331 |
OUTPUT: |
| 332 |
RETVAL |
| 333 |
|
| 334 |
void |
| 335 |
invert_opset(opset) |
| 336 |
SV *opset |
| 337 |
CODE: |
| 338 |
{ |
| 339 |
char *bitmap; |
| 340 |
dMY_CXT; |
| 341 |
STRLEN len = opset_len; |
| 342 |
|
| 343 |
opset = sv_2mortal(new_opset(aTHX_ opset)); /* verify and clone opset */ |
| 344 |
bitmap = SvPVX(opset); |
| 345 |
while(len-- > 0) |
| 346 |
bitmap[len] = ~bitmap[len]; |
| 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)); |
| 350 |
} |
| 351 |
ST(0) = opset; |
| 352 |
|
| 353 |
|
| 354 |
void |
| 355 |
opset_to_ops(opset, desc = 0) |
| 356 |
SV *opset |
| 357 |
int desc |
| 358 |
PPCODE: |
| 359 |
{ |
| 360 |
STRLEN len; |
| 361 |
int i, j, myopcode; |
| 362 |
char *bitmap = SvPV(opset, len); |
| 363 |
char **names = (desc) ? get_op_descs() : get_op_names(); |
| 364 |
dMY_CXT; |
| 365 |
|
| 366 |
verify_opset(aTHX_ opset,1); |
| 367 |
for (myopcode=0, i=0; i < opset_len; i++) { |
| 368 |
U16 bits = bitmap[i]; |
| 369 |
for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++) { |
| 370 |
if ( bits & (1 << j) ) |
| 371 |
XPUSHs(sv_2mortal(newSVpv(names[myopcode], 0))); |
| 372 |
} |
| 373 |
} |
| 374 |
} |
| 375 |
|
| 376 |
|
| 377 |
void |
| 378 |
opset(...) |
| 379 |
CODE: |
| 380 |
int i; |
| 381 |
SV *bitspec, *opset; |
| 382 |
char *bitmap; |
| 383 |
STRLEN len, on; |
| 384 |
|
| 385 |
opset = sv_2mortal(new_opset(aTHX_ Nullsv)); |
| 386 |
bitmap = SvPVX(opset); |
| 387 |
for (i = 0; i < items; i++) { |
| 388 |
char *opname; |
| 389 |
on = 1; |
| 390 |
if (verify_opset(aTHX_ ST(i),0)) { |
| 391 |
opname = "(opset)"; |
| 392 |
bitspec = ST(i); |
| 393 |
} |
| 394 |
else { |
| 395 |
opname = SvPV(ST(i), len); |
| 396 |
if (*opname == '!') { on=0; ++opname;--len; } |
| 397 |
bitspec = get_op_bitspec(aTHX_ opname, len, 1); |
| 398 |
} |
| 399 |
set_opset_bits(aTHX_ bitmap, bitspec, on, opname); |
| 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 |
| 410 |
ALIAS: |
| 411 |
permit = 1 |
| 412 |
deny_only = 2 |
| 413 |
deny = 3 |
| 414 |
CODE: |
| 415 |
int i, on; |
| 416 |
SV *bitspec, *mask; |
| 417 |
char *bitmap, *opname; |
| 418 |
STRLEN len; |
| 419 |
dMY_CXT; |
| 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 */ |
| 425 |
sv_setsv(mask, sv_2mortal(new_opset(aTHX_ PERMITING ? opset_all : Nullsv))); |
| 426 |
else |
| 427 |
verify_opset(aTHX_ mask,1); /* croaks */ |
| 428 |
bitmap = SvPVX(mask); |
| 429 |
for (i = 1; i < items; i++) { |
| 430 |
on = PERMITING ? 0 : 1; /* deny = mask bit on */ |
| 431 |
if (verify_opset(aTHX_ ST(i),0)) { /* it's a valid mask */ |
| 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; } |
| 439 |
bitspec = get_op_bitspec(aTHX_ opname, len, 1); /* croaks */ |
| 440 |
} |
| 441 |
set_opset_bits(aTHX_ bitmap, bitspec, on, opname); |
| 442 |
} |
| 443 |
ST(0) = &PL_sv_yes; |
| 444 |
|
| 445 |
|
| 446 |
|
| 447 |
void |
| 448 |
opdesc(...) |
| 449 |
PPCODE: |
| 450 |
int i, myopcode; |
| 451 |
STRLEN len; |
| 452 |
SV **args; |
| 453 |
char **op_desc = get_op_descs(); |
| 454 |
dMY_CXT; |
| 455 |
|
| 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. */ |
| 458 |
args = (SV**)SvPVX(sv_2mortal(newSVpvn((char*)&ST(0), items*sizeof(SV*)))); |
| 459 |
for (i = 0; i < items; i++) { |
| 460 |
char *opname = SvPV(args[i], len); |
| 461 |
SV *bitspec = get_op_bitspec(aTHX_ opname, len, 1); |
| 462 |
if (SvIOK(bitspec)) { |
| 463 |
myopcode = SvIV(bitspec); |
| 464 |
if (myopcode < 0 || myopcode >= PL_maxo) |
| 465 |
croak("panic: opcode %d (%s) out of range",myopcode,opname); |
| 466 |
XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0))); |
| 467 |
} |
| 468 |
else if (SvPOK(bitspec) && SvCUR(bitspec) == (STRLEN)opset_len) { |
| 469 |
int b, j; |
| 470 |
STRLEN n_a; |
| 471 |
char *bitmap = SvPV(bitspec,n_a); |
| 472 |
myopcode = 0; |
| 473 |
for (b=0; b < opset_len; b++) { |
| 474 |
U16 bits = bitmap[b]; |
| 475 |
for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++) |
| 476 |
if (bits & (1 << j)) |
| 477 |
XPUSHs(sv_2mortal(newSVpv(op_desc[myopcode], 0))); |
| 478 |
} |
| 479 |
} |
| 480 |
else |
| 481 |
croak("panic: invalid bitspec for \"%s\" (type %u)", |
| 482 |
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 |
char *optag = SvPV(optagsv, len); |
| 493 |
|
| 494 |
put_op_bitspec(aTHX_ optag, len, mask); /* croaks */ |
| 495 |
ST(0) = &PL_sv_yes; |
| 496 |
|
| 497 |
|
| 498 |
void |
| 499 |
empty_opset() |
| 500 |
CODE: |
| 501 |
ST(0) = sv_2mortal(new_opset(aTHX_ Nullsv)); |
| 502 |
|
| 503 |
void |
| 504 |
full_opset() |
| 505 |
CODE: |
| 506 |
dMY_CXT; |
| 507 |
ST(0) = sv_2mortal(new_opset(aTHX_ opset_all)); |
| 508 |
|
| 509 |
void |
| 510 |
opmask_add(opset) |
| 511 |
SV *opset |
| 512 |
PREINIT: |
| 513 |
if (!PL_op_mask) |
| 514 |
Newz(0, PL_op_mask, PL_maxo, char); |
| 515 |
CODE: |
| 516 |
opmask_add(aTHX_ opset); |
| 517 |
|
| 518 |
void |
| 519 |
opcodes() |
| 520 |
PPCODE: |
| 521 |
if (GIMME == G_ARRAY) { |
| 522 |
croak("opcodes in list context not yet implemented"); /* XXX */ |
| 523 |
} |
| 524 |
else { |
| 525 |
XPUSHs(sv_2mortal(newSViv(PL_maxo))); |
| 526 |
} |
| 527 |
|
| 528 |
void |
| 529 |
opmask() |
| 530 |
CODE: |
| 531 |
ST(0) = sv_2mortal(new_opset(aTHX_ Nullsv)); |
| 532 |
if (PL_op_mask) { |
| 533 |
char *bitmap = SvPVX(ST(0)); |
| 534 |
int myopcode; |
| 535 |
for(myopcode=0; myopcode < PL_maxo; ++myopcode) { |
| 536 |
if (PL_op_mask[myopcode]) |
| 537 |
bitmap[myopcode >> 3] |= 1 << (myopcode & 0x07); |
| 538 |
} |
| 539 |
} |
| 540 |
|
