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