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 #ifdef OPCODE_DEBUG 17 int x_opcode_debug; /* unused warn() emitting debugging code */ 18 #endif 19 } my_cxt_t; 20 21 START_MY_CXT 22 23 #define op_named_bits (MY_CXT.x_op_named_bits) 24 #define opset_all (MY_CXT.x_opset_all) 25 #define opset_len (MY_CXT.x_opset_len) 26 #ifdef OPCODE_DEBUG 27 # define opcode_debug (MY_CXT.x_opcode_debug) 28 #else 29 /* no API to turn this on at runtime, so constant fold the code away */ 30 # define opcode_debug 0 31 #endif 32 33 static SV *new_opset (pTHX_ SV *old_opset); 34 static int verify_opset (pTHX_ SV *opset, int fatal); 35 static void set_opset_bits (pTHX_ char *bitmap, SV *bitspec, int on, const char *opname); 36 static void put_op_bitspec (pTHX_ const char *optag, STRLEN len, SV *opset); 37 static SV *get_op_bitspec (pTHX_ const char *opname, STRLEN len, int fatal); 38 39 40 /* Initialise our private op_named_bits HV. 41 * It is first loaded with the name and number of each perl operator. 42 * Then the builtin tags :none and :all are added. 43 * Opcode.pm loads the standard optags from __DATA__ 44 * XXX leak-alert: data allocated here is never freed, call this 45 * at most once 46 */ 47 48 static void 49 op_names_init(pTHX) 50 { 51 int i; 52 STRLEN len; 53 char **op_names; 54 char *bitmap; 55 dMY_CXT; 56 57 op_named_bits = newHV(); 58 op_names = get_op_names(); 59 for(i=0; i < PL_maxo; ++i) { 60 SV * const sv = newSViv(i); 61 SvREADONLY_on(sv); 62 (void) hv_store(op_named_bits, op_names[i], strlen(op_names[i]), sv, 0); 63 } 64 65 put_op_bitspec(aTHX_ STR_WITH_LEN(":none"), sv_2mortal(new_opset(aTHX_ Nullsv))); 66 67 opset_all = new_opset(aTHX_ Nullsv); 68 bitmap = SvPV(opset_all, len); 69 memset(bitmap, 0xFF, len-1); /* deal with last byte specially, see below */ 70 /* Take care to set the right number of bits in the last byte */ 71 bitmap[len-1] = (PL_maxo & 0x07) ? ~(0xFF << (PL_maxo & 0x07)) : 0xFF; 72 put_op_bitspec(aTHX_ STR_WITH_LEN(":all"), opset_all); /* don't mortalise */ 73 } 74 75 76 /* Store a new tag definition. Always a mask. 77 * The tag must not already be defined. 78 * SV *mask is copied not referenced. 79 */ 80 81 static void 82 put_op_bitspec(pTHX_ const char *optag, STRLEN len, SV *mask) 83 { 84 SV **svp; 85 dMY_CXT; 86 87 verify_opset(aTHX_ mask,1); 88 svp = hv_fetch(op_named_bits, optag, len, 1); 89 if (SvOK(*svp)) 90 croak("Opcode tag \"%s\" already defined", optag); 91 sv_setsv(*svp, mask); 92 SvREADONLY_on(*svp); 93 } 94 95 96 97 /* Fetch a 'bits' entry for an opname or optag (IV/PV). 98 * Note that we return the actual entry for speed. 99 * Always sv_mortalcopy() if returning it to user code. 100 */ 101 102 static SV * 103 get_op_bitspec(pTHX_ const char *opname, STRLEN len, int fatal) 104 { 105 SV **svp; 106 dMY_CXT; 107 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(opset_len); 137 Zero(SvPVX_const(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 const char *err = NULL; 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, const char *opname) 164 { 165 dMY_CXT; 166 167 if (SvIOK(bitspec)) { 168 const int myopcode = SvIV(bitspec); 169 const int offset = myopcode >> 3; 170 const 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 const char * const 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 const 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 #ifdef OPCODE_DEBUG 231 dMY_CXT; 232 #endif 233 234 SAVEVPTR(PL_op_mask); 235 /* XXX casting to an ordinary function ptr from a member function ptr 236 * is disallowed by Borland 237 */ 238 if (opcode_debug >= 2) 239 SAVEDESTRUCTOR((void(*)(void*))Perl_warn,"PL_op_mask restored"); 240 PL_op_mask = &op_mask_buf[0]; 241 if (orig_op_mask) 242 Copy(orig_op_mask, PL_op_mask, PL_maxo, char); 243 else 244 Zero(PL_op_mask, PL_maxo, char); 245 opmask_add(aTHX_ opset); 246 } 247 248 249 250 MODULE = Opcode PACKAGE = Opcode 251 252 PROTOTYPES: ENABLE 253 254 BOOT: 255 { 256 MY_CXT_INIT; 257 assert(PL_maxo < OP_MASK_BUF_SIZE); 258 opset_len = (PL_maxo + 7) / 8; 259 if (opcode_debug >= 1) 260 warn("opset_len %ld\n", (long)opset_len); 261 op_names_init(aTHX); 262 } 263 264 void 265 _safe_pkg_prep(Package) 266 SV *Package 267 PPCODE: 268 HV *hv; 269 char *hvname; 270 ENTER; 271 272 hv = gv_stashsv(Package, GV_ADDWARN); /* should exist already */ 273 274 hvname = HvNAME_get(hv); 275 if (!hvname || strNE(hvname, "main")) { 276 /* make it think it's in main:: */ 277 hv_name_set(hv, "main", 4, 0); 278 (void) hv_store(hv,"_",1,(SV *)PL_defgv,0); /* connect _ to global */ 279 SvREFCNT_inc((SV *)PL_defgv); /* want to keep _ around! */ 280 } 281 LEAVE; 282 283 284 285 286 287 void 288 _safe_call_sv(Package, mask, codesv) 289 SV * Package 290 SV * mask 291 SV * codesv 292 PPCODE: 293 char op_mask_buf[OP_MASK_BUF_SIZE]; 294 GV *gv; 295 HV *dummy_hv; 296 297 ENTER; 298 299 opmask_addlocal(aTHX_ mask, op_mask_buf); 300 301 save_aptr(&PL_endav); 302 PL_endav = (AV*)sv_2mortal((SV*)newAV()); /* ignore END blocks for now */ 303 304 save_hptr(&PL_defstash); /* save current default stash */ 305 /* the assignment to global defstash changes our sense of 'main' */ 306 PL_defstash = gv_stashsv(Package, GV_ADDWARN); /* should exist already */ 307 308 SAVEGENERICSV(PL_curstash); 309 PL_curstash = (HV *)SvREFCNT_inc_simple(PL_defstash); 310 311 /* defstash must itself contain a main:: so we'll add that now */ 312 /* take care with the ref counts (was cause of long standing bug) */ 313 /* XXX I'm still not sure if this is right, GV_ADDWARN should warn! */ 314 gv = gv_fetchpvs("main::", GV_ADDWARN, SVt_PVHV); 315 sv_free((SV*)GvHV(gv)); 316 GvHV(gv) = (HV*)SvREFCNT_inc(PL_defstash); 317 318 /* %INC must be clean for use/require in compartment */ 319 dummy_hv = save_hash(PL_incgv); 320 GvHV(PL_incgv) = (HV*)SvREFCNT_inc(GvHV(gv_HVadd(gv_fetchpvs("INC",GV_ADD,SVt_PVHV)))); 321 322 /* Invalidate class and method caches */ 323 ++PL_sub_generation; 324 hv_clear(PL_stashcache); 325 326 PUSHMARK(SP); 327 /* use caller’s context */ 328 perl_call_sv(codesv, GIMME_V|G_EVAL|G_KEEPERR); 329 sv_free( (SV *) dummy_hv); /* get rid of what save_hash gave us*/ 330 SPAGAIN; /* for the PUTBACK added by xsubpp */ 331 LEAVE; 332 333 /* Invalidate again */ 334 ++PL_sub_generation; 335 hv_clear(PL_stashcache); 336 337 338 int 339 verify_opset(opset, fatal = 0) 340 SV *opset 341 int fatal 342 CODE: 343 RETVAL = verify_opset(aTHX_ opset,fatal); 344 OUTPUT: 345 RETVAL 346 347 void 348 invert_opset(opset) 349 SV *opset 350 CODE: 351 { 352 char *bitmap; 353 dMY_CXT; 354 STRLEN len = opset_len; 355 356 opset = sv_2mortal(new_opset(aTHX_ opset)); /* verify and clone opset */ 357 bitmap = SvPVX(opset); 358 while(len-- > 0) 359 bitmap[len] = ~bitmap[len]; 360 /* take care of extra bits beyond PL_maxo in last byte */ 361 if (PL_maxo & 07) 362 bitmap[opset_len-1] &= ~(0xFF << (PL_maxo & 0x07)); 363 } 364 ST(0) = opset; 365 366 367 void 368 opset_to_ops(opset, desc = 0) 369 SV *opset 370 int desc 371 PPCODE: 372 { 373 STRLEN len; 374 int i, j, myopcode; 375 const char * const bitmap = SvPV(opset, len); 376 char **names = (desc) ? get_op_descs() : get_op_names(); 377 dMY_CXT; 378 379 verify_opset(aTHX_ opset,1); 380 for (myopcode=0, i=0; i < opset_len; i++) { 381 const U16 bits = bitmap[i]; 382 for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++) { 383 if ( bits & (1 << j) ) 384 XPUSHs(newSVpvn_flags(names[myopcode], strlen(names[myopcode]), 385 SVs_TEMP)); 386 } 387 } 388 } 389 390 391 void 392 opset(...) 393 CODE: 394 int i; 395 SV *bitspec; 396 STRLEN len, on; 397 398 SV * const opset = sv_2mortal(new_opset(aTHX_ Nullsv)); 399 char * const bitmap = SvPVX(opset); 400 for (i = 0; i < items; i++) { 401 const char *opname; 402 on = 1; 403 if (verify_opset(aTHX_ ST(i),0)) { 404 opname = "(opset)"; 405 bitspec = ST(i); 406 } 407 else { 408 opname = SvPV(ST(i), len); 409 if (*opname == '!') { on=0; ++opname;--len; } 410 bitspec = get_op_bitspec(aTHX_ opname, len, 1); 411 } 412 set_opset_bits(aTHX_ bitmap, bitspec, on, opname); 413 } 414 ST(0) = opset; 415 416 417 #define PERMITING (ix == 0 || ix == 1) 418 #define ONLY_THESE (ix == 0 || ix == 2) 419 420 void 421 permit_only(safe, ...) 422 SV *safe 423 ALIAS: 424 permit = 1 425 deny_only = 2 426 deny = 3 427 CODE: 428 int i; 429 SV *bitspec, *mask; 430 char *bitmap; 431 STRLEN len; 432 dMY_CXT; 433 434 if (!SvROK(safe) || !SvOBJECT(SvRV(safe)) || SvTYPE(SvRV(safe))!=SVt_PVHV) 435 croak("Not a Safe object"); 436 mask = *hv_fetch((HV*)SvRV(safe), "Mask",4, 1); 437 if (ONLY_THESE) /* *_only = new mask, else edit current */ 438 sv_setsv(mask, sv_2mortal(new_opset(aTHX_ PERMITING ? opset_all : Nullsv))); 439 else 440 verify_opset(aTHX_ mask,1); /* croaks */ 441 bitmap = SvPVX(mask); 442 for (i = 1; i < items; i++) { 443 const char *opname; 444 int on = PERMITING ? 0 : 1; /* deny = mask bit on */ 445 if (verify_opset(aTHX_ ST(i),0)) { /* it's a valid mask */ 446 opname = "(opset)"; 447 bitspec = ST(i); 448 } 449 else { /* it's an opname/optag */ 450 opname = SvPV(ST(i), len); 451 /* invert if op has ! prefix (only one allowed) */ 452 if (*opname == '!') { on = !on; ++opname; --len; } 453 bitspec = get_op_bitspec(aTHX_ opname, len, 1); /* croaks */ 454 } 455 set_opset_bits(aTHX_ bitmap, bitspec, on, opname); 456 } 457 ST(0) = &PL_sv_yes; 458 459 460 461 void 462 opdesc(...) 463 PPCODE: 464 int i; 465 STRLEN len; 466 SV **args; 467 char **op_desc = get_op_descs(); 468 dMY_CXT; 469 470 /* copy args to a scratch area since we may push output values onto */ 471 /* the stack faster than we read values off it if masks are used. */ 472 args = (SV**)SvPVX(newSVpvn_flags((char*)&ST(0), items*sizeof(SV*), SVs_TEMP)); 473 for (i = 0; i < items; i++) { 474 const char * const opname = SvPV(args[i], len); 475 SV *bitspec = get_op_bitspec(aTHX_ opname, len, 1); 476 if (SvIOK(bitspec)) { 477 const int myopcode = SvIV(bitspec); 478 if (myopcode < 0 || myopcode >= PL_maxo) 479 croak("panic: opcode %d (%s) out of range",myopcode,opname); 480 XPUSHs(newSVpvn_flags(op_desc[myopcode], strlen(op_desc[myopcode]), 481 SVs_TEMP)); 482 } 483 else if (SvPOK(bitspec) && SvCUR(bitspec) == (STRLEN)opset_len) { 484 int b, j; 485 const char * const bitmap = SvPV_nolen_const(bitspec); 486 int myopcode = 0; 487 for (b=0; b < opset_len; b++) { 488 const U16 bits = bitmap[b]; 489 for (j=0; j < 8 && myopcode < PL_maxo; j++, myopcode++) 490 if (bits & (1 << j)) 491 XPUSHs(newSVpvn_flags(op_desc[myopcode], 492 strlen(op_desc[myopcode]), 493 SVs_TEMP)); 494 } 495 } 496 else 497 croak("panic: invalid bitspec for \"%s\" (type %u)", 498 opname, (unsigned)SvTYPE(bitspec)); 499 } 500 501 502 void 503 define_optag(optagsv, mask) 504 SV *optagsv 505 SV *mask 506 CODE: 507 STRLEN len; 508 const char *optag = SvPV(optagsv, len); 509 510 put_op_bitspec(aTHX_ optag, len, mask); /* croaks */ 511 ST(0) = &PL_sv_yes; 512 513 514 void 515 empty_opset() 516 CODE: 517 ST(0) = sv_2mortal(new_opset(aTHX_ Nullsv)); 518 519 void 520 full_opset() 521 CODE: 522 dMY_CXT; 523 ST(0) = sv_2mortal(new_opset(aTHX_ opset_all)); 524 525 void 526 opmask_add(opset) 527 SV *opset 528 PREINIT: 529 if (!PL_op_mask) 530 Newxz(PL_op_mask, PL_maxo, char); 531 CODE: 532 opmask_add(aTHX_ opset); 533 534 void 535 opcodes() 536 PPCODE: 537 if (GIMME_V == G_ARRAY) { 538 croak("opcodes in list context not yet implemented"); /* XXX */ 539 } 540 else { 541 XPUSHs(sv_2mortal(newSViv(PL_maxo))); 542 } 543 544 void 545 opmask() 546 CODE: 547 ST(0) = sv_2mortal(new_opset(aTHX_ Nullsv)); 548 if (PL_op_mask) { 549 char * const bitmap = SvPVX(ST(0)); 550 int myopcode; 551 for(myopcode=0; myopcode < PL_maxo; ++myopcode) { 552 if (PL_op_mask[myopcode]) 553 bitmap[myopcode >> 3] |= 1 << (myopcode & 0x07); 554 } 555 } 556 557