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