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 12typedef struct { 13 HV * x_op_named_bits; /* cache shared for whole process */ 14 SV * x_opset_all; /* mask with all bits set */ 15#ifdef OPCODE_DEBUG 16 int x_opcode_debug; /* unused warn() emitting debugging code */ 17#endif 18} my_cxt_t; 19 20START_MY_CXT 21 22/* length of opmasks in bytes */ 23static const STRLEN opset_len = (PL_maxo + 7) / 8; 24 25#define op_named_bits (MY_CXT.x_op_named_bits) 26#define opset_all (MY_CXT.x_opset_all) 27#ifdef OPCODE_DEBUG 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 33 34static SV *new_opset (pTHX_ SV *old_opset); 35static int verify_opset (pTHX_ SV *opset, int fatal); 36static void set_opset_bits (pTHX_ char *bitmap, SV *bitspec, int on, const char *opname); 37static void put_op_bitspec (pTHX_ const char *optag, STRLEN len, SV *opset); 38static SV *get_op_bitspec (pTHX_ const char *opname, STRLEN len, int fatal); 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__ 45 * XXX leak-alert: data allocated here is never freed, call this 46 * at most once 47 */ 48 49static void 50op_names_init(pTHX) 51{ 52 int i; 53 STRLEN len; 54 const char *const *op_names; 55 U8 *bitmap; 56 dMY_CXT; 57 58 op_named_bits = newHV(); 59 hv_ksplit(op_named_bits, PL_maxo); 60 op_names = PL_op_name; 61 for(i=0; i < PL_maxo; ++i) { 62 SV * const sv = newSViv(i); 63 SvREADONLY_on(sv); 64 (void) hv_store(op_named_bits, op_names[i], strlen(op_names[i]), sv, 0); 65 } 66 67 put_op_bitspec(aTHX_ STR_WITH_LEN(":none"), sv_2mortal(new_opset(aTHX_ Nullsv))); 68 69 opset_all = new_opset(aTHX_ Nullsv); 70 bitmap = (U8*)SvPV(opset_all, len); 71 memset(bitmap, 0xFF, len-1); /* deal with last byte specially, see below */ 72 /* Take care to set the right number of bits in the last byte */ 73 bitmap[len-1] = (PL_maxo & 0x07) ? ((U8) (~(0xFF << (PL_maxo & 0x07)))) 74 : 0xFF; 75 put_op_bitspec(aTHX_ STR_WITH_LEN(":all"), opset_all); /* don't mortalise */ 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 84static void 85put_op_bitspec(pTHX_ const char *optag, STRLEN len, SV *mask) 86{ 87 SV **svp; 88 dMY_CXT; 89 90 verify_opset(aTHX_ mask,1); 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. 102 * Always sv_mortalcopy() if returning it to user code. 103 */ 104 105static SV * 106get_op_bitspec(pTHX_ const char *opname, STRLEN len, int fatal) 107{ 108 SV **svp; 109 dMY_CXT; 110 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 128static SV * 129new_opset(pTHX_ SV *old_opset) 130{ 131 SV *opset; 132 133 if (old_opset) { 134 verify_opset(aTHX_ old_opset,1); 135 opset = newSVsv(old_opset); 136 } 137 else { 138 opset = newSV(opset_len); 139 Zero(SvPVX_const(opset), opset_len + 1, char); 140 SvCUR_set(opset, opset_len); 141 (void)SvPOK_only(opset); 142 } 143 /* not mortalised here */ 144 return opset; 145} 146 147 148static int 149verify_opset(pTHX_ SV *opset, int fatal) 150{ 151 const char *err = NULL; 152 153 if (!SvOK(opset)) err = "undefined"; 154 else if (!SvPOK(opset)) err = "wrong type"; 155 else if (SvCUR(opset) != opset_len) err = "wrong size"; 156 if (err && fatal) { 157 croak("Invalid opset: %s", err); 158 } 159 return !err; 160} 161 162 163static void 164set_opset_bits(pTHX_ char *bitmap, SV *bitspec, int on, const char *opname) 165{ 166 if (SvIOK(bitspec)) { 167 const int myopcode = SvIV(bitspec); 168 const int offset = myopcode >> 3; 169 const int bit = myopcode & 0x07; 170 if (myopcode >= PL_maxo || myopcode < 0) 171 croak("panic: opcode \"%s\" value %d is invalid", opname, myopcode); 172 if (opcode_debug >= 2) 173 warn("set_opset_bits bit %2d (off=%d, bit=%d) %s %s\n", 174 myopcode, offset, bit, opname, (on)?"on":"off"); 175 if (on) 176 bitmap[offset] |= 1 << bit; 177 else 178 bitmap[offset] &= ~(1 << bit); 179 } 180 else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) { 181 182 STRLEN len; 183 const char * const specbits = SvPV(bitspec, len); 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 192 croak("panic: invalid bitspec for \"%s\" (type %u)", 193 opname, (unsigned)SvTYPE(bitspec)); 194} 195 196 197static void 198opmask_add(pTHX_ SV *opset) /* THE ONLY FUNCTION TO EDIT PL_op_mask ITSELF */ 199{ 200 int j; 201 char *bitmask; 202 STRLEN len; 203 int myopcode = 0; 204 205 verify_opset(aTHX_ opset,1); /* croaks on bad opset */ 206 207 if (!PL_op_mask) /* caller must ensure PL_op_mask exists */ 208 croak("Can't add to uninitialised PL_op_mask"); 209 210 /* OPCODES ALREADY MASKED ARE NEVER UNMASKED. See opmask_addlocal() */ 211 212 bitmask = SvPV(opset, len); 213 for (STRLEN i=0; i < opset_len; i++) { 214 const U16 bits = bitmask[i]; 215 if (!bits) { /* optimise for sparse masks */ 216 myopcode += 8; 217 continue; 218 } 219 for (j=0; j < 8 && myopcode < PL_maxo; ) 220 PL_op_mask[myopcode++] |= bits & (1 << j++); 221 } 222} 223 224static void 225opmask_addlocal(pTHX_ SV *opset, char *op_mask_buf) /* Localise PL_op_mask then opmask_add() */ 226{ 227 char *orig_op_mask = PL_op_mask; 228#ifdef OPCODE_DEBUG 229 dMY_CXT; 230#endif 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_nocontext, 238 "PL_op_mask restored"); 239 PL_op_mask = &op_mask_buf[0]; 240 if (orig_op_mask) 241 Copy(orig_op_mask, PL_op_mask, PL_maxo, char); 242 else 243 Zero(PL_op_mask, PL_maxo, char); 244 opmask_add(aTHX_ opset); 245} 246 247 248 249MODULE = Opcode PACKAGE = Opcode 250 251PROTOTYPES: ENABLE 252 253BOOT: 254{ 255 MY_CXT_INIT; 256 STATIC_ASSERT_STMT(PL_maxo < OP_MASK_BUF_SIZE); 257 if (opcode_debug >= 1) 258 warn("opset_len %ld\n", (long)opset_len); 259 op_names_init(aTHX); 260} 261 262void 263_safe_pkg_prep(Package) 264 SV *Package 265PPCODE: 266 HV *hv; 267 char *hvname; 268 ENTER; 269 270 hv = gv_stashsv(Package, GV_ADDWARN); /* should exist already */ 271 272 hvname = HvNAME_get(hv); 273 if (!hvname || strNE(hvname, "main")) { 274 /* make it think it's in main:: */ 275 hv_name_set(hv, "main", 4, 0); 276 (void) hv_store(hv,"_",1,(SV *)PL_defgv,0); /* connect _ to global */ 277 SvREFCNT_inc((SV *)PL_defgv); /* want to keep _ around! */ 278 } 279 LEAVE; 280 281 282 283 284 285void 286_safe_call_sv(Package, mask, codesv) 287 SV * Package 288 SV * mask 289 SV * codesv 290PPCODE: 291 char op_mask_buf[OP_MASK_BUF_SIZE]; 292 GV *gv; 293 HV *dummy_hv; 294 295 ENTER; 296 297 opmask_addlocal(aTHX_ mask, op_mask_buf); 298 299 save_aptr(&PL_endav); 300 PL_endav = (AV*)sv_2mortal((SV*)newAV()); /* ignore END blocks for now */ 301 302 save_hptr(&PL_defstash); /* save current default stash */ 303 /* the assignment to global defstash changes our sense of 'main' */ 304 PL_defstash = gv_stashsv(Package, GV_ADDWARN); /* should exist already */ 305 306 SAVEGENERICSV(PL_curstash); 307 PL_curstash = (HV *)SvREFCNT_inc_simple(PL_defstash); 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! */ 312 gv = gv_fetchpvs("main::", GV_ADDWARN, SVt_PVHV); 313 sv_free((SV*)GvHV(gv)); 314 GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash); 315 316 /* %INC must be clean for use/require in compartment */ 317 dummy_hv = save_hash(PL_incgv); 318 GvHV(PL_incgv) = (HV*)SvREFCNT_inc(GvHV(gv_HVadd(gv_fetchpvs("INC",GV_ADD,SVt_PVHV)))); 319 320 /* Invalidate class and method caches */ 321 ++PL_sub_generation; 322 hv_clear(PL_stashcache); 323 324 PUSHMARK(SP); 325 /* use caller���s context */ 326 perl_call_sv(codesv, GIMME_V|G_EVAL|G_KEEPERR); 327 sv_free( (SV *) dummy_hv); /* get rid of what save_hash gave us*/ 328 SPAGAIN; /* for the PUTBACK added by xsubpp */ 329 LEAVE; 330 331 /* Invalidate again */ 332 ++PL_sub_generation; 333 hv_clear(PL_stashcache); 334 335 336int 337verify_opset(opset, fatal = 0) 338 SV *opset 339 int fatal 340CODE: 341 RETVAL = verify_opset(aTHX_ opset,fatal); 342OUTPUT: 343 RETVAL 344 345void 346invert_opset(opset) 347 SV *opset 348CODE: 349 { 350 char *bitmap; 351 STRLEN len = opset_len; 352 353 opset = sv_2mortal(new_opset(aTHX_ opset)); /* verify and clone opset */ 354 bitmap = SvPVX(opset); 355 while(len-- > 0) 356 bitmap[len] = ~bitmap[len]; 357 /* take care of extra bits beyond PL_maxo in last byte */ 358 if (PL_maxo & 07) 359 bitmap[opset_len-1] &= ~(char)(0xFF << (PL_maxo & 0x07)); 360 } 361 ST(0) = opset; 362 363 364void 365opset_to_ops(opset, desc = 0) 366 SV *opset 367 int desc 368PPCODE: 369 { 370 STRLEN len; 371 STRLEN i; 372 int j, myopcode; 373 const char * const bitmap = SvPV(opset, len); 374 const char *const *names = (desc) ? PL_op_desc : PL_op_name; 375 376 verify_opset(aTHX_ opset,1); 377 for (myopcode=0, i=0; i < opset_len; i++) { 378 const U16 bits = bitmap[i]; 379 for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++) { 380 if ( bits & (1 << j) ) 381 XPUSHs(newSVpvn_flags(names[myopcode], strlen(names[myopcode]), 382 SVs_TEMP)); 383 } 384 } 385 } 386 387 388void 389opset(...) 390CODE: 391 int i; 392 SV *bitspec; 393 STRLEN len, on; 394 395 SV * const opset = sv_2mortal(new_opset(aTHX_ Nullsv)); 396 char * const bitmap = SvPVX(opset); 397 for (i = 0; i < items; i++) { 398 const char *opname; 399 on = 1; 400 if (verify_opset(aTHX_ ST(i),0)) { 401 opname = "(opset)"; 402 bitspec = ST(i); 403 } 404 else { 405 opname = SvPV(ST(i), len); 406 if (*opname == '!') { on=0; ++opname;--len; } 407 bitspec = get_op_bitspec(aTHX_ opname, len, 1); 408 } 409 set_opset_bits(aTHX_ bitmap, bitspec, on, opname); 410 } 411 ST(0) = opset; 412 413 414#define PERMITING (ix == 0 || ix == 1) 415#define ONLY_THESE (ix == 0 || ix == 2) 416 417void 418permit_only(safe, ...) 419 SV *safe 420ALIAS: 421 permit = 1 422 deny_only = 2 423 deny = 3 424CODE: 425 int i; 426 SV *bitspec, *mask; 427 char *bitmap; 428 STRLEN len; 429 dMY_CXT; 430 431 if (!SvROK(safe) || !SvOBJECT(SvRV(safe)) || SvTYPE(SvRV(safe))!=SVt_PVHV) 432 croak("Not a Safe object"); 433 mask = *hv_fetchs((HV*)SvRV(safe), "Mask", 1); 434 if (ONLY_THESE) /* *_only = new mask, else edit current */ 435 sv_setsv(mask, sv_2mortal(new_opset(aTHX_ PERMITING ? opset_all : Nullsv))); 436 else 437 verify_opset(aTHX_ mask,1); /* croaks */ 438 bitmap = SvPVX(mask); 439 for (i = 1; i < items; i++) { 440 const char *opname; 441 int on = PERMITING ? 0 : 1; /* deny = mask bit on */ 442 if (verify_opset(aTHX_ ST(i),0)) { /* it's a valid mask */ 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; } 450 bitspec = get_op_bitspec(aTHX_ opname, len, 1); /* croaks */ 451 } 452 set_opset_bits(aTHX_ bitmap, bitspec, on, opname); 453 } 454 ST(0) = &PL_sv_yes; 455 456 457 458void 459opdesc(...) 460PPCODE: 461 int i; 462 STRLEN len; 463 SV **args; 464 const char *const *op_desc = PL_op_desc; 465 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. */ 468 args = (SV**)SvPVX(newSVpvn_flags((char*)&ST(0), items*sizeof(SV*), SVs_TEMP)); 469 for (i = 0; i < items; i++) { 470 const char * const opname = SvPV(args[i], len); 471 SV *bitspec = get_op_bitspec(aTHX_ opname, len, 1); 472 if (SvIOK(bitspec)) { 473 const int myopcode = SvIV(bitspec); 474 if (myopcode < 0 || myopcode >= PL_maxo) 475 croak("panic: opcode %d (%s) out of range",myopcode,opname); 476 XPUSHs(newSVpvn_flags(op_desc[myopcode], strlen(op_desc[myopcode]), 477 SVs_TEMP)); 478 } 479 else if (SvPOK(bitspec) && SvCUR(bitspec) == opset_len) { 480 STRLEN b; 481 int j; 482 const char * const bitmap = SvPV_nolen_const(bitspec); 483 int myopcode = 0; 484 for (b=0; b < opset_len; b++) { 485 const U16 bits = bitmap[b]; 486 for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++) 487 if (bits & (1 << j)) 488 XPUSHs(newSVpvn_flags(op_desc[myopcode], 489 strlen(op_desc[myopcode]), 490 SVs_TEMP)); 491 } 492 } 493 else 494 croak("panic: invalid bitspec for \"%s\" (type %u)", 495 opname, (unsigned)SvTYPE(bitspec)); 496 } 497 498 499void 500define_optag(optagsv, mask) 501 SV *optagsv 502 SV *mask 503CODE: 504 STRLEN len; 505 const char *optag = SvPV(optagsv, len); 506 507 put_op_bitspec(aTHX_ optag, len, mask); /* croaks */ 508 ST(0) = &PL_sv_yes; 509 510 511void 512empty_opset() 513CODE: 514 ST(0) = sv_2mortal(new_opset(aTHX_ Nullsv)); 515 516void 517full_opset() 518CODE: 519 dMY_CXT; 520 ST(0) = sv_2mortal(new_opset(aTHX_ opset_all)); 521 522void 523opmask_add(opset) 524 SV *opset 525PREINIT: 526 if (!PL_op_mask) 527 Newxz(PL_op_mask, PL_maxo, char); 528CODE: 529 opmask_add(aTHX_ opset); 530 531void 532opcodes() 533PPCODE: 534 if (GIMME_V == G_LIST) { 535 croak("opcodes in list context not yet implemented"); /* XXX */ 536 } 537 else { 538 XPUSHs(sv_2mortal(newSViv(PL_maxo))); 539 } 540 541void 542opmask() 543CODE: 544 ST(0) = sv_2mortal(new_opset(aTHX_ Nullsv)); 545 if (PL_op_mask) { 546 char * const bitmap = SvPVX(ST(0)); 547 int myopcode; 548 for(myopcode=0; myopcode < PL_maxo; ++myopcode) { 549 if (PL_op_mask[myopcode]) 550 bitmap[myopcode >> 3] |= 1 << (myopcode & 0x07); 551 } 552 } 553 554