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/glue.h" 19#include <cxxabi.h> 20 21// had to be copied from mg.c 22struct magic_state { 23 SV* mgs_sv; 24 I32 mgs_ss_ix; 25 U32 mgs_flags; 26#if PerlVersion < 5220 27 bool mgs_readonly; 28#endif 29 bool mgs_bumped; 30}; 31 32namespace pm { namespace perl { namespace glue { 33 34using polymake::AnyString; 35using polymake::Int; 36 37HV *FuncDescr_stash = nullptr, 38 *TypeDescr_stash = nullptr, 39 *User_stash = nullptr, 40 *Object_InitTransaction_stash = nullptr; 41 42const CV* cur_wrapper_cv = nullptr; 43const base_vtbl* cur_class_vtbl = nullptr; 44GV *CPP_root = nullptr, 45 *PropertyType_nested_instantiation = nullptr, 46 *User_application = nullptr, 47 *Debug_level = nullptr; 48SV *negative_indices_key = nullptr, 49 *Serializer_Sparse_dim_key = nullptr, 50 *temporary_value_flag = nullptr; 51 52int Object_name_index, Object_description_index, 53 Object_parent_index, Object_transaction_index, Object_attachments_index, 54 Application_pkg_index, Application_eval_expr_index, 55 TypeDescr_pkg_index, TypeDescr_vtbl_index, TypeDescr_cpperl_file_index, TypeDescr_typeid_index, TypeDescr_generated_by_index, 56 CPPOptions_builtin_index, CPPOptions_descr_index, 57 FuncDescr_wrapper_index, FuncDescr_return_type_reg_index, FuncDescr_name_index, FuncDescr_cpperl_file_index, 58 FuncDescr_arg_types_index, FuncDescr_cross_apps_index, FuncDescr_return_type_index, 59 PropertyType_pkg_index, PropertyType_cppoptions_index, PropertyType_params_index, 60 CPP_functions_index, CPP_regular_functions_index, CPP_embedded_rules_index, 61 CPP_duplicate_class_instances_index, CPP_type_descr_index, CPP_builtins_index, 62 CPP_templates_index, CPP_typeids_index, 63 CPP_auto_assignment_index, CPP_auto_conversion_index, 64 CPP_auto_assoc_methods_index, CPP_auto_set_methods_index, 65 FuncDescr_fill, FuncDescr_fill_visible, TypeDescr_fill; 66 67namespace { 68 69int CPP_Assoc_helem_index, CPP_Assoc_find_index, CPP_Assoc_exists_index, 70 CPP_Assoc_delete_void_index, CPP_Assoc_delete_ret_index; 71int returns_lvalue_flag; 72 73// don't report C++ exceptions as coming from these files - go deeper down the call stack 74const char* skip_contexts[]={ "/Polymake/Core/CPlusPlus.pm", 75 "/Polymake/Core/PropertyType.pm", 76 "/Polymake/Core/Serializer.pm", 77 "/Polymake/Overload.pm" 78 }; 79// don't report C++ exceptions as coming from lines labelled with this - go deeper down the call stack 80const char skip_label[]="CROAK_SKIP"; 81 82bool report_position(pTHX_ COP* o) 83{ 84 const char* const file = CopFILE(o); 85 for (int i = 0, end = sizeof(skip_contexts) / sizeof(skip_contexts[0]); i < end; ++i) { 86 if (strstr(file, skip_contexts[i])) return false; 87 } 88 89 STRLEN label_len = 0; 90 const char* const label = CopLABEL_len(o, &label_len); 91 if (label && label_len == sizeof(skip_label)-1 && !strncmp(label, skip_label, label_len)) 92 return false; 93 94 sv_catpvf(ERRSV, " at %s line %d.\n", file, int(CopLINE(o))); 95 return true; 96} 97 98void raise_exception(pTHX) __attribute__noreturn__; 99 100void raise_exception(pTHX_ const AnyString& errmsg) __attribute__noreturn__; 101 102void raise_exception(pTHX) 103{ 104 STRLEN l; 105 const char* errmsg = SvPV(ERRSV, l); 106 if (l > 0 && errmsg[l-1] != '\n') { 107 if (!report_position(aTHX_ PL_curcop)) { 108 for (PERL_CONTEXT *cx_bottom=cxstack, *cx=cx_bottom+cxstack_ix; 109 cx >= cx_bottom && !(CxTYPE(cx)==CXt_SUB && report_position(aTHX_ cx->blk_oldcop)); 110 --cx) ; 111 } 112 } 113 Perl_croak(aTHX_ Nullch); 114} 115 116void raise_exception(pTHX_ const AnyString& errmsg) 117{ 118 sv_setpvn(ERRSV, errmsg.ptr, errmsg.len); 119 raise_exception(aTHX); 120} 121 122template <typename T> 123class localize_var { 124public: 125 using Tptr = T*; 126 localize_var(Tptr& global_var_, const Tptr new_value) 127 : global_var(global_var_) 128 , saved_value(global_var_) 129 { 130 global_var = new_value; 131 } 132 133 ~localize_var() 134 { 135 global_var = saved_value; 136 } 137 138private: 139 localize_var(const localize_var&) = delete; 140 localize_var(localize_var&&) = delete; 141 142 Tptr& global_var; 143 const Tptr saved_value; 144}; 145 146template <typename Expr> 147auto guarded_call(pTHX_ const Expr& expr) -> decltype(expr()) 148{ 149 try { return expr(); } 150 catch (const pm::perl::exception&) {} 151 catch (const std::exception& ex) { 152 sv_setpv(ERRSV, ex.what()); 153 } 154 catch (...) { 155 sv_setpv(ERRSV, "unknown exception"); 156 } 157 raise_exception(aTHX); 158} 159 160template <typename Expr> 161auto guarded_call(pTHX_ const Expr& expr, const base_vtbl* t) -> decltype(expr()) 162{ 163 localize_var<const base_vtbl> loc(cur_class_vtbl, t); 164 return guarded_call(aTHX_ expr); 165} 166 167template <typename Expr> 168auto guarded_call(pTHX_ const Expr& expr, const CV* cv) 169{ 170 localize_var<const CV> loc(cur_wrapper_cv, cv); 171 return guarded_call(aTHX_ expr); 172} 173 174const uint8_t read_only_flag = uint8_t(ValueFlags::read_only); 175 176template <typename VTable> 177const VTable* get_vtable(SV* descr) 178{ 179 return reinterpret_cast<const VTable*>(SvPVX(PmArray(descr)[TypeDescr_vtbl_index])); 180} 181 182} 183 184int canned_dup(pTHX_ MAGIC* mg, CLONE_PARAMS* param) 185{ 186 return 0; 187} 188 189MAGIC* allocate_canned_magic(pTHX_ SV* sv, SV* descr, ValueFlags flags, unsigned int n_anchors) 190{ 191 const auto t = get_vtable<base_vtbl>(descr); 192 (t->sv_maker)(aTHX_ sv, descr, flags, n_anchors); 193 return SvMAGIC(SvRV(sv)); 194} 195 196int destroy_canned(pTHX_ SV* sv, MAGIC* mg) 197{ 198 if (!(mg->mg_flags & MGf_GSKIP)) { 199 if (mg->mg_len) { 200 const auto t = as_vtbl<base_vtbl>(mg); 201 if (t->destructor) (t->destructor)(mg->mg_ptr); 202 } 203 if (mg->mg_private) { 204 for (Value::Anchor *anchor_ptr = MagicAnchors::first(mg), *anchor_end = anchor_ptr+mg->mg_private; 205 anchor_ptr < anchor_end; ++anchor_ptr) 206 SvREFCNT_dec(anchor_ptr->stored); 207 } 208 } 209 return 0; 210} 211 212namespace { 213 214void defuse_lval_magic(pTHX_ SV* sv) 215{ 216 MGS *mgs; 217 I32 mgs_ix; 218 assert(PL_savestack[PL_savestack_ix-1].any_uv == SAVEt_DESTRUCTOR_X); 219 mgs_ix = static_cast<I32>(PL_savestack[PL_savestack_ix-2].any_uv); 220 mgs = SSPTR(mgs_ix, MGS*); 221 assert(mgs->mgs_sv == sv); 222 mgs->mgs_flags = 0; 223 SvMAGIC(sv) = nullptr; 224} 225 226int assigned_to_canned_lvalue(pTHX_ SV* lval_sv, MAGIC* lval_mg) 227{ 228 SV* sv = lval_mg->mg_obj; 229 MAGIC* mg = get_cpp_magic(sv); 230 const int local = PL_localizing; 231 232 if (local != 0) { 233 // can happen during map or foreach iteration over a container, 234 // some nested function tries to localize $_ 235 if (local == 1) defuse_lval_magic(aTHX_ lval_sv); 236 } else if ((mg->mg_flags & read_only_flag) || 237 SvIVX(as_vtbl<base_vtbl>(mg)->mutable_ref_typeid_name_sv) == 0) { 238 // a read-only reference or an immutable object 239 switch (PL_op->op_type) { 240 case OP_AASSIGN: 241 case OP_SASSIGN: 242 case OP_ORASSIGN: 243 case OP_ANDASSIGN: 244 // for these operations it's safe (and the only possibility) 245 // to raise the exception right here 246 raise_exception(aTHX_ "Attempt to modify a read-only C++ object"); 247 default: 248 // all others like += or *= will complain in the operator body 249 // raising an exception here leads to memory leaks 250 break; 251 } 252 } else { 253 const auto t = as_vtbl<base_vtbl>(mg); 254 guarded_call(aTHX_ [=](){ (t->assignment)(mg->mg_ptr, lval_sv, ValueFlags::not_trusted); }); 255 if (SvROK(lval_sv)) { 256 if (SvRV(lval_sv)==sv) return 0; 257 SvREFCNT_dec(SvRV(lval_sv)); 258 } else { 259 if (SvPOK(lval_sv) && SvPVX(lval_sv) && SvLEN(lval_sv)) { 260#if PerlVersion >= 5200 261 if (SvIsCOW(lval_sv)) { 262 sv_force_normal_flags(lval_sv, SV_COW_DROP_PV); 263 } else 264#endif 265 { 266 Safefree(SvPVX(lval_sv)); 267 SvPVX(lval_sv) = nullptr; 268 SvLEN(lval_sv) = 0; 269 } 270 } 271 SvFLAGS(lval_sv) &= ~SVf_OK; 272 SvROK_on(lval_sv); 273 } 274 SvRV(lval_sv) = SvREFCNT_inc_simple_NN(sv); 275 } 276 return 0; 277} 278 279MGVTBL magic_lval_vtbl={ 0, &assigned_to_canned_lvalue, 0, 0, 0 }; 280 281void destroy_iterators(pTHX_ AV* av, MAGIC* mg, bool final) 282{ 283 SV* it_sv = AvARRAY(av)[1]; 284 auto acct = as_vtbl<container_vtbl>(mg)->acc + (mg->mg_flags & read_only_flag); 285 if (it_sv && SvIOK(it_sv)) { 286 if (acct->destructor) (acct->destructor)(SvPVX(it_sv)); 287 SvIOK_off(it_sv); 288 } 289 if (final) SvREFCNT_dec(it_sv); 290 291 acct += 2; 292 if (acct->begin) { 293 it_sv=AvARRAY(av)[2]; 294 if (it_sv && SvIOK(it_sv)) { 295 if (acct->destructor) (acct->destructor)(SvPVX(it_sv)); 296 SvIOK_off(it_sv); 297 } 298 if (final) SvREFCNT_dec(it_sv); 299 } 300} 301 302void destroy_assoc_iterator(pTHX_ HV* hv, MAGIC* mg) 303{ 304 const auto acct = as_vtbl<container_vtbl>(mg)->acc + (mg->mg_flags & read_only_flag); 305 char* it = (char*)HvARRAY(hv); 306 if (it[acct->obj_size]) { 307 if (acct->destructor) (acct->destructor)(it); 308 Zero(it, HvMAX(hv)+1, HE*); 309 } 310} 311 312#ifdef SVs_PADBUSY 313# define SaveSVflags (SVs_PADBUSY | SVs_PADTMP | SVs_PADMY | SVs_TEMP) 314#else 315# define SaveSVflags (SVs_PADTMP | SVs_PADMY | SVs_TEMP) 316#endif 317 318SV* new_magic_ref(pTHX_ SV* dst_ref, SV* sv, SV* pkg_ref, ValueFlags flags) 319{ 320 if (!(SvTYPE(dst_ref)==SVt_PVLV && (LvTYPE(dst_ref)=='t' || LvTYPE(dst_ref)==0))) { 321 if (SvTYPE(dst_ref)) { 322 U32 refc=SvREFCNT(dst_ref), 323 save_flags=SvFLAGS(dst_ref) & SaveSVflags; 324 SvREFCNT(dst_ref)=0; 325 sv_clear(dst_ref); 326 SvREFCNT(dst_ref)=refc; 327 SvFLAGS(dst_ref)=save_flags; 328 } 329 sv_upgrade(dst_ref, flags * ValueFlags::expect_lval ? SVt_PVLV : SVt_RV); 330 } 331 SvRV_set(dst_ref,sv); 332 SvROK_on(dst_ref); 333 if (flags * ValueFlags::expect_lval) 334 sv_magicext(dst_ref, sv, PERL_MAGIC_ext, &magic_lval_vtbl, 0, 0); 335 336 return SvROK(pkg_ref) ? sv_bless(dst_ref, (HV*)SvRV(pkg_ref)) : dst_ref; 337} 338 339#undef SaveSVflags 340 341MAGIC* allocate_magic(pTHX_ SV* sv, char how, const base_vtbl* vtab, ValueFlags flags, unsigned int n_anchors) 342{ 343 const size_t mgsz = n_anchors ? sizeof(MagicAnchors) + (n_anchors-1) * sizeof(Value::Anchor) : sizeof(MAGIC); 344 char* mg_raw; 345 Newxz(mg_raw, mgsz, char); 346 MagicAnchors* anch = (MagicAnchors*)mg_raw; 347 MAGIC* mg = &anch->magic; 348 mg->mg_moremagic = SvMAGIC(sv); 349 SvMAGIC_set(sv, mg); 350 mg->mg_type = how; 351 mg->mg_private = U16(n_anchors); 352 if (flags * ValueFlags::alloc_magic) { 353 mg->mg_len = vtab->obj_size; 354 Newxz(mg->mg_ptr, vtab->obj_size, char); 355 } 356 mg->mg_virtual = const_cast<base_vtbl*>(vtab); 357 mg_magical(sv); 358 return mg; 359} 360 361SV* new_builtin_magic_sv(pTHX_ const base_vtbl* t, ValueFlags flags, unsigned int n_anchors) 362{ 363 SV* sv = newSV_type(SVt_PVMG); 364 allocate_magic(aTHX_ sv, PERL_MAGIC_ext, t, flags, n_anchors); 365 return sv; 366} 367 368SV* prepare_scalar_magic_sv(pTHX_ SV* sv, const base_vtbl* t, ValueFlags flags, unsigned int n_anchors) 369{ 370 MAGIC* mg = allocate_magic(aTHX_ sv, PERL_MAGIC_ext, t, flags, n_anchors); 371 set_bit_flags(mg->mg_flags, I32(flags & ValueFlags::read_only) | I32(SvIVX(t->typeid_name_sv))); 372 SvRMAGICAL_on(sv); 373 return sv; 374} 375 376SV* new_container_magic_sv(pTHX_ const container_vtbl* t, ValueFlags flags, unsigned int n_anchors) 377{ 378 AV* av = newAV(); 379 const int last_it = t->acc[2].begin ? 2 : 1; // has reverse_iterator? 380 av_extend(av, last_it); 381 AvARRAY(av)[0] = reinterpret_cast<SV *>((IV)-1); // loop context index 382 AvFILLp(av) = -1; // cached real container size 383 AvREAL_off(av); // we'll destroy the iterator SVs manually 384 385 MAGIC* mg = allocate_magic(aTHX_ (SV*)av, PERL_MAGIC_tied, t, flags, n_anchors); 386 set_bit_flags(mg->mg_flags, MGf_COPY | I32(flags & ValueFlags::read_only) | I32(SvIVX(t->typeid_name_sv))); 387 SvRMAGICAL_on(av); 388 return (SV*)av; 389} 390 391SV* new_composite_magic_sv(pTHX_ const composite_vtbl* t, ValueFlags flags, unsigned int n_anchors) 392{ 393 AV* av = newAV(); 394 MAGIC* mg = allocate_magic(aTHX_ (SV*)av, PERL_MAGIC_tied, t, flags, n_anchors); 395 set_bit_flags(mg->mg_flags, MGf_COPY | I32(flags & ValueFlags::read_only) | I32(SvIVX(t->typeid_name_sv))); 396 SvRMAGICAL_on(av); 397 return (SV*)av; 398} 399 400SV* new_assoc_container_magic_sv(pTHX_ const container_vtbl* t, ValueFlags flags, unsigned int n_anchors) 401{ 402 HV* hv = newHV(); 403 MAGIC* mg; 404 const container_access_vtbl* acct = t->acc + int(flags & ValueFlags::read_only); 405 // let it reserve at least one additional byte after the iterator to hold the 'iterator created' flag 406 HvMAX(hv) = acct->obj_size/sizeof(HE*)+1; 407 hv_iterinit(hv); 408 mg = allocate_magic(aTHX_ (SV*)hv, PERL_MAGIC_tied, t, flags, n_anchors); 409 set_bit_flags(mg->mg_flags, MGf_COPY | I32(flags & ValueFlags::read_only) | I32(SvIVX(t->typeid_name_sv))); 410 SvRMAGICAL_on(hv); 411 return (SV*)hv; 412} 413 414SV* call_extractor(type_reg_fn_type func, bool get_proto) 415{ 416 const auto p = func(nullptr, nullptr, nullptr); 417 return get_proto ? p.first : p.second; 418} 419 420SV* call_extractor(provide_type func, bool) 421{ 422 return func(); 423} 424 425template <typename VTable, typename ExtractorFunc> 426SV* extract_type_info(pTHX_ SV* descr, ExtractorFunc VTable::* func_mem, ClassFlags mask, ClassFlags expected, bool get_proto = false) 427{ 428 const auto t = get_vtable<VTable>(descr); 429 if ((t->flags & mask) == expected) { 430 if (const ExtractorFunc func = t->*func_mem) { 431 return guarded_call(aTHX_ [=](){ return call_extractor(func, get_proto); }, t); 432 } 433 } 434 return &PL_sv_undef; 435} 436 437int get_sizeof(pTHX_ HV* stash) 438{ 439 dSP; 440 CV* sizeof_cv = GvCV((GV*)*hv_fetch(stash, "sizeof", 6, FALSE)); 441 PUSHMARK(SP); 442 call_sv((SV*)sizeof_cv, G_SCALAR); 443 SPAGAIN; 444 IV s = POPi; 445 PUTBACK; 446 return I32(s); 447} 448 449int count_refs(pTHX_ SV* ref, SV* obj, bool ref_is_known) 450{ 451 if (ref_is_known || SvROK(ref) && SvRV(ref) == obj) { 452 // magic lvalue objects are refcounted twice, for the direct object reference and for mg_obj 453 if (SvTYPE(ref) >= SVt_PVMG) { 454 MAGIC* mg = SvMAGIC(ref); 455 if (mg && mg->mg_virtual == &magic_lval_vtbl && 456 (mg->mg_flags & MGf_REFCOUNTED) && mg->mg_obj == obj) 457 return 2; 458 } 459 return 1; 460 } 461 return 0; 462} 463 464bool is_temporary(pTHX_ SV* ref, SV* obj) 465{ 466 // An object is deemed temporary and movable if: 467 // - it's pointed to by a single reference 468 // - that reference is kept in the argument list which has been "reified" by taking a reference when passing it to resolve_node or resolve_auto_function 469 // - that reference is a temporary variable 470 471 if ((SvFLAGS(ref) & SVs_PADTMP) || SvREFCNT(ref) != 2) 472 return false; 473 474 int obj_refc = SvREFCNT(obj); 475#if PerlVersion >= 5240 476 if (obj_refc == count_refs(aTHX_ ref, obj, true)) { 477 return std::find(PL_tmps_stack, PL_tmps_stack+PL_tmps_ix, ref) != PL_tmps_stack+PL_tmps_ix; 478 } 479#else 480 // In perls older than 5.24 there can be duplicate temporary references produced in pp_leave closing the wrappers where the object has been created. 481 if (obj_refc <= 3) { 482 for (SV **tmps_bottom = PL_tmps_stack, **tmps = tmps_bottom + PL_tmps_ix-1; tmps >= tmps_bottom; --tmps) { 483 SV* sv = *tmps; 484 if (int c = count_refs(aTHX_ sv, obj, sv == ref)) { 485 if (!(obj_refc -= c)) return true; 486 } 487 } 488 } 489#endif 490 return false; 491} 492 493} // end anonymous namespace 494 495int assigned_to_primitive_lvalue(pTHX_ SV* lval_sv, MAGIC* lval_mg) 496{ 497 const int local = PL_localizing; 498 if (local != 0) { 499 /* can happen during map or foreach iteration over a container, 500 some nested function tries to localize $_ */ 501 if (local == 1) defuse_lval_magic(aTHX_ lval_sv); 502 } else if (lval_mg->mg_flags & read_only_flag) { 503 raise_exception(aTHX_ "Attempt to modify an element in a read-only C++ object"); 504 } else { 505 const auto t = as_vtbl<base_vtbl>(lval_mg); 506 guarded_call(aTHX_ [=](){ (t->assignment)(lval_mg->mg_ptr, lval_sv, ValueFlags::not_trusted); }); 507 } 508 return 0; 509} 510 511mg_size_ret_t canned_container_size(pTHX_ SV* sv, MAGIC* mg) 512{ 513 const auto t = as_vtbl<container_vtbl>(mg); 514 Int s; 515 if (mg->mg_flags & read_only_flag) { 516 // can cache the size 517 if (AvFILLp(sv) < 0) 518 AvFILLp(sv) = (t->size)(mg->mg_ptr); 519 s = AvFILLp(sv); 520 } else { 521 s = (t->size)(mg->mg_ptr); 522 } 523 if (sizeof(mg_size_ret_t) < sizeof(Int) && 524 static_cast<inherit_signed_t<Int, mg_size_ret_t>>(s) >= std::numeric_limits<mg_size_ret_t>::max()) 525 Perl_croak(aTHX_ "container size exceeds the current perl implementation limit"); 526 return static_cast<mg_size_ret_t>(s-1); 527} 528 529int clear_canned_container(pTHX_ SV* sv, MAGIC* mg) 530{ 531 if (mg->mg_flags & read_only_flag) 532 raise_exception(aTHX_ "Attempt to modify a read-only C++ object"); 533 destroy_iterators(aTHX_ (AV*)sv, mg, false); 534 AvFILLp(sv) = -1; 535 return 1; 536} 537 538int clear_canned_assoc_container(pTHX_ SV *sv, MAGIC* mg) 539{ 540 const auto t = as_vtbl<container_vtbl>(mg); 541 if (mg->mg_flags & read_only_flag) 542 raise_exception(aTHX_ "Attempt to modify a read-only C++ object"); 543 destroy_assoc_iterator(aTHX_ (HV*)sv, mg); 544 guarded_call(aTHX_ [=](){ (t->resize)(mg->mg_ptr, 0); }); 545 return 1; 546} 547 548int destroy_canned_container(pTHX_ SV *sv, MAGIC* mg) 549{ 550 destroy_iterators(aTHX_ (AV*)sv, mg, true); 551 return destroy_canned(aTHX_ sv, mg); 552} 553 554int destroy_canned_assoc_container(pTHX_ SV *sv, MAGIC* mg) 555{ 556 destroy_assoc_iterator(aTHX_ (HV*)sv, mg); 557 return destroy_canned(aTHX_ sv, mg); 558} 559 560mg_size_ret_t canned_composite_size(pTHX_ SV *sv, MAGIC* mg) 561{ 562 const auto t = as_vtbl<composite_vtbl>(mg); 563 return t->n_members-1; // compatible to AvFILL 564} 565 566MAGIC* upgrade_to_builtin_magic_sv(pTHX_ SV* dst, SV* descr, unsigned int n_anchors) 567{ 568 (void)SvUPGRADE(dst, SVt_PVMG); 569 return allocate_magic(aTHX_ dst, PERL_MAGIC_ext, get_vtable<base_vtbl>(descr), ValueFlags::is_mutable, n_anchors); 570} 571 572SV* create_builtin_magic_sv(pTHX_ SV* dst_ref, SV* descr, ValueFlags flags, unsigned int n_anchors) 573{ 574 return new_magic_ref(aTHX_ dst_ref, 575 new_builtin_magic_sv(aTHX_ get_vtable<base_vtbl>(descr), flags, n_anchors), 576 PmArray(descr)[TypeDescr_pkg_index], flags); 577} 578 579SV* clone_builtin_magic_sv(pTHX_ SV* src) 580{ 581 MAGIC *mg=SvMAGIC(src); 582 return sv_bless(newRV_noinc(new_builtin_magic_sv(aTHX_ as_vtbl<base_vtbl>(mg), ValueFlags::alloc_magic, 0)), SvSTASH(src)); 583} 584 585SV* create_scalar_magic_sv(pTHX_ SV* dst_ref, SV* descr, ValueFlags flags, unsigned int n_anchors) 586{ 587 return new_magic_ref(aTHX_ dst_ref, 588 prepare_scalar_magic_sv(aTHX_ newSV_type(SVt_PVMG), get_vtable<base_vtbl>(descr), flags, n_anchors), 589 PmArray(descr)[TypeDescr_pkg_index], flags); 590} 591 592SV* clone_scalar_magic_sv(pTHX_ SV* src) 593{ 594 MAGIC* mg=SvMAGIC(src); 595 SV* sv=prepare_scalar_magic_sv(aTHX_ 596 SvFLAGS(src) & (SVf_ROK|SVf_POK|SVp_POK|SVf_IOK|SVp_IOK|SVf_NOK|SVp_NOK) 597 ? newSVsv(src) : newSV_type(SVt_PVMG), 598 as_vtbl<base_vtbl>(mg), ValueFlags::alloc_magic, 0); 599 return sv_bless(newRV_noinc(sv), SvSTASH(src)); 600} 601 602SV* create_container_magic_sv(pTHX_ SV* dst_ref, SV* descr, ValueFlags flags, unsigned int n_anchors) 603{ 604 return new_magic_ref(aTHX_ dst_ref, 605 new_container_magic_sv(aTHX_ get_vtable<container_vtbl>(descr), flags, n_anchors), 606 PmArray(descr)[TypeDescr_pkg_index], flags); 607} 608 609SV* clone_container_magic_sv(pTHX_ SV* src) 610{ 611 MAGIC* mg=get_cpp_magic(src); 612 return sv_bless(newRV_noinc(new_container_magic_sv(aTHX_ as_vtbl<container_vtbl>(mg), ValueFlags::alloc_magic, 0)), SvSTASH(src)); 613} 614 615SV* create_composite_magic_sv(pTHX_ SV* dst_ref, SV* descr, ValueFlags flags, unsigned int n_anchors) 616{ 617 return new_magic_ref(aTHX_ dst_ref, 618 new_composite_magic_sv(aTHX_ get_vtable<composite_vtbl>(descr), flags, n_anchors), 619 PmArray(descr)[TypeDescr_pkg_index], flags); 620} 621 622SV* clone_composite_magic_sv(pTHX_ SV* src) 623{ 624 MAGIC* mg=get_cpp_magic(src); 625 return sv_bless(newRV_noinc(new_composite_magic_sv(aTHX_ as_vtbl<composite_vtbl>(mg), ValueFlags::alloc_magic, 0)), SvSTASH(src)); 626} 627 628SV* create_assoc_container_magic_sv(pTHX_ SV* dst_ref, SV* descr, ValueFlags flags, unsigned int n_anchors) 629{ 630 return new_magic_ref(aTHX_ dst_ref, 631 new_assoc_container_magic_sv(aTHX_ get_vtable<container_vtbl>(descr), flags, n_anchors), 632 PmArray(descr)[TypeDescr_pkg_index], flags); 633} 634 635SV* clone_assoc_container_magic_sv(pTHX_ SV* src) 636{ 637 MAGIC* mg=get_cpp_magic(src); 638 return sv_bless(newRV_noinc(new_assoc_container_magic_sv(aTHX_ as_vtbl<container_vtbl>(mg), ValueFlags::alloc_magic, 0)), SvSTASH(src)); 639} 640 641namespace { 642 643constexpr bool is_random_access_op(const OPCODE opc) 644{ 645 return opc == OP_AELEM || opc == OP_ASLICE 646#if PerlVersion >= 5220 647 || opc == OP_MULTIDEREF 648#endif 649 ; 650} 651 652template <typename ContainerVtbl, typename AccessVtbl> 653int dereference_iterator(pTHX_ const ContainerVtbl* t, const AccessVtbl* acct, char* obj, char* it, SV* sv, SV* nsv, Int index) 654{ 655 if (SvOK(nsv)) { 656 // we are called from av_store (during aassign): nsv carries the RHS value 657 guarded_call(aTHX_ [=](){ (t->store_at_ref)(obj, it, index, nsv); }, t); 658 } else { 659 guarded_call(aTHX_ [=](){ (acct->deref)(obj, it, index, nsv, sv); }, t); 660 } 661 return 1; 662} 663 664template <typename ContainerVtbl, typename AccessVtbl> 665int dereference_new_iterator(pTHX_ const ContainerVtbl* t, const AccessVtbl* acct, char* obj, SV* it_sv, char* it, SV* sv, SV* nsv, Int index) 666{ 667 guarded_call(aTHX_ [=](){ (acct->begin)(it, obj); }); 668 SvIVX(it_sv) = index; 669 SvIOK_on(it_sv); 670 return dereference_iterator(aTHX_ t, acct, obj, it, sv, nsv, index); 671} 672 673} 674 675int canned_container_access(pTHX_ SV* sv, MAGIC* mg, SV* nsv, const char* dummy, const mg_copy_index_t index) 676{ 677 const OPCODE opc = PL_op ? PL_op->op_type : OP_AELEM; // assume a plain array access when called directly from the callable library 678 auto t = as_vtbl<container_vtbl>(mg); 679 char* obj = mg->mg_ptr; 680 char* it; 681 auto acct = t->acc + (mg->mg_flags & read_only_flag); 682 AV* my_av = (AV*)sv; 683 SV* it_sv; 684 Int it_index, it_incr; 685 686 if (opc == OP_ITER) { 687 int cix = cxstack_ix; 688 PERL_CONTEXT* cx = cxstack + cix; 689 if (cx->blk_loop.state_u.ary.ary == my_av) { 690 // direct iterating over a C++ container: each loop requires its own iterator 691 if (PL_op->op_private & OPpITER_REVERSED) { 692 it_index = 2; it_incr = -1; acct += 2; 693 } else { 694 it_index = 1; it_incr = 1; 695 } 696 if (AvARRAY(my_av)[0] != reinterpret_cast<SV*>(static_cast<IV>(cix))) { 697 // new loop detected: need a new iterator 698 699 if (!acct->begin) 700 raise_exception(aTHX_ "No access in reverse order"); 701 702 if (SvREFCNT(sv) > 1) { 703 // Create a temporary magical array sharing the C++ object and store it as the loop's array. 704 // It will be recycled automatically after the loop completion. 705 SvREFCNT_dec(sv); 706 sv = new_container_magic_sv(aTHX_ t, ValueFlags(mg->mg_flags) & ValueFlags::read_only, 0); 707 my_av = (AV*)sv; 708 mg = SvMAGIC(sv); 709 mg->mg_ptr = obj; 710 cx->blk_loop.state_u.ary.ary = my_av; 711 } 712 AvARRAY(my_av)[0] = reinterpret_cast<SV*>(static_cast<IV>(cix)); 713 AvARRAY(my_av)[it_index] = it_sv = newSV_type(SVt_PVIV); 714 sv_grow(it_sv, acct->obj_size); 715 it = SvPVX(it_sv); 716 return dereference_new_iterator(aTHX_ t, acct, obj, it_sv, it, sv, nsv, index); 717 } 718 719 it_sv = AvARRAY(my_av)[it_index]; 720 it = SvPVX(it_sv); 721 if ((SvIVX(it_sv) += it_incr) != index) 722 raise_exception(aTHX_ "Attempt to access array elements out of natural order"); 723 return dereference_iterator(aTHX_ t, acct, obj, it, sv, nsv, index); 724 } 725 726 } else if (is_random_access_op(opc) && acct->random) { 727 guarded_call(aTHX_ [=](){ (acct->random)(obj, nullptr, index, nsv, sv); }, t); 728 return 1; 729 } 730 731 if (index >= 0) { 732 it_incr = 1; it_index = 1; 733 } else { 734 it_incr = -1; it_index = 2; 735 acct += 2; 736 } 737 it_sv = AvARRAY(my_av)[it_index]; 738 if (it_sv && SvIOK(it_sv)) { 739 // iterator already created 740 it = SvPVX(it_sv); 741 if ((SvIVX(it_sv) += it_incr) == index) 742 return dereference_iterator(aTHX_ t, acct, obj, it, sv, nsv, index); 743 if (acct->destructor) 744 (acct->destructor)(it); 745 SvIOK_off(it_sv); 746 } else { 747 AvARRAY(my_av)[it_index] = it_sv = newSV_type(SVt_PVIV); 748 sv_grow(it_sv, acct->obj_size); 749 it = SvPVX(it_sv); 750 } 751 752 if (index != 0) { 753 if (index == -1) { 754 if (!acct->begin) 755 raise_exception(aTHX_ "No access in reverse order"); 756 } else { 757 if (is_random_access_op(opc)) 758 raise_exception(aTHX_ "No random access"); 759 else 760 raise_exception(aTHX_ "Attempt to access array elements out of natural order"); 761 } 762 } 763 return dereference_new_iterator(aTHX_ t, acct, obj, it_sv, it, sv, nsv, index); 764} 765 766int canned_assoc_container_access(pTHX_ SV* obj_sv, MAGIC* mg, SV* val_sv, const char* key, mg_copy_index_t klen) 767{ 768 const auto t = as_vtbl<container_vtbl>(mg); 769 const auto acct = t->acc + (mg->mg_flags & read_only_flag); 770 char* it = reinterpret_cast<char*>(HvARRAY(obj_sv)); 771 guarded_call(aTHX_ [=](){ (acct->deref)(nullptr, it, 1, val_sv, obj_sv); }, t); 772 return 1; 773} 774 775int canned_composite_access(pTHX_ SV* sv, MAGIC* mg, SV* nsv, const char *dummy, mg_copy_index_t index) 776{ 777 const auto t = as_vtbl<composite_vtbl>(mg); 778 const auto acct = t->acc + index; 779 char* obj = mg->mg_ptr; 780 781 if (SvOK(nsv)) { 782 // we are called from av_store (during aassign): nsv carries the RHS value 783 if (mg->mg_flags & read_only_flag) 784 raise_exception(aTHX_ "Attempt to modify a read-only C++ object"); 785 guarded_call(aTHX_ [=](){ (acct->store)(obj, nsv); }, t); 786 } else { 787 guarded_call(aTHX_ [=](){ (acct->get[mg->mg_flags & read_only_flag])(obj, nsv, sv); }, t); 788 } 789 return 1; 790} 791 792OP* cpp_helem(pTHX_ HV* hv, const MAGIC* mg) 793{ 794 dSP; 795 U8 save_private=PL_op->op_private; 796 const auto t = as_vtbl<container_vtbl>(mg); 797 TOPm1s=sv_2mortal(newRV((SV*)hv)); // Restore the reference to the map object 798 PUSHMARK(SP-2); 799 XPUSHs(AvARRAY(t->assoc_methods)[PL_op->op_flags & OPf_MOD ? CPP_Assoc_helem_index : CPP_Assoc_find_index]); 800 PUTBACK; 801 PL_op->op_flags |= OPf_STACKED; 802 PL_op->op_private=0; 803 OP* next=Perl_pp_entersub(aTHX); 804 PL_op->op_private=save_private; 805 return next; 806} 807 808OP* cpp_hslice(pTHX_ HV* hv, const MAGIC* mg) 809{ 810 dSP; 811 const auto t = as_vtbl<container_vtbl>(mg); 812 SV* brk_cv = AvARRAY(t->assoc_methods)[PL_op->op_flags & OPf_MOD ? CPP_Assoc_helem_index : CPP_Assoc_find_index]; 813 EXTEND(SP, 3); 814 dMARK; 815 SSize_t key = MARK - SP, key1 = key; 816 SV* val = nullptr; 817 I32 gimme = GIMME_V; 818 SV* hvref = sv_2mortal(newRV((SV*)hv)); 819 while (++key <= 0) { 820 ENTER; 821 PUSHMARK(SP); 822 val = SP[key]; 823 PUSHs(hvref); 824 PUSHs(val); 825 PUTBACK; 826 call_sv(brk_cv, G_SCALAR); 827 SPAGAIN; 828 val = POPs; 829 SP[key] = val; 830 LEAVE; 831 } 832 if (gimme != G_ARRAY) { 833 SP -= key1-1; 834 SETs(val); 835 } 836 RETURN; 837} 838 839OP* cpp_exists(pTHX_ HV* hv, const MAGIC* mg) 840{ 841 dSP; 842 U8 save_private = PL_op->op_private; 843 const auto t = as_vtbl<const container_vtbl>(mg); 844 TOPm1s = sv_2mortal(newRV((SV*)hv)); // Restore the reference to the map object 845 PUSHMARK(SP-2); 846 XPUSHs(AvARRAY(t->assoc_methods)[CPP_Assoc_exists_index]); 847 PUTBACK; 848 PL_op->op_flags |= OPf_STACKED; 849 PL_op->op_private = 0; 850 OP* next = Perl_pp_entersub(aTHX); 851 PL_op->op_private = save_private; 852 return next; 853} 854 855OP* cpp_delete_hslice(pTHX_ HV* hv, const MAGIC* mg) 856{ 857 dSP; 858 const auto t = as_vtbl<container_vtbl>(mg); 859 SV* hvref = sv_2mortal(newRV((SV*)hv)), *brk_cv; 860 I32 gimme = GIMME_V; 861 brk_cv = AvARRAY(t->assoc_methods)[gimme == G_VOID ? CPP_Assoc_delete_void_index : CPP_Assoc_delete_ret_index]; 862 I32 discard = gimme == G_VOID ? G_DISCARD : G_SCALAR; 863 EXTEND(SP,3); 864 dMARK; 865 SSize_t key = MARK - SP, key1 = key; 866 SV* val = nullptr; 867 while (++key <= 0) { 868 ENTER; 869 PUSHMARK(SP); 870 val = SP[key]; 871 PUSHs(hvref); 872 PUSHs(val); 873 PUTBACK; 874 call_sv(brk_cv, discard); 875 SPAGAIN; 876 if (gimme != G_VOID) { 877 val=POPs; SP[key]=val; 878 } 879 LEAVE; 880 } 881 if (gimme != G_ARRAY) { 882 SP -= key1; 883 if (gimme == G_SCALAR) *++SP = val; 884 } 885 RETURN; 886} 887 888OP* cpp_delete_helem(pTHX_ HV* hv, const MAGIC* mg) 889{ 890 dSP; 891 U8 save_private = PL_op->op_private; 892 const auto t = as_vtbl<container_vtbl>(mg); 893 I32 gimme = GIMME_V; 894 TOPm1s = sv_2mortal(newRV((SV*)hv)); // Restore the reference to the map object 895 PUSHMARK(SP-2); 896 XPUSHs(AvARRAY(t->assoc_methods)[gimme == G_VOID ? CPP_Assoc_delete_void_index : CPP_Assoc_delete_ret_index]); 897 PUTBACK; 898 PL_op->op_flags |= OPf_STACKED; 899 PL_op->op_private = 0; 900 OP* next = Perl_pp_entersub(aTHX); 901 PL_op->op_private = save_private; 902 return next; 903} 904 905OP* cpp_keycnt(pTHX_ HV* hv, const MAGIC* mg) 906{ 907 const auto t = as_vtbl<container_vtbl>(mg); 908 const Int s = (t->size)(mg->mg_ptr); 909 dSP; 910 SETs(sv_2mortal(newSViv(s))); 911 return NORMAL; 912} 913 914SSize_t cpp_hassign(pTHX_ HV* hv, MAGIC* mg, I32* firstRp, I32 lastR, bool return_size) 915{ 916 dSP; 917 I32 firstR = *firstRp; 918 clear_canned_assoc_container(aTHX_ (SV*)hv, mg); 919 if (firstR < lastR) { 920 const auto t = as_vtbl<container_vtbl>(mg); 921 SV* brk_cv = AvARRAY(t->assoc_methods)[CPP_Assoc_helem_index]; 922 EXTEND(SP, 3); 923 ENTER; SAVETMPS; 924 SV* hvref = sv_2mortal(newRV((SV*)hv)); 925 do { 926 PUSHMARK(SP); 927 PUSHs(hvref); 928 PUSHs(PL_stack_base[firstR]); ++firstR; 929 PUTBACK; 930 call_sv(brk_cv, G_SCALAR); 931 SPAGAIN; 932 SV* helem = POPs; 933 if (firstR <= lastR) { 934 SvSetMagicSV(helem, PL_stack_base[firstR]); ++firstR; 935 } else { 936 SvSetMagicSV(helem, &PL_sv_undef); 937 } 938 } while (firstR < lastR); 939 FREETMPS; LEAVE; 940 *firstRp = firstR; 941 if (return_size) 942 return (t->size)(mg->mg_ptr); 943 } 944 return 0; 945} 946 947bool cpp_has_assoc_methods(const MAGIC* mg) 948{ 949 return as_vtbl<container_vtbl>(mg)->assoc_methods != nullptr; 950} 951 952} } } // end namespace pm::perl 953 954using namespace pm::perl; 955using namespace pm::perl::glue; 956 957MODULE = Polymake::Core::CPlusPlus PACKAGE = Polymake::Core::CPlusPlus 958 959PROTOTYPES: DISABLE 960 961void assign_to_cpp_object(SV* obj, SV* value, SV* flags_sv) 962PPCODE: 963{ 964 MAGIC* mg = get_cpp_magic(SvRV(obj)); 965 const auto t = as_vtbl<base_vtbl>(mg); 966 const ValueFlags flags = (SvTRUE(flags_sv) ? ValueFlags::is_trusted : ValueFlags::not_trusted) | ValueFlags::ignore_magic; 967 PUTBACK; 968 guarded_call(aTHX_ [=](){ (t->assignment)(mg->mg_ptr, value, flags); }, t); 969 XSprePUSH; 970 PUSHs(obj); 971} 972 973void convert_to_string(SV* src, ...) 974PPCODE: 975{ 976 MAGIC* mg = get_cpp_magic(SvRV(src)); 977 const auto t = as_vtbl<common_vtbl>(mg); 978 PUTBACK; 979 SV* result = guarded_call(aTHX_ [=](){ return (t->to_string)(mg->mg_ptr); }); 980 XSprePUSH; 981 PUSHs(result); 982} 983 984void convert_to_serialized(SV* src, ...) 985PPCODE: 986{ 987 // TODO: rename to convert_to_tuple when the result becomes always a tuple 988 src = SvRV(src); 989 MAGIC* mg = get_cpp_magic(src); 990 const auto t = as_vtbl<common_vtbl>(mg); 991 PUTBACK; 992 SV* result = guarded_call(aTHX_ [=](){ return (t->to_serialized)(mg->mg_ptr, src); }, t); 993 XSprePUSH; 994 PUSHs(result); 995} 996 997void get_magic_typeid(SV* x, I32 arg_flags) 998PPCODE: 999{ 1000 SV* result = &PL_sv_undef; 1001 SV* obj; 1002 if (SvROK(x) && (obj=SvRV(x), SvOBJECT(obj))) { 1003 if (SvSTASH(obj) == TypeDescr_stash) { 1004 result = AvARRAY((AV*)obj)[TypeDescr_typeid_index]; 1005 } else if (MAGIC* mg = get_cpp_magic(obj)) { 1006 const auto t = as_vtbl<base_vtbl>(mg); 1007 if (arg_flags == arg_is_const_ref || mg->mg_flags & read_only_flag) { 1008 result = t->const_ref_typeid_name_sv; 1009 } else if (arg_flags == arg_is_lval_ref) { 1010 result = t->mutable_ref_typeid_name_sv; 1011 } else if (mg->mg_len != 0 && is_temporary(aTHX_ x, obj)) { 1012 // canned object, referenced solely from a temp ref living in the argument list: 1013 // can be moved if needed 1014 result = t->typeid_name_sv; 1015 } else if (arg_flags == arg_is_univ_ref) { 1016 result = t->mutable_ref_typeid_name_sv; 1017 } else { 1018 result = t->const_ref_typeid_name_sv; 1019 } 1020 } 1021 } 1022 PUSHs(result); 1023} 1024 1025void must_be_copied(SV* x, SV* for_temp, SV* will_be_lval_ref) 1026PPCODE: 1027{ 1028 MAGIC* mg; 1029 PUSHs(&PL_sv_yes); 1030 if (SvROK(x) && (x=SvRV(x), SvOBJECT(x) && (mg=get_cpp_magic(x)) && mg->mg_len)) { 1031 // is an object canned here 1032 if ((SvTRUE(for_temp) || as_vtbl<base_vtbl>(mg)->flags * ClassFlags::is_declared) 1033 // is of a declared property type, or it'll be just a temp value 1034 && !(SvTRUE(will_be_lval_ref) && 1035 ((mg->mg_flags & read_only_flag) || 1036 SvIVX(as_vtbl<base_vtbl>(mg)->mutable_ref_typeid_name_sv) == 0)) 1037 // can be passed by lvalue reference 1038 ) 1039 SETs(&PL_sv_no); 1040 } 1041} 1042 1043void composite_access(SV* src) 1044PPCODE: 1045{ 1046 src = SvRV(src); 1047 MAGIC* mg = get_cpp_magic(src); 1048 const auto t = as_vtbl<composite_vtbl>(mg); 1049 SV* result = sv_newmortal(); 1050 PUTBACK; 1051 guarded_call(aTHX_ [=](){ (t->acc[CvDEPTH(cv)].get[mg->mg_flags & read_only_flag])(mg->mg_ptr, result, src); }, t); 1052 XSprePUSH; 1053 PUSHs(result); 1054} 1055 1056void call_function(...) 1057PPCODE: 1058{ 1059 AV* descr = (AV*)CvXSUBANY(cv).any_ptr; 1060 const int n_args = CvDEPTH(cv); 1061 if (items != n_args) { 1062 PERL_CONTEXT *cx_bottom = cxstack, *cx = cx_bottom + cxstack_ix; 1063 while (cx >= cx_bottom) { 1064 if (CxTYPE(cx) == CXt_SUB) { 1065 cv = cx->blk_sub.cv; 1066 if (!skip_debug_sub(aTHX_ cv) && !CvANON(cv)) { 1067 GV* gv = CvGV(cv); 1068 sv_setpvf(ERRSV, 1069 "%.*s::%.*s : got %d argument(s) while %d expected", 1070 PmPrintHvNAME(GvSTASH(gv)), PmPrintGvNAME(gv), int(items), n_args); 1071 raise_exception(aTHX); 1072 } 1073 } 1074 --cx; 1075 } 1076 sv_setpvf(ERRSV, "ANONYMOUS C++ function : got %d argument(s) while %d expected", int(items), n_args); 1077 raise_exception(aTHX); 1078 } 1079 PUTBACK; 1080 const wrapper_type wrapper = reinterpret_cast<wrapper_type>(AvARRAY(descr)[FuncDescr_wrapper_index]); 1081 SV* ret = guarded_call(aTHX_ [=](){ return wrapper(SP+1); }, cv); 1082 SPAGAIN; 1083 if (ret) PUSHs(ret); 1084} 1085 1086void create_function_wrapper(SV* descr, SV* app_stash_ref, I32 n_args, SV* returns) 1087PPCODE: 1088{ 1089 AV* descr_av = (AV*)SvRV(descr); 1090 if (AvARRAY(descr_av)[FuncDescr_wrapper_index]) { 1091 SV* sub = newSV_type(SVt_PVCV); 1092 CvXSUB(sub) = &XS_Polymake__Core__CPlusPlus_call_function; 1093 CvFLAGS(sub) = CvFLAGS(cv) | CVf_ANON; 1094 CvDEPTH(sub) = n_args; 1095 CvXSUBANY(sub).any_ptr = descr_av; 1096 CvSTASH_set((CV*)sub, (HV*)SvRV(app_stash_ref)); 1097 1098 SV* type_reg_sv = AvARRAY(descr_av)[FuncDescr_return_type_reg_index]; 1099 if (type_reg_sv) { 1100 const auto type_reg_fn = reinterpret_cast<type_reg_fn_type>(type_reg_sv); 1101 SV* result_proto = nullptr; 1102 PUTBACK; 1103 if (SvPOK(returns)) { 1104 guarded_call(aTHX_ [=](){ type_reg_fn(returns, app_stash_ref, descr); }); 1105 } else if (SvROK(returns)) { 1106 // for containers, key and/or value types may also be prescribed 1107 if (SvTYPE(SvRV(returns)) != SVt_PVAV || AvFILLp(SvRV(returns)) < 1 || !SvPOK(PmArray(returns)[0])) 1108 Perl_croak(aTHX_ "Invalid return type description"); 1109 SV* container_descr = guarded_call(aTHX_ [=](){ return type_reg_fn(PmArray(returns)[0], app_stash_ref, descr).second; }); 1110 const auto vtbl = get_vtable<container_vtbl>(container_descr); 1111 if ((vtbl->flags & (ClassFlags::kind_mask | ClassFlags::is_assoc_container)) == ClassFlags::is_container) { 1112 if (AvFILLp(SvRV(returns)) != 1 || !SvPOK(PmArray(returns)[1])) 1113 Perl_croak(aTHX_ "Invalid container return type description"); 1114 guarded_call(aTHX_ [=](){ vtbl->provide_value_type(PmArray(returns)[1], app_stash_ref, descr); }); 1115 } else if ((vtbl->flags & (ClassFlags::kind_mask | ClassFlags::is_assoc_container)) == (ClassFlags::is_container | ClassFlags::is_assoc_container)) { 1116 if (AvFILLp(SvRV(returns)) != 2) 1117 Perl_croak(aTHX_ "Invalid associative container return type description"); 1118 if (SvPOK(PmArray(returns)[1])) { 1119 guarded_call(aTHX_ [=](){ vtbl->provide_key_type(PmArray(returns)[1], app_stash_ref, descr); }); 1120 } 1121 if (SvPOK(PmArray(returns)[2])) { 1122 guarded_call(aTHX_ [=](){ vtbl->provide_value_type(PmArray(returns)[2], app_stash_ref, descr); }); 1123 } 1124 } else { 1125 Perl_croak(aTHX_ "Invalid return type description: is not a container"); 1126 } 1127 } else { 1128 result_proto = guarded_call(aTHX_ [=](){ return type_reg_fn(nullptr, nullptr, descr).first; }); 1129 } 1130 SPAGAIN; 1131 if (result_proto) 1132 AvARRAY(descr_av)[FuncDescr_return_type_index] = SvREFCNT_inc_simple_NN(result_proto); 1133 } 1134 if (SvIOK(returns) && SvIVX(returns) == returns_lvalue_flag) 1135 CvFLAGS(sub) |= CVf_LVALUE | CVf_NODEBUG; 1136 1137 PUSHs(sv_2mortal(newRV_noinc(sub))); 1138 } 1139} 1140 1141void overload_clone_op(SV* ref, ...) 1142PPCODE: 1143{ 1144 SV* obj = SvRV(ref); 1145 if (SvTYPE(ref) == SVt_PVLV) { 1146 // It's the result of a lvalue function (like container random access). 1147 // The second reference to the object is stored in the ref's set-magic. 1148 // We shall return the same reference, it won't be checked by perl afterwards. 1149 ++SP; 1150 } else { 1151 MAGIC* mg = get_cpp_magic(obj); 1152 const auto t = as_vtbl<base_vtbl>(mg); 1153 if (!(mg->mg_flags & read_only_flag) && t->copy_constructor) { 1154 // Should clone only if persistent and really mutable 1155 SV* copy = (t->sv_cloner)(aTHX_ obj); 1156 PUTBACK; 1157 guarded_call(aTHX_ [=](){ (t->copy_constructor)(SvMAGIC(SvRV(copy))->mg_ptr, mg->mg_ptr); }); 1158 XSprePUSH; 1159 PUSHs(sv_2mortal(copy)); 1160 } else { 1161 ++SP; 1162 } 1163 } 1164} 1165 1166void convert_to_Int(SV* proto, SV* obj) 1167PPCODE: 1168{ 1169 dTARGET; 1170 const Int result = guarded_call(aTHX_ [=](){ return pm::perl::Scalar::convert_to_Int(obj); }); 1171 PUSHi(result); 1172 PERL_UNUSED_ARG(proto); 1173} 1174 1175void convert_to_Float(SV* proto, SV* obj) 1176PPCODE: 1177{ 1178 dTARGET; 1179 const double result = guarded_call(aTHX_ [=](){ return pm::perl::Scalar::convert_to_Float(obj); }); 1180 PUSHn(result); 1181 PERL_UNUSED_ARG(proto); 1182} 1183 1184void classify_scalar(SV* x ,...) 1185PPCODE: 1186{ 1187 // @retval: 0 - string, 1 - double, 2 - Int, 3 - bool, undef - the rest 1188 dTARGET; 1189 const bool require_numeric = items == 2 && SvTRUE(ST(1)); 1190 if (x == &PL_sv_yes || x == &PL_sv_no) { 1191 PUSHi(require_numeric ? 2 : 3); 1192 } else if (SvIOK(x)) { 1193 PUSHi(2); 1194 } else if (SvNOK(x)) { 1195 PUSHi(1); 1196 } else if (SvPOK(x)) { 1197 int flags; 1198 if (SvCUR(x) > 0 && (flags = looks_like_number(x)) != 0) { 1199 if ((flags & (IS_NUMBER_NOT_INT | IS_NUMBER_IN_UV)) == IS_NUMBER_IN_UV) 1200 PUSHi(2); 1201 else 1202 PUSHi(1); 1203 } else { 1204 PUSHs(require_numeric ? &PL_sv_undef : &PL_sv_no); 1205 } 1206 } else { 1207 PUSHs(&PL_sv_undef); 1208 } 1209} 1210 1211void demangle(const char* sym) 1212PPCODE: 1213{ 1214 dTARGET; 1215 std::string s = polymake::legible_typename(sym); 1216 PUSHp(s.c_str(), s.size()); 1217} 1218 1219MODULE = Polymake::Core::CPlusPlus PACKAGE = Polymake::Core::CPlusPlus::TypeDescr 1220 1221void value_type(SV* descr) 1222PPCODE: 1223{ 1224 PUTBACK; 1225 SV* result=extract_type_info(aTHX_ descr, &container_vtbl::provide_value_type, 1226 ClassFlags::kind_mask, ClassFlags::is_container, true); 1227 XSprePUSH; 1228 PUSHs(result); 1229} 1230 1231void value_descr(SV* descr) 1232PPCODE: 1233{ 1234 PUTBACK; 1235 SV* result=extract_type_info(aTHX_ descr, &container_vtbl::provide_value_type, 1236 ClassFlags::kind_mask, ClassFlags::is_container); 1237 XSprePUSH; 1238 PUSHs(result); 1239} 1240 1241void element_type(SV* descr) 1242PPCODE: 1243{ 1244 PUTBACK; 1245 SV* result=extract_type_info(aTHX_ descr, &container_vtbl::provide_key_type, 1246 ClassFlags::kind_mask | ClassFlags::is_assoc_container, ClassFlags::is_container, true); 1247 XSprePUSH; 1248 PUSHs(result); 1249} 1250 1251void element_descr(SV* descr) 1252PPCODE: 1253{ 1254 PUTBACK; 1255 SV* result=extract_type_info(aTHX_ descr, &container_vtbl::provide_key_type, 1256 ClassFlags::kind_mask | ClassFlags::is_assoc_container, ClassFlags::is_container); 1257 XSprePUSH; 1258 PUSHs(result); 1259} 1260 1261void key_type(SV* descr) 1262PPCODE: 1263{ 1264 PUTBACK; 1265 SV* result=extract_type_info(aTHX_ descr, &container_vtbl::provide_key_type, 1266 ClassFlags::kind_mask | ClassFlags::is_assoc_container, ClassFlags::is_container | ClassFlags::is_assoc_container, true); 1267 XSprePUSH; 1268 PUSHs(result); 1269} 1270 1271void key_descr(SV* descr) 1272PPCODE: 1273{ 1274 PUTBACK; 1275 SV* result=extract_type_info(aTHX_ descr, &container_vtbl::provide_key_type, 1276 ClassFlags::kind_mask | ClassFlags::is_assoc_container, ClassFlags::is_container | ClassFlags::is_assoc_container); 1277 XSprePUSH; 1278 PUSHs(result); 1279} 1280 1281void member_types(SV* descr) 1282PPCODE: 1283{ 1284 PUTBACK; 1285 SV* result=extract_type_info(aTHX_ descr, &composite_vtbl::provide_member_types, 1286 ClassFlags::kind_mask, ClassFlags::is_composite); 1287 XSprePUSH; 1288 PUSHs(result); 1289} 1290 1291void member_descrs(SV* descr) 1292PPCODE: 1293{ 1294 PUTBACK; 1295 SV* result=extract_type_info(aTHX_ descr, &composite_vtbl::provide_member_descrs, 1296 ClassFlags::kind_mask, ClassFlags::is_composite); 1297 XSprePUSH; 1298 PUSHs(result); 1299} 1300 1301void member_names(SV* descr) 1302PPCODE: 1303{ 1304 PUTBACK; 1305 SV* result=extract_type_info(aTHX_ descr, &composite_vtbl::provide_member_names, 1306 ClassFlags::kind_mask, ClassFlags::is_composite); 1307 XSprePUSH; 1308 PUSHs(result); 1309} 1310 1311void num_members(SV* descr) 1312PPCODE: 1313{ 1314 dTARGET; 1315 const auto t = get_vtable<composite_vtbl>(descr); 1316 if ((t->flags & ClassFlags::kind_mask) == ClassFlags::is_composite) 1317 PUSHi(t->n_members); 1318 else 1319 PUSHs(&PL_sv_undef); 1320} 1321 1322void serialized_type(SV* descr) 1323PPCODE: 1324{ 1325 // TODO: rename to tuple_type 1326 PUTBACK; 1327 SV* result=extract_type_info(aTHX_ descr, &common_vtbl::provide_serialized_type, 1328 ClassFlags::is_serializable, ClassFlags::is_serializable, true); 1329 XSprePUSH; 1330 PUSHs(result); 1331} 1332 1333void serialized_descr(SV* descr) 1334PPCODE: 1335{ 1336 // TODO: rename to tuple_descr 1337 PUTBACK; 1338 SV* result=extract_type_info(aTHX_ descr, &common_vtbl::provide_serialized_type, 1339 ClassFlags::is_serializable, ClassFlags::is_serializable); 1340 XSprePUSH; 1341 PUSHs(result); 1342} 1343 1344void dimension(SV* descr) 1345PPCODE: 1346{ 1347 dTARGET; 1348 const auto t = get_vtable<base_vtbl>(descr); 1349 PUSHi(t->obj_dimension); 1350} 1351 1352void own_dimension(SV* descr) 1353PPCODE: 1354{ 1355 dTARGET; 1356 const auto t = get_vtable<container_vtbl>(descr); 1357 if ((t->flags & ClassFlags::kind_mask) == ClassFlags::is_container) 1358 PUSHi(t->own_dimension); 1359 else 1360 PUSHs(&PL_sv_undef); 1361} 1362 1363void is_scalar(SV* descr) 1364PPCODE: 1365{ 1366 const auto t = get_vtable<base_vtbl>(descr); 1367 PUSHs((t->flags & ClassFlags::kind_mask) == ClassFlags::is_scalar ? &PL_sv_yes : &PL_sv_no); 1368} 1369 1370void is_container(SV* descr) 1371PPCODE: 1372{ 1373 const auto t = get_vtable<base_vtbl>(descr); 1374 PUSHs((t->flags & ClassFlags::kind_mask) == ClassFlags::is_container ? &PL_sv_yes : &PL_sv_no); 1375} 1376 1377void is_composite(SV* descr) 1378PPCODE: 1379{ 1380 const auto t = get_vtable<base_vtbl>(descr); 1381 PUSHs((t->flags & ClassFlags::kind_mask) == ClassFlags::is_composite ? &PL_sv_yes : &PL_sv_no); 1382} 1383 1384void is_opaque(SV* descr) 1385PPCODE: 1386{ 1387 const auto t = get_vtable<base_vtbl>(descr); 1388 PUSHs((t->flags & ClassFlags::kind_mask) == ClassFlags::is_opaque ? &PL_sv_yes : &PL_sv_no); 1389} 1390 1391void is_assoc_container(SV* descr) 1392PPCODE: 1393{ 1394 const auto t = get_vtable<base_vtbl>(descr); 1395 PUSHs((t->flags & (ClassFlags::kind_mask | ClassFlags::is_assoc_container)) == (ClassFlags::is_container | ClassFlags::is_assoc_container) ? &PL_sv_yes : &PL_sv_no); 1396} 1397 1398void is_sparse_container(SV* descr) 1399PPCODE: 1400{ 1401 const auto t = get_vtable<base_vtbl>(descr); 1402 PUSHs((t->flags & (ClassFlags::kind_mask | ClassFlags::is_sparse_container)) == (ClassFlags::is_container | ClassFlags::is_sparse_container) ? &PL_sv_yes : &PL_sv_no); 1403} 1404 1405void is_set(SV* descr) 1406PPCODE: 1407{ 1408 const auto t = get_vtable<base_vtbl>(descr); 1409 PUSHs(t->flags * ClassFlags::is_set ? &PL_sv_yes : &PL_sv_no); 1410} 1411 1412void is_serializable(SV* descr) 1413PPCODE: 1414{ 1415 const auto t = get_vtable<base_vtbl>(descr); 1416 PUSHs(t->flags * ClassFlags::is_serializable ? &PL_sv_yes : &PL_sv_no); 1417} 1418 1419void is_sparse_serialized(SV* descr) 1420PPCODE: 1421{ 1422 const auto t = get_vtable<base_vtbl>(descr); 1423 PUSHs(t->flags * ClassFlags::is_sparse_serialized ? &PL_sv_yes : &PL_sv_no); 1424} 1425 1426void is_ordered(SV* descr) 1427PPCODE: 1428{ 1429 const auto t = get_vtable<base_vtbl>(descr); 1430 PUSHs(t->flags * ClassFlags::is_ordered ? &PL_sv_yes : &PL_sv_no); 1431} 1432 1433MODULE = Polymake::Core::CPlusPlus PACKAGE = Polymake::Core::CPlusPlus::Iterator 1434 1435void incr(SV* ref, ...) 1436PPCODE: 1437{ 1438 MAGIC* mg = SvMAGIC(SvRV(ref)); 1439 const auto t = as_vtbl<iterator_vtbl>(mg); 1440 PUTBACK; 1441 guarded_call(aTHX_ [=](){ (t->incr)(mg->mg_ptr); }); 1442 XSprePUSH; 1443 PUSHs(ref); 1444} 1445 1446void not_at_end(SV* ref, ...) 1447PPCODE: 1448{ 1449 MAGIC* mg = SvMAGIC(SvRV(ref)); 1450 const auto t = as_vtbl<iterator_vtbl>(mg); 1451 // we don't expect any perl objects be accessed or created in at_end() methods, therefore the stack can't change 1452 const bool at_end = guarded_call(aTHX_ [=](){ return (t->at_end)(mg->mg_ptr); }); 1453 if (at_end) 1454 PUSHs(&PL_sv_no); 1455 else 1456 PUSHs(&PL_sv_yes); 1457} 1458 1459void deref(SV* ref, ...) 1460PPCODE: 1461{ 1462 MAGIC* mg = SvMAGIC(SvRV(ref)); 1463 const auto t = as_vtbl<iterator_vtbl>(mg); 1464 PUTBACK; 1465 SV* result = guarded_call(aTHX_ [=](){ return (t->deref)(mg->mg_ptr); }, t); 1466 XSprePUSH; 1467 PUSHs(result); 1468} 1469 1470void deref_to_scalar(SV* ref, ...) 1471PPCODE: 1472{ 1473 MAGIC* mg = SvMAGIC(SvRV(ref)); 1474 const auto t = as_vtbl<iterator_vtbl>(mg); 1475 PUTBACK; 1476 SV* result = guarded_call(aTHX_ [=](){ return (t->deref)(mg->mg_ptr); }, t); 1477 XSprePUSH; 1478 PUSHs(sv_2mortal(newRV(result))); 1479} 1480 1481void index(SV* ref) 1482PPCODE: 1483{ 1484 MAGIC* mg = SvMAGIC(SvRV(ref)); 1485 const auto t = as_vtbl<iterator_vtbl>(mg); 1486 // we don't expect any perl objects be accessed or created in index() methods, therefore the stack can't change 1487 if (t->index) { 1488 dTARGET; 1489 const Int ret = guarded_call(aTHX_ [=](){ return (t->index)(mg->mg_ptr); }); 1490 PUSHi(ret); 1491 } else { 1492 PUSHs(&PL_sv_undef); 1493 } 1494} 1495 1496void hidden(SV* ref, ...) 1497PPCODE: 1498{ 1499 PUSHs(SvRV(ref)); 1500} 1501 1502MODULE = Polymake::Core::CPlusPlus PACKAGE = Polymake::Core::CPlusPlus::TiedArray 1503 1504void EXTEND(SV* obj, I32 n) 1505PPCODE: 1506{ 1507 MAGIC* mg = get_cpp_magic(SvRV(obj)); 1508 const auto t = as_vtbl<container_vtbl>(mg); 1509 if ((mg->mg_flags & read_only_flag) || !t->resize) 1510 raise_exception(aTHX_ "Attempt to overwrite elements in a read-only C++ object"); 1511 guarded_call(aTHX_ [=](){ (t->resize)(mg->mg_ptr, n); }); 1512} 1513 1514MODULE = Polymake::Core::CPlusPlus PACKAGE = Polymake::Core::CPlusPlus::TiedCompositeArray 1515 1516void EXTEND(SV* obj, I32 n) 1517PPCODE: 1518{ 1519 MAGIC* mg = get_cpp_magic(SvRV(obj)); 1520 const auto t = as_vtbl<composite_vtbl>(mg); 1521 if (n != t->n_members) 1522 raise_exception(aTHX_ "Wrong number of elements in a composite assignment"); 1523} 1524 1525MODULE = Polymake::Core::CPlusPlus PACKAGE = Polymake::Core::CPlusPlus::TiedHash 1526 1527void FIRSTKEY(SV* obj_ref) 1528PPCODE: 1529{ 1530 SV* obj_sv = SvRV(obj_ref); 1531 SV* key_sv = sv_newmortal(); 1532 MAGIC* mg = get_cpp_magic(obj_sv); 1533 char* obj = mg->mg_ptr; 1534 char* it = (char*)HvARRAY(obj_sv); 1535 const auto t = as_vtbl<container_vtbl>(mg); 1536 const auto acct = t->acc + (mg->mg_flags & read_only_flag); 1537 if (it[acct->obj_size]) { 1538 if (acct->destructor) 1539 (acct->destructor)(it); 1540 it[acct->obj_size] = 0; 1541 } 1542 PUTBACK; 1543 guarded_call(aTHX_ [=](){ (acct->begin)(it, obj); }); 1544 it[acct->obj_size] = 1; 1545 guarded_call(aTHX_ [=](){ (acct->deref)(nullptr, it, -1, key_sv, obj_sv); }, t); 1546 XSprePUSH; 1547 PUSHs(key_sv); 1548} 1549 1550void NEXTKEY(SV* obj_ref, SV* key_sv) 1551PPCODE: 1552{ 1553 SV* obj_sv = SvRV(obj_ref); 1554 MAGIC* mg = get_cpp_magic(obj_sv); 1555 const auto t = as_vtbl<container_vtbl>(mg); 1556 const auto acct = t->acc + (mg->mg_flags & read_only_flag); 1557 char* it = (char*)HvARRAY(obj_sv); 1558 key_sv = sv_newmortal(); 1559 PUTBACK; 1560 guarded_call(aTHX_ [=](){ (acct->deref)(nullptr, it, 0, key_sv, obj_sv); }, t); 1561 XSprePUSH; 1562 PUSHs(key_sv); 1563} 1564 1565MODULE = Polymake::Core::CPlusPlus PACKAGE = Polymake::Core::Serializer::Sparse 1566 1567void dim_key() 1568PPCODE: 1569{ 1570 XPUSHs(Serializer_Sparse_dim_key); 1571} 1572 1573BOOT: 1574{ 1575 CPP_root = get_named_variable(aTHX_ "Polymake::Core::CPlusPlus::root", SVt_PV); 1576 PropertyType_nested_instantiation = get_named_variable(aTHX_ "Polymake::Core::PropertyType::nested_instantiation", SVt_PV); 1577 User_application = get_named_variable(aTHX_ "Polymake::User::application", SVt_PV); 1578 Debug_level = get_named_variable(aTHX_ "Polymake::DebugLevel", SVt_PV); 1579 1580 FuncDescr_stash = get_named_stash(aTHX_ "Polymake::Core::CPlusPlus::FuncDescr"); 1581 FuncDescr_fill_visible = get_sizeof(aTHX_ FuncDescr_stash)-1; 1582 FuncDescr_wrapper_index = FuncDescr_fill_visible+1; 1583 FuncDescr_return_type_reg_index = FuncDescr_wrapper_index+1; 1584 FuncDescr_fill = FuncDescr_return_type_reg_index; 1585 FuncDescr_name_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::FuncDescr::name", false)); 1586 FuncDescr_cpperl_file_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::FuncDescr::cpperl_file", false)); 1587 FuncDescr_arg_types_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::FuncDescr::arg_types", false)); 1588 FuncDescr_cross_apps_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::FuncDescr::cross_apps", false)); 1589 FuncDescr_return_type_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::FuncDescr::return_type", false)); 1590 1591 TypeDescr_stash = get_named_stash(aTHX_ "Polymake::Core::CPlusPlus::TypeDescr"); 1592 TypeDescr_fill = get_sizeof(aTHX_ TypeDescr_stash)-1; 1593 TypeDescr_pkg_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::TypeDescr::pkg", false)); 1594 TypeDescr_vtbl_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::TypeDescr::vtbl", false)); 1595 TypeDescr_cpperl_file_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::TypeDescr::cpperl_file", false)); 1596 TypeDescr_typeid_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::TypeDescr::typeid", false)); 1597 TypeDescr_generated_by_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::TypeDescr::generated_by", false)); 1598 1599 User_stash = get_named_stash(aTHX_ "Polymake::User"); 1600 1601 CPPOptions_builtin_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::Options::builtin", false)); 1602 CPPOptions_descr_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::Options::descr", false)); 1603 1604 PropertyType_pkg_index = CvDEPTH(get_cv("Polymake::Core::PropertyType::pkg", false)); 1605 PropertyType_cppoptions_index = CvDEPTH(get_cv("Polymake::Core::PropertyType::cppoptions", false)); 1606 PropertyType_params_index = CvDEPTH(get_cv("Polymake::Core::PropertyType::params", false)); 1607 1608 CPP_functions_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::functions", false)); 1609 CPP_regular_functions_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::regular_functions", false)); 1610 CPP_embedded_rules_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::embedded_rules", false)); 1611 CPP_duplicate_class_instances_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::duplicate_class_instances", false)); 1612 CPP_type_descr_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::type_descr", false)); 1613 CPP_builtins_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::builtins", false)); 1614 CPP_templates_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::templates", false)); 1615 CPP_typeids_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::typeids", false)); 1616 CPP_auto_assignment_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::auto_assignment", false)); 1617 CPP_auto_conversion_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::auto_conversion", false)); 1618 CPP_auto_assoc_methods_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::auto_assoc_methods", false)); 1619 CPP_auto_set_methods_index = CvDEPTH(get_cv("Polymake::Core::CPlusPlus::auto_set_methods", false)); 1620 1621 HV* assoc_stash = get_named_stash(aTHX_ "Polymake::Core::CPlusPlus::Assoc"); 1622 CPP_Assoc_helem_index = get_named_constant(aTHX_ assoc_stash, "helem"); 1623 CPP_Assoc_find_index = get_named_constant(aTHX_ assoc_stash, "find"); 1624 CPP_Assoc_exists_index = get_named_constant(aTHX_ assoc_stash, "exists"); 1625 CPP_Assoc_delete_void_index = get_named_constant(aTHX_ assoc_stash, "delete_void"); 1626 CPP_Assoc_delete_ret_index = get_named_constant(aTHX_ assoc_stash, "delete_ret"); 1627 1628 Serializer_Sparse_dim_key = newSVpvn_share("_dim", 4, 0); 1629 1630 Application_pkg_index = CvDEPTH(get_cv("Polymake::Core::Application::pkg", false)); 1631 Application_eval_expr_index = CvDEPTH(get_cv("Polymake::Core::Application::eval_expr", false)); 1632 1633 Object_name_index = CvDEPTH(get_cv("Polymake::Core::BigObject::name", false)); 1634 Object_description_index = CvDEPTH(get_cv("Polymake::Core::BigObject::description", false)); 1635 Object_parent_index = CvDEPTH(get_cv("Polymake::Core::BigObject::parent", false)); 1636 Object_transaction_index = CvDEPTH(get_cv("Polymake::Core::BigObject::transaction", false)); 1637 Object_attachments_index = CvDEPTH(get_cv("Polymake::Core::BigObject::attachments", false)); 1638 Object_InitTransaction_stash = get_named_stash(aTHX_ "Polymake::Core::InitTransaction"); 1639 1640 CvLVALUE_on(get_cv("Polymake::Core::CPlusPlus::Iterator::hidden", false)); 1641 CvMETHOD_on(get_cv("Polymake::Core::CPlusPlus::convert_to_Int", false)); 1642 CvMETHOD_on(get_cv("Polymake::Core::CPlusPlus::convert_to_Float", false)); 1643 1644 if (PL_DBgv) { 1645 CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::Iterator::deref", false)); 1646 CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::Iterator::deref_to_scalar", false)); 1647 CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::Iterator::incr", false)); 1648 CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::Iterator::not_at_end", false)); 1649 CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::Iterator::hidden", false)); 1650 CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::call_function", false)); 1651 CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::composite_access", false)); 1652 CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::assign_to_cpp_object", false)); 1653 CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::overload_clone_op", false)); 1654 CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::convert_to_string", false)); 1655 CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::convert_to_Int", false)); 1656 CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::convert_to_Float", false)); 1657 CvNODEBUG_on(get_cv("Polymake::Core::CPlusPlus::convert_to_serialized", false)); 1658 } 1659 1660 HV* FuncFlag_stash = get_named_stash(aTHX_ "Polymake::Core::CPlusPlus::FuncFlag"); 1661 if (arg_is_lval_ref != get_named_constant(aTHX_ FuncFlag_stash, "arg_is_lval_ref") || 1662 arg_is_univ_ref != get_named_constant(aTHX_ FuncFlag_stash, "arg_is_univ_ref") || 1663 arg_is_const_or_rval_ref != get_named_constant(aTHX_ FuncFlag_stash, "arg_is_const_or_rval_ref")) 1664 Perl_croak(aTHX_ "internal error: mismatch between C++ and perl enum values for FuncFlags"); 1665 returns_lvalue_flag = get_named_constant(aTHX_ FuncFlag_stash, "returns_lvalue"); 1666 1667 HV* PropertyValueFlags_stash = get_named_stash(aTHX_ "Polymake::Core::PropertyValue::Flags"); 1668 temporary_value_flag = get_named_constant_sv(aTHX_ PropertyValueFlags_stash, "is_temporary"); 1669 1670 negative_indices_key = newSVpvn_share(NEGATIVE_INDICES_VAR, 16, 0); 1671 connect_cout(aTHX); 1672} 1673 1674=pod 1675// Local Variables: 1676// mode:C++ 1677// c-basic-offset:3 1678// indent-tabs-mode:nil 1679// End: 1680=cut 1681