1/* Copyright (c) 1997-2021 2 Ewgenij Gawrilow, Michael Joswig, and the polymake team 3 Technische Universität Berlin, Germany 4 https://polymake.org 5 6 This program is free software; you can redistribute it and/or modify it 7 under the terms of the GNU General Public License as published by the 8 Free Software Foundation; either version 2, or (at your option) any 9 later version: http://www.gnu.org/licenses/gpl.txt. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 GNU General Public License for more details. 15-------------------------------------------------------------------------------- 16*/ 17 18#include "polymake/perl/Ext.h" 19 20namespace pm { namespace perl { namespace glue { 21 22namespace { 23 24HV* secret_pkg; 25 26Perl_check_t def_ck_AASSIGN; 27 28#if PerlVersion >= 5220 29# define PmDenyStealingScalar SVs_GMG|SVs_SMG|SVf_PROTECT 30#else 31# define PmDenyStealingScalar SVs_GMG|SVs_SMG 32#endif 33 34MGVTBL pkg_retrieval_index_vtbl={ 0, 0, 0, 0, 0 }; 35 36struct method_info { 37 OP* next_op; 38 SV* filter; 39 SV* fallback; 40 I32 field_index; 41 I32 filter_is_method; 42 CV* accessor; 43}; 44 45OP* pp_hide_orig_object(pTHX) 46{ 47 OP* next = (PL_ppaddr[OP_ENTERSUB])(aTHX); 48 AV* args = GvAV(PL_defgv); 49 // imitate shift(@_) without cleaning out the 0-th slot 50 ++AvARRAY(args); 51 AvMAX(args)--; 52 AvFILLp(args)--; 53 PL_op->op_ppaddr = PL_ppaddr[OP_ENTERSUB]; 54 return next; 55} 56 57OP* pp_hide_orig_object_first(pTHX) 58{ 59 PL_stack_sp += 2; 60 return pp_hide_orig_object(aTHX); 61} 62 63SV* find_method(pTHX_ I32 index, method_info* info) 64{ 65 dSP; dTOPss; 66 SV* obj = SvRV(sv); 67 SV* field = *av_fetch((AV*)obj, index, 1); 68 SV* method_cv; 69 for (;;) { 70 if (SvROK(field)) { 71 method_cv = SvRV(field); 72 if (SvTYPE(method_cv) == SVt_PVCV) 73 break; 74 if (SvOBJECT(method_cv)) { 75 sv = field; 76 obj = method_cv; 77 field = *av_fetch((AV*)obj, index, 1); 78 } else { 79 Perl_croak(aTHX_ "The method field contains a reference of a wrong type"); 80 } 81 82 } else if (SvIOK(field)) { 83 field = *av_fetch((AV*)obj, SvIVX(field), 1); 84 85 } else if (SvPOK(field)) { 86 if (SvCUR(field)) { 87 GV* method_gv = gv_fetchmethod(SvSTASH(obj), SvPVX(field)); 88 method_cv = method_gv && isGV(method_gv) 89 ? (SV*)GvCV(method_gv) 90 : namespace_try_lookup(aTHX_ SvSTASH(obj), field, SVt_PVCV); 91 if (method_cv) { 92 sv_setsv(field, newRV(method_cv)); 93 break; 94 } else { 95 sv_setsv(field, &PL_sv_no); 96 } 97 } 98 if (info) Perl_croak(aTHX_ "Undefined method called"); 99 return field; 100 101 } else if (SvOK(field)) { 102 Perl_croak(aTHX_ "The method field contains a value of a wrong type"); 103 104 } else if (info) { 105 if ((method_cv = info->fallback)) { 106 sv = TOPs; 107 break; 108 } else { 109 Perl_croak(aTHX_ "Undefined method called"); 110 } 111 } else { 112 return field; 113 } 114 } 115 if (info) { 116 if (CvMETHOD((CV*)method_cv)) { 117 SV **stack, **bottom, *orig=TOPs; 118 const bool push_orig = sv!=orig && SvSTASH(method_cv) != secret_pkg; 119 EXTEND(SP, push_orig+1); 120 for (stack = SP, bottom = PL_stack_base+TOPMARK+1; stack > bottom; --stack) 121 stack[push_orig] = stack[-1]; 122 *stack = orig; 123 if (push_orig) { 124 *++stack = sv; 125 info->next_op->op_next->op_ppaddr = &pp_hide_orig_object; 126 } 127 *(PL_stack_sp=SP+push_orig+1) = method_cv; 128 return method_cv; 129 130 } else { 131 SETs(method_cv); 132 return nullptr; 133 } 134 135 } else { 136 return sv_2mortal(newRV(method_cv)); 137 } 138} 139 140OP* pp_access(pTHX) 141{ 142 dSP; dTOPss; 143 SV* obj; 144 if (SvROK(sv) && (obj = SvRV(sv), SvOBJECT(obj))) { 145 HV* stash = SvSTASH(obj); 146 SV* method_name = cSVOP_sv; 147 MAGIC* mg = SvMAGIC(method_name); 148 do { 149 if (stash == (HV*)mg->mg_obj) { 150 method_info* info = (method_info*)mg->mg_ptr; 151 SV* field = *av_fetch((AV*)obj, info->field_index, 1); 152 if (info->filter) { 153 SV* rhs = SP[-1]; // rhs value 154 SP[-1] = field; // preserve it below the mark 155 if (info->filter_is_method) 156 XPUSHs(method_name); // preserve ref(obj) on the stack 157 else 158 SP[0] = method_name; 159 XPUSHs(rhs); 160 XPUSHs(info->filter); 161 PUTBACK; 162 return info->next_op; 163 } else { 164 SETs(field); // replace ref(obj) on the stack top by the requested field 165 (void)POPMARK; // skip pp_entersub 166 return info->next_op->op_next; 167 } 168 } 169 } while ((mg = mg->mg_moremagic)); 170 } 171 return Perl_pp_method_named(aTHX); 172} 173 174OP* pp_swap(pTHX) 175{ 176 dSP; dTOPss; 177 SP[0] = SP[-1]; 178 SP[-1] = sv; 179 return NORMAL; 180} 181 182// better to repeat some code than to put extra tests in the heavily used pp_access 183OP* pp_method_access(pTHX) 184{ 185 dSP; dTOPss; 186 SV* obj; 187 if (!SvROK(sv) || (obj = SvRV(sv), !SvOBJECT(obj))) return Perl_pp_method_named(aTHX); 188 189 HV* stash = SvSTASH(obj); 190 SV* method_name = cSVOP_sv; 191 MAGIC* mg=SvMAGIC(method_name); 192 do { 193 if (stash == (HV*)mg->mg_obj) { 194 method_info* info = (method_info*)mg->mg_ptr; 195 SV* method = find_method(aTHX_ info->field_index, 0); 196 SETs(method); 197 (void)POPMARK; 198 return info->next_op->op_next; 199 } 200 } while ((mg = mg->mg_moremagic)); 201 202 return Perl_pp_method_named(aTHX); 203} 204 205OP* pp_method_defined(pTHX) 206{ 207 dSP; dTOPss; 208 SV* obj; 209 if (!SvROK(sv) || (obj = SvRV(sv), !SvOBJECT(obj))) return Perl_pp_method_named(aTHX); 210 211 HV* stash = SvSTASH(obj); 212 SV* method_name = cSVOP_sv; 213 MAGIC* mg = SvMAGIC(method_name); 214 do { 215 if (stash == (HV*)mg->mg_obj) { 216 method_info* info = (method_info*)mg->mg_ptr; 217 const bool is_assignment = info->next_op->op_next->op_type == OP_DORASSIGN; 218 SV* field = *av_fetch((AV*)obj, info->field_index, is_assignment); 219 SETs(field); // replace ref(obj) on the stack top by the requested field 220 if (SvROK(field) ? SvTYPE(SvRV(field)) != SVt_PVCV : SvIOK(field)) { 221 // if it's a reference to another object to follow, pretend it's undefined 222 if (is_assignment) 223 SvOK_off(field); 224 else 225 SETs(&PL_sv_undef); 226 } 227 (void)POPMARK; // skip pp_entersub 228 return info->next_op->op_next; 229 } 230 } while ((mg = mg->mg_moremagic)); 231 232 return Perl_pp_method_named(aTHX); 233} 234 235OP* pp_method_call(pTHX) 236{ 237 dSP; dTOPss; 238 SV* obj; 239 if (!SvROK(sv) || (obj=SvRV(sv), !SvOBJECT(obj))) return Perl_pp_method_named(aTHX); 240 241 HV* stash=SvSTASH(obj); 242 SV* method_name=cSVOP_sv; 243 MAGIC* mg=SvMAGIC(method_name); 244 do { 245 if (stash == (HV*)mg->mg_obj) { 246 method_info *info=(method_info*)mg->mg_ptr; 247 (void)POPMARK; 248 (void)find_method(aTHX_ info->field_index, info); 249 return info->next_op->op_next; 250 } 251 } while ((mg=mg->mg_moremagic)); 252 253 return Perl_pp_method_named(aTHX); 254} 255 256OP* intercept_ck_aassign(pTHX_ OP* o) 257{ 258 OP* lhs; 259 o=def_ck_AASSIGN(aTHX_ o); 260 lhs=OpSIBLING(cUNOPo->op_first); 261 if (lhs->op_type == OP_NULL) lhs=cUNOPx(lhs)->op_first; 262 while (lhs) { 263 if (lhs->op_type == OP_ENTERSUB) { 264 OP* meth_op=method_named_op(lhs); 265 if (meth_op) meth_op->op_private |= MethodIsCalledOnLeftSideOfArrayAssignment; 266 } 267 lhs=OpSIBLING(lhs); 268 } 269 return o; 270} 271 272void catch_ptrs(pTHX_ SV *dummy) 273{ 274 PL_check[OP_AASSIGN]=&intercept_ck_aassign; 275} 276 277void reset_ptrs(pTHX_ SV *dummy) 278{ 279 PL_check[OP_AASSIGN]=def_ck_AASSIGN; 280} 281 282} 283 284SV* retrieve_pkg(pTHX_ SV* obj) 285{ 286 MAGIC* mg=mg_findext(obj, PERL_MAGIC_ext, &pkg_retrieval_index_vtbl); 287 return mg ? AvARRAY(obj)[mg->mg_private] : nullptr; 288} 289 290HV* retrieve_pkg_stash(pTHX_ SV* obj) 291{ 292 return get_cached_stash(aTHX_ retrieve_pkg(aTHX_ obj)); 293} 294 295} } } 296 297using namespace pm::perl::glue; 298 299MODULE = Polymake::Struct PACKAGE = Polymake::Struct 300 301PROTOTYPES: DISABLE 302 303void access_field(SV* obj_ref, ...) 304PPCODE: 305{ 306 I32 index=CvDEPTH(cv); 307 OP* o=method_named_op(PL_op); 308 SV* obj; 309 if (SvROK(obj_ref)) 310 obj=SvRV(obj_ref); 311 else 312 Perl_croak(aTHX_ "field access for %.*s called as static method", (int)SvCUR(obj_ref), SvPVX(obj_ref)); 313 314 if (o) { 315 OP* next_op=PL_op->op_next; 316 SV* filter=Nullsv; 317 SV* method_name=cSVOPo_sv; 318 HV* stash=SvSTASH(obj); 319 MAGIC* mg=nullptr; 320 321 if (SvTYPE(method_name) == SVt_PVMG) { 322 // maybe the first object of some derived class? 323 mg=SvMAGIC(method_name); 324 do { 325 if (((method_info*)mg->mg_ptr)->accessor == cv) break; 326 } while ((mg=mg->mg_moremagic)); 327 } 328 329 if (!mg) { 330 method_info info; 331 if (next_op->op_type == OP_SASSIGN && !(next_op->op_private & OPpASSIGN_BACKWARDS)) { 332 filter = GvSV(CvGV(cv)); 333 if (filter && (SvROK(filter) || (SvPOK(filter) && SvCUR(filter)))) { 334 OP* sub_op = OpSIBLING(o); 335 if (SvROK(filter)) { 336 filter = SvRV(filter); 337 } else { 338 GV* method_gv = gv_fetchmethod(SvSTASH(obj), SvPVX(filter)); 339 CV* filter_cv = method_gv && isGV(method_gv) 340 ? GvCV(method_gv) 341 : (CV*)namespace_try_lookup(aTHX_ SvSTASH(obj), filter, SVt_PVCV); 342 if (!filter_cv) Perl_croak(aTHX_ "access filter method %.*s not found", (int)SvCUR(filter), SvPVX(filter)); 343 filter = (SV*)filter_cv; 344 } 345 if (!sub_op) { 346 OP* swap_op; 347 NewOp(0, sub_op, 1, OP); 348 sub_op->op_type = OP_CUSTOM; 349 sub_op->op_ppaddr = PL_ppaddr[OP_ENTERSUB]; 350 sub_op->op_flags = U8(PL_op->op_flags & ~(OPf_KIDS)); 351 sub_op->op_private = U8(PL_op->op_private & ~(OPpLVAL_INTRO)); 352 NewOp(0, swap_op, 1, OP); 353 swap_op->op_type = OP_CUSTOM; 354 swap_op->op_ppaddr = &pp_swap; 355 swap_op->op_next = next_op; 356 sub_op->op_next = swap_op; 357 // CAUTION: 358 // This linkage does not match the op_last field of parent ENTERSUB, but that can't be changed without breaking method_named_op(). 359 // The design must be rethought when it starts to fire exceptions in perl core because of inconsistency. 360 OpMORESIB_set(o, sub_op); 361 OpMORESIB_set(sub_op, swap_op); 362 OpLASTSIB_set(swap_op, PL_op); 363 } 364 next_op = sub_op; 365 } else { 366 next_op = PL_op; 367 filter = nullptr; 368 } 369 } else { 370 next_op = PL_op; 371 } 372 373 info.field_index = index; 374 info.filter = filter; 375 info.filter_is_method = filter && CvMETHOD((CV*)filter); 376 info.next_op = next_op; 377 info.fallback = nullptr; 378 info.accessor = cv; 379 380 if (SvTYPE(method_name) < SVt_PVMG) { 381 // first use of this operation 382 U32 flags = SvFLAGS(method_name) & (SVf_FAKE | SVf_READONLY); 383 SvFLAGS(method_name) &= ~(SVf_FAKE | SVf_READONLY); 384 sv_magicext(method_name, (SV*)stash, PERL_MAGIC_ext, 0, (char*)&info, sizeof(info)); 385 SvFLAGS(method_name) |= flags; 386 o->op_ppaddr = &pp_access; 387 } else { 388 sv_magicext(method_name, (SV*)stash, PERL_MAGIC_ext, 0, (char*)&info, sizeof(info)); 389 } 390 391 } else { 392 // first object of some derived class 393 sv_magicext(method_name, (SV*)stash, PERL_MAGIC_ext, 0, mg->mg_ptr, 0); 394 filter = ((method_info*)mg->mg_ptr)->filter; 395 } 396 397 if (filter) { 398 OP* prev = OpSIBLING(cUNOP->op_first); 399 while (prev->op_next != o) prev = prev->op_next; 400 PL_op = prev; 401 PUSHMARK(SP); // restore the mark 402 return; // avoid PUTBACK 403 } 404 } 405 PUSHs(*av_fetch((AV*)obj, index, 1)); 406} 407 408 409void method_call(SV* obj_ref) 410PPCODE: 411{ 412 SV* obj = SvRV(obj_ref); 413 method_info info, *infop = &info; 414 I32 index = CvDEPTH(cv); 415 OP* o = method_named_op(PL_op); 416 OP* next_op = PL_op->op_next; 417 SV* fallback = GvSV(CvGV(cv)); 418 if (fallback) { 419 if (SvROK(fallback)) fallback = SvRV(fallback); 420 if (SvTYPE(fallback) != SVt_PVCV) fallback = nullptr; 421 } 422 423 if (o) { 424 SV* method_name = cSVOPo_sv; 425 HV* stash = SvSTASH(obj); 426 MAGIC* mg = nullptr; 427 428 if (SvTYPE(method_name) == SVt_PVMG) { 429 // maybe the first object of some derived class? 430 mg = SvMAGIC(method_name); 431 do { 432 if (((method_info*)mg->mg_ptr)->accessor == cv) break; 433 } while ((mg = mg->mg_moremagic)); 434 } 435 436 if (!mg) { 437 info.field_index = index; 438 info.filter = nullptr; 439 info.next_op = PL_op; 440 info.fallback = fallback; 441 info.accessor = cv; 442 443 if (SvTYPE(method_name) < SVt_PVMG) { 444 // first use of this operation 445 U32 flags = SvFLAGS(method_name) & (SVf_FAKE | SVf_READONLY); 446 SvFLAGS(method_name) &= ~(SVf_FAKE | SVf_READONLY); 447 sv_magicext(method_name, (SV*)stash, PERL_MAGIC_ext, 0, (char*)&info, sizeof(info)); 448 SvFLAGS(method_name) |= flags; 449 switch (next_op->op_type) { 450 case OP_SASSIGN: 451 case OP_UNDEF: 452#if PerlVersion >= 5275 453 case OP_MULTICONCAT: 454#endif 455 o->op_ppaddr = &pp_access; 456 break; 457 case OP_DEFINED: 458 case OP_DOR: 459 case OP_DORASSIGN: 460 o->op_ppaddr = &pp_method_defined; 461 break; 462 case OP_ENTERSUB: 463 o->op_ppaddr = &pp_method_call; 464 break; 465 default: 466 o->op_ppaddr = PL_op->op_private & OPpLVAL_INTRO ? &pp_access : &pp_method_access; 467 break; 468 } 469 } else { 470 sv_magicext(method_name, (SV*)stash, PERL_MAGIC_ext, 0, (char*)&info, sizeof(info)); 471 } 472 473 } else { 474 // first object of some derived class 475 sv_magicext(method_name, (SV*)stash, PERL_MAGIC_ext, 0, mg->mg_ptr, 0); 476 infop=(method_info*)mg->mg_ptr; 477 } 478 } 479 switch (next_op->op_type) { 480 default: 481 if (!(o && o->op_ppaddr == &pp_access)) { 482 PUSHs(find_method(aTHX_ index, 0)); 483 break; 484 } 485 // FALLTHRU 486 case OP_SASSIGN: 487 case OP_UNDEF: 488 PUSHs(*av_fetch((AV*)obj, index, 1)); 489 break; 490 case OP_DEFINED: 491 case OP_DOR: 492 case OP_DORASSIGN: 493 PUSHs(*av_fetch((AV*)obj, index, next_op->op_type == OP_DORASSIGN)); 494 // if it's an index to another field to follow, pretend it's undefined 495 if (SvROK(TOPs) ? SvTYPE(SvRV(TOPs)) != SVt_PVCV : SvIOK(TOPs)) { 496 if (next_op->op_type == OP_DORASSIGN) 497 SvOK_off(TOPs); 498 else 499 SETs(&PL_sv_undef); 500 } 501 break; 502 case OP_ENTERSUB: 503 if (!o) { 504 info.fallback=fallback; 505 info.next_op=PL_op; 506 } 507 if (find_method(aTHX_ index, infop)) { 508 if (next_op->op_ppaddr==&pp_hide_orig_object) 509 next_op->op_ppaddr=&pp_hide_orig_object_first; 510 else 511 next_op->op_ppaddr=&select_method_helper_op; 512 } 513 ++SP; 514 /* TRICK: even if find_method pushed two or more items on the stack (object, hidden object, method), this XSUB may push only one 515 (due to scalar context imposed on this op). Thus we pretend here to push just one item, and the helper 516 op unveils the rest. */ 517 } 518} 519 520 521I32 get_field_index(SV* sub_ref) 522CODE: 523{ 524 CV* sub; 525 RETVAL = SvROK(sub_ref) && (sub = (CV*)SvRV(sub_ref), CvSTASH(sub) == secret_pkg) ? CvDEPTH(sub) : -1; 526} 527OUTPUT: 528 RETVAL 529 530 531void get_field_filter(SV* sub) 532PPCODE: 533{ 534 SV *filter = &PL_sv_undef; 535 if (SvROK(sub) && (sub = SvRV(sub), CvSTASH((CV*)sub) == secret_pkg)) { 536 GV *field_gv = CvGV(sub); 537 filter = GvSV(field_gv); 538 if (filter && SvROK(filter) && SvTYPE(SvRV(filter)) == SVt_PVCV) 539 filter = sv_mortalcopy(filter); 540 else if (filter && SvPOK(filter) && SvCUR(filter)) { 541 GV* method_gv = gv_fetchmethod(GvSTASH(field_gv), SvPVX(filter)); 542 if (method_gv && isGV(method_gv)) 543 filter=sv_2mortal(newRV((SV*)GvCV(method_gv))); 544 else 545 filter = &PL_sv_undef; 546 } else { 547 filter = &PL_sv_undef; 548 } 549 } 550 PUSHs(filter); 551} 552 553 554void create_accessor(I32 index, SV* xsubr) 555PPCODE: 556{ 557 SV* sub = newSV_type(SVt_PVCV); 558 CV* xsub = (CV*)SvRV(xsubr); 559 CvDEPTH(sub) = index; 560 CvXSUB(sub) = CvXSUB(xsub); 561 CvFLAGS(sub) = CvFLAGS(cv) | CVf_ANON | CVf_LVALUE | CVf_METHOD | CVf_NODEBUG; // standard flags should be the same by all XSUBs 562 CvSTASH_set((CV*)sub, CvSTASH(xsub)); 563 PUSHs(sv_2mortal(newRV_noinc(sub))); 564} 565 566 567void make_body(...) 568PPCODE: 569{ 570 AV* av = newAV(); 571 SV **ary, **src = SP+1, **src_end = SP+items, *pkg_from = *src_end, *rv; 572 Newx(ary, items-1, SV*); 573 AvALLOC(av) = ary; 574 AvARRAY(av) = ary; 575 AvFILLp(av) = items-2; 576 AvMAX(av) = items-2; 577 for (; src < src_end; ++src, ++ary) { 578 SV* sv = *src; 579 if ((SvFLAGS(sv) & (SVs_TEMP|PmDenyStealingScalar)) == SVs_TEMP) { 580 SvTEMP_off(sv); 581 SvREFCNT_inc_simple_void_NN(sv); 582 *ary = sv; 583 } else { 584 *ary = newSVsv(sv); 585 } 586 } 587 rv = newRV_noinc((SV*)av); 588 HV* stash = nullptr; 589 if (SvROK(pkg_from)) { 590 pkg_from = SvRV(pkg_from); 591 if (SvOBJECT(pkg_from)) 592 stash = SvSTASH(pkg_from); 593 } else if (SvPOK(pkg_from)) { 594 stash = gv_stashsv(pkg_from, GV_ADD); 595 } 596 if (stash) 597 sv_bless(rv, stash); 598 else 599 Perl_croak(aTHX_ "Struct::make_body expects an object reference or package name"); 600 PUSHs(sv_2mortal(rv)); 601} 602 603void make_alias(SV* body, I32 index) 604PROTOTYPE: $$ 605PPCODE: 606{ 607 SV** dst = AvARRAY(SvRV(body)) + index; 608 GV* gv = gv_fetchsv(*dst, GV_ADD, SVt_PV); 609 SvREFCNT_dec(*dst); 610 *dst = SvREFCNT_inc(GvSV(gv)); 611} 612 613void original_object() 614PPCODE: 615{ 616 XPUSHs(AvALLOC(GvAV(PL_defgv))[0]); 617} 618 619void pass_original_object(SV* subr) 620PPCODE: 621{ 622 if (!SvROK(subr) || (subr=SvRV(subr), SvTYPE(subr)!=SVt_PVCV)) 623 croak_xs_usage(cv, "\\&sub"); 624 SvSTASH(subr)=secret_pkg; 625 SvREFCNT_inc_simple_void_NN(secret_pkg); 626 ++SP; 627} 628 629void mark_as_default(SV* sv) 630PPCODE: 631{ 632 if (!SvTEMP(sv)) 633 sv=sv_mortalcopy(sv); 634 PUSHs(sv); 635 sv_magicext(sv, Nullsv, PERL_MAGIC_ext, 0, (const char*)&secret_pkg, 0); 636} 637 638void is_default(SV* sv) 639PPCODE: 640{ 641 if (SvTYPE(sv) == SVt_PVMG) { 642 MAGIC *mg=SvMAGIC(sv); 643 if (mg && mg->mg_type==PERL_MAGIC_ext && mg->mg_ptr==(const char*)&secret_pkg) 644 XSRETURN_YES; 645 } 646 XSRETURN_NO; 647} 648 649void learn_package_retrieval(SV* objref, SV* cvref) 650CODE: 651{ 652 MAGIC* mg = sv_magicext(SvRV(objref), Nullsv, PERL_MAGIC_ext, &pkg_retrieval_index_vtbl, Nullch, 0); 653 mg->mg_private = U8(CvDEPTH(SvRV(cvref))); 654} 655 656BOOT: 657{ 658 secret_pkg=gv_stashpv("Polymake::Struct::.secret", TRUE); 659 CvSTASH_set(get_cv("Polymake::Struct::method_call", FALSE), secret_pkg); 660 CvSTASH_set(get_cv("Polymake::Struct::access_field", FALSE), secret_pkg); 661 if (PL_DBgv) { 662 CvNODEBUG_on(get_cv("Polymake::Struct::make_body", FALSE)); 663 CvNODEBUG_on(get_cv("Polymake::Struct::original_object", FALSE)); 664 CvNODEBUG_on(get_cv("Polymake::Struct::pass_original_object", FALSE)); 665 CvNODEBUG_on(get_cv("Polymake::Struct::mark_as_default", FALSE)); 666 } 667 def_ck_AASSIGN=PL_check[OP_AASSIGN]; 668 namespace_register_plugin(aTHX_ catch_ptrs, reset_ptrs, &PL_sv_undef); 669} 670 671=pod 672// Local Variables: 673// mode:C++ 674// c-basic-offset:3 675// indent-tabs-mode:nil 676// End: 677=cut 678