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