1 /* This file is part of the autovivification Perl module.
2 * See http://search.cpan.org/dist/autovivification/ */
4 #define PERL_NO_GET_CONTEXT
9 /* --- XS helpers ---------------------------------------------------------- */
11 #define XSH_PACKAGE "autovivification"
18 /* ... Lexical hints ....................................................... */
20 /* Used both for hints and op flags */
21 #define A_HINT_STRICT 1
23 #define A_HINT_FETCH 4
24 #define A_HINT_STORE 8
25 #define A_HINT_KEYS 16
26 #define A_HINT_VALUES 32
27 #define A_HINT_EXISTS 64
28 #define A_HINT_DELETE 128
29 #define A_HINT_NOTIFY (A_HINT_STRICT|A_HINT_WARN)
30 #define A_HINT_DO (A_HINT_FETCH|A_HINT_STORE|A_HINT_KEYS|A_HINT_VALUES|A_HINT_EXISTS|A_HINT_DELETE)
31 #define A_HINT_MASK (A_HINT_NOTIFY|A_HINT_DO)
33 /* Only used in op flags */
34 #define A_HINT_ROOT 256
35 #define A_HINT_SECOND 512
36 #define A_HINT_DEREF 1024
38 #define XSH_HINTS_TYPE_UV 1
40 #include "xsh/hints.h"
42 #define a_hint() xsh_hints_detag(xsh_hints_fetch())
44 /* ... Thread-local storage ................................................ */
46 #define XSH_THREADS_COMPILE_TIME_PROTECTION 1
47 #define XSH_THREADS_USER_CONTEXT 0
49 #include "xsh/threads.h"
51 /* --- Compatibility wrappers ---------------------------------------------- */
54 # define HvNAME_get(H) HvNAME(H)
58 # define HvNAMELEN_get(H) strlen(HvNAME_get(H))
61 #ifndef A_HAS_MULTIDEREF
62 # define A_HAS_MULTIDEREF XSH_HAS_PERL(5, 21, 7)
65 #ifndef A_HAS_SCALARKEYS_OPT
66 # define A_HAS_SCALARKEYS_OPT XSH_HAS_PERL(5, 27, 3)
69 /* ... Our vivify_ref() .................................................... */
71 /* Perl_vivify_ref() is not exported, so we have to reimplement it. */
75 static SV *a_vivify_ref(pTHX_ SV *sv, int to_hash) {
76 #define a_vivify_ref(S, TH) a_vivify_ref(aTHX_ (S), (TH))
83 Perl_croak_no_modify();
85 /* Inlined prepare_SV_for_RV() */
86 if (SvTYPE(sv) < SVt_PV && SvTYPE(sv) != SVt_IV) {
87 sv_upgrade(sv, SVt_IV);
88 } else if (SvTYPE(sv) >= SVt_PV) {
94 val = to_hash ? MUTABLE_SV(newHV()) : MUTABLE_SV(newAV());
101 if (SvGMAGICAL(sv)) {
102 SV *msv = sv_newmortal();
103 sv_setsv_nomg(msv, sv);
110 #endif /* A_HAS_MULTIDEREF */
112 /* --- op => info map ------------------------------------------------------ */
120 #define PTABLE_NAME ptable_map
121 #define PTABLE_VAL_FREE(V) PerlMemShared_free(V)
122 #define PTABLE_VAL_NEED_CONTEXT 0
123 #define PTABLE_NEED_DELETE 1
124 #define PTABLE_NEED_WALK 0
126 #include "xsh/ptable.h"
128 #define ptable_map_store(T, K, V) ptable_map_store(aPMS_ (T), (K), (V))
129 #define ptable_map_delete(T, K) ptable_map_delete(aPMS_ (T), (K))
130 #define ptable_map_free(T) ptable_map_free(aPMS_ (T))
132 static ptable *a_op_map = NULL;
136 #define dA_MAP_THX a_op_info a_op_map_tmp_oi
138 static perl_mutex a_op_map_mutex;
140 static const a_op_info *a_map_fetch(const OP *o, a_op_info *oi) {
141 const a_op_info *val;
143 XSH_LOCK(&a_op_map_mutex);
145 val = ptable_fetch(a_op_map, o);
151 XSH_UNLOCK(&a_op_map_mutex);
156 #define a_map_fetch(O) a_map_fetch((O), &a_op_map_tmp_oi)
158 #else /* USE_ITHREADS */
160 #define dA_MAP_THX dNOOP
162 #define a_map_fetch(O) ptable_fetch(a_op_map, (O))
164 #endif /* !USE_ITHREADS */
166 static const a_op_info *a_map_store_locked(pPMS_ const OP *o, OP *(*old_pp)(pTHX), void *next, UV flags) {
167 #define a_map_store_locked(O, PP, N, F) a_map_store_locked(aPMS_ (O), (PP), (N), (F))
170 if (!(oi = ptable_fetch(a_op_map, o))) {
171 oi = PerlMemShared_malloc(sizeof *oi);
172 ptable_map_store(a_op_map, o, oi);
182 static void a_map_store(pTHX_ const OP *o, OP *(*old_pp)(pTHX), void *next, UV flags) {
183 #define a_map_store(O, PP, N, F) a_map_store(aTHX_ (O), (PP), (N), (F))
184 XSH_LOCK(&a_op_map_mutex);
186 a_map_store_locked(o, old_pp, next, flags);
188 XSH_UNLOCK(&a_op_map_mutex);
191 static void a_map_delete(pTHX_ const OP *o) {
192 #define a_map_delete(O) a_map_delete(aTHX_ (O))
193 XSH_LOCK(&a_op_map_mutex);
195 ptable_map_delete(a_op_map, o);
197 XSH_UNLOCK(&a_op_map_mutex);
200 static const OP *a_map_descend(const OP *o) {
201 switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
205 case OA_BASEOP_OR_UNOP:
206 return cUNOPo->op_first;
209 return cLISTOPo->op_last;
215 static void a_map_store_root(pTHX_ const OP *root, OP *(*old_pp)(pTHX), UV flags) {
216 #define a_map_store_root(R, PP, F) a_map_store_root(aTHX_ (R), (PP), (F))
217 const a_op_info *roi;
221 XSH_LOCK(&a_op_map_mutex);
223 roi = a_map_store_locked(o, old_pp, (OP *) root, flags | A_HINT_ROOT);
225 while (o->op_flags & OPf_KIDS) {
226 o = a_map_descend(o);
229 if ((oi = ptable_fetch(a_op_map, o))) {
230 oi->flags &= ~A_HINT_ROOT;
231 oi->next = (a_op_info *) roi;
236 XSH_UNLOCK(&a_op_map_mutex);
241 static void a_map_update_flags_topdown(const OP *root, UV flags) {
245 XSH_LOCK(&a_op_map_mutex);
247 flags &= ~A_HINT_ROOT;
250 if ((oi = ptable_fetch(a_op_map, o)))
251 oi->flags = (oi->flags & (A_HINT_ROOT|A_HINT_SECOND)) | flags;
252 if (!(o->op_flags & OPf_KIDS))
254 o = a_map_descend(o);
257 XSH_UNLOCK(&a_op_map_mutex);
262 #define a_map_cancel(R) a_map_update_flags_topdown((R), 0)
264 static void a_map_update_flags_bottomup(const OP *o, UV flags, UV rflags) {
267 XSH_LOCK(&a_op_map_mutex);
269 flags &= ~A_HINT_ROOT;
270 rflags |= A_HINT_ROOT;
272 oi = ptable_fetch(a_op_map, o);
273 while (!(oi->flags & A_HINT_ROOT)) {
279 XSH_UNLOCK(&a_op_map_mutex);
284 /* ... Decide whether this expression should be autovivified or not ........ */
286 static UV a_map_resolve(const OP *o, const a_op_info *oi) {
287 UV flags = 0, rflags;
289 const a_op_info *roi = oi;
291 while (!(roi->flags & A_HINT_ROOT))
296 rflags = roi->flags & ~A_HINT_ROOT;
301 if (root->op_flags & OPf_MOD) {
302 if (rflags & A_HINT_STORE)
303 flags = (A_HINT_STORE|A_HINT_DEREF);
305 if (rflags & (A_HINT_FETCH|A_HINT_KEYS|A_HINT_VALUES))
306 flags = (rflags|A_HINT_DEREF);
311 a_map_update_flags_bottomup(o, 0, 0);
315 flags |= (rflags & A_HINT_NOTIFY);
316 a_map_update_flags_bottomup(o, flags, 0);
318 return oi->flags & A_HINT_ROOT ? 0 : flags;
321 /* ... Inspired from pp_defined() .......................................... */
323 static int a_undef(pTHX_ SV *sv) {
324 #define a_undef(S) a_undef(aTHX_ (S))
325 switch (SvTYPE(sv)) {
329 if (AvMAX(sv) >= 0 || SvGMAGICAL(sv)
330 || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
334 if (HvARRAY(sv) || SvGMAGICAL(sv)
335 || (SvRMAGICAL(sv) && mg_find(sv, PERL_MAGIC_tied)))
347 /* --- PP functions -------------------------------------------------------- */
349 /* Be aware that we restore PL_op->op_ppaddr from the pointer table old_pp
350 * value, another extension might have saved our pp replacement as the ppaddr
351 * for this op, so this doesn't ensure that our function will never be called
352 * again. That's why we don't remove the op info from our map, so that it can
353 * still run correctly if required. */
355 /* ... pp_rv2av ............................................................ */
357 static OP *a_pp_rv2av(pTHX) {
362 oi = a_map_fetch(PL_op);
364 if (oi->flags & A_HINT_DEREF) {
366 /* We always need to push an empty array to fool the pp_aelem() that comes
370 av = sv_2mortal((SV *) newAV());
376 return oi->old_pp(aTHX);
379 /* ... pp_rv2hv ............................................................ */
381 static OP *a_pp_rv2hv_simple(pTHX) {
386 oi = a_map_fetch(PL_op);
388 if (oi->flags & A_HINT_DEREF) {
393 return oi->old_pp(aTHX);
396 static OP *a_pp_rv2hv(pTHX) {
401 oi = a_map_fetch(PL_op);
403 if (oi->flags & A_HINT_DEREF) {
407 hv = sv_2mortal((SV *) newHV());
413 return oi->old_pp(aTHX);
416 #if A_HAS_SCALARKEYS_OPT
418 static OP *a_pp_rv2hv_dokeys(pTHX) {
423 oi = a_map_fetch(PL_op);
425 if (oi->flags & A_HINT_KEYS) {
434 return oi->old_pp(aTHX);
439 /* ... pp_deref (aelem,helem,rv2sv,padsv) .................................. */
441 static void a_cannot_vivify(pTHX_ UV flags) {
442 #define a_cannot_vivify(F) a_cannot_vivify(aTHX_ (F))
443 if (flags & A_HINT_STRICT)
444 croak("Reference vivification forbidden");
445 else if (flags & A_HINT_WARN)
446 warn("Reference was vivified");
447 else /* A_HINT_STORE */
448 croak("Can't vivify reference");
451 static OP *a_pp_deref(pTHX) {
457 oi = a_map_fetch(PL_op);
460 if (flags & A_HINT_DEREF) {
463 o = oi->old_pp(aTHX);
465 if (flags & (A_HINT_NOTIFY|A_HINT_STORE)) {
468 a_cannot_vivify(flags);
474 return oi->old_pp(aTHX);
477 /* ... pp_root (exists,delete,keys,values) ................................. */
479 static OP *a_pp_root_unop(pTHX) {
484 /* Can only be reached by keys or values */
485 if (GIMME_V == G_SCALAR) {
494 const a_op_info *oi = a_map_fetch(PL_op);
495 return oi->old_pp(aTHX);
499 static OP *a_pp_root_binop(pTHX) {
502 if (a_undef(TOPm1s)) {
505 if (PL_op->op_type == OP_EXISTS)
513 const a_op_info *oi = a_map_fetch(PL_op);
514 return oi->old_pp(aTHX);
520 /* ... pp_multideref ....................................................... */
522 /* This pp replacement is actually only called for topmost exists/delete ops,
523 * because we hijack the [ah]elem check functions and this disables the
524 * optimization for lvalue and rvalue dereferencing. In particular, the
525 * OPf_MOD branches should never be covered. In the future, the multideref
526 * optimization might also be disabled for custom exists/delete check functions,
527 * which will make this section unnecessary. However, the code tries to be as
528 * general as possible in case I think of a way to reenable the multideref
529 * optimization even when this module is in use. */
531 static UV a_do_multideref(const OP *o, UV flags) {
532 UV isexdel, other_flags;
534 XSH_ASSERT(o->op_type == OP_MULTIDEREF);
536 other_flags = flags & ~A_HINT_DO;
538 isexdel = o->op_private & (OPpMULTIDEREF_EXISTS|OPpMULTIDEREF_DELETE);
540 if (isexdel & OPpMULTIDEREF_EXISTS) {
541 flags &= A_HINT_EXISTS;
543 flags &= A_HINT_DELETE;
546 if (o->op_flags & OPf_MOD) {
547 flags &= A_HINT_STORE;
549 flags &= A_HINT_FETCH;
553 return flags ? (flags | other_flags) : 0;
556 static SV *a_do_fake_pp(pTHX_ OP *op) {
557 #define a_do_fake_pp(O) a_do_fake_pp(aTHX_ (O))
563 PL_op->op_ppaddr(aTHX);
577 static void a_do_fake_pp_unop_init(pTHX_ UNOP *unop, U32 type, U32 flags) {
578 #define a_do_fake_pp_unop_init(O, T, F) a_do_fake_pp_unop_init(aTHX_ (O), (T), (F))
579 unop->op_type = type;
580 unop->op_flags = OPf_WANT_SCALAR | (~OPf_WANT & flags);
581 unop->op_private = 0;
582 unop->op_first = NULL;
583 unop->op_ppaddr = PL_ppaddr[type];
586 static SV *a_do_fake_pp_unop_arg1(pTHX_ U32 type, U32 flags, SV *arg) {
587 #define a_do_fake_pp_unop_arg1(T, F, A) a_do_fake_pp_unop_arg1(aTHX_ (T), (F), (A))
591 a_do_fake_pp_unop_init(&unop, type, flags);
597 return a_do_fake_pp((OP *) &unop);
600 static SV *a_do_fake_pp_unop_arg2(pTHX_ U32 type, U32 flags, SV *arg1, SV *arg2) {
601 #define a_do_fake_pp_unop_arg2(T, F, A1, A2) a_do_fake_pp_unop_arg2(aTHX_ (T), (F), (A1), (A2))
605 a_do_fake_pp_unop_init(&unop, type, flags);
612 return a_do_fake_pp((OP *) &unop);
615 #define a_do_pp_rv2av(R) a_do_fake_pp_unop_arg1(OP_RV2AV, OPf_REF, (R))
616 #define a_do_pp_afetch(A, I) a_do_fake_pp_unop_arg2(OP_AELEM, 0, (A), (I))
617 #define a_do_pp_afetch_lv(A, I) a_do_fake_pp_unop_arg2(OP_AELEM, OPf_MOD, (A), (I))
618 #define a_do_pp_aexists(A, I) a_do_fake_pp_unop_arg2(OP_EXISTS, OPf_SPECIAL, (A), (I))
619 #define a_do_pp_adelete(A, I) a_do_fake_pp_unop_arg2(OP_DELETE, OPf_SPECIAL, (A), (I))
621 #define a_do_pp_rv2hv(R) a_do_fake_pp_unop_arg1(OP_RV2HV, OPf_REF, (R))
622 #define a_do_pp_hfetch(H, K) a_do_fake_pp_unop_arg2(OP_HELEM, 0, (H), (K))
623 #define a_do_pp_hfetch_lv(H, K) a_do_fake_pp_unop_arg2(OP_HELEM, OPf_MOD, (H), (K))
624 #define a_do_pp_hexists(H, K) a_do_fake_pp_unop_arg2(OP_EXISTS, 0, (H), (K))
625 #define a_do_pp_hdelete(H, K) a_do_fake_pp_unop_arg2(OP_DELETE, 0, (H), (K))
627 static OP *a_pp_multideref(pTHX) {
628 UNOP_AUX_item *items;
636 const a_op_info *oi = a_map_fetch(PL_op);
638 flags = a_do_multideref(PL_op, oi->flags);
640 return oi->old_pp(aTHX);
643 items = cUNOP_AUXx(PL_op)->op_aux;
646 PL_multideref_pc = items;
649 switch (actions & MDEREF_ACTION_MASK) {
651 actions = (++items)->uv;
653 case MDEREF_AV_padav_aelem: /* $lex[...] */
654 sv = PAD_SVl((++items)->pad_offset);
658 case MDEREF_AV_gvav_aelem: /* $pkg[...] */
659 sv = UNOP_AUX_item_sv(++items);
660 XSH_ASSERT(isGV_with_GP(sv));
661 sv = (SV *) GvAVn((GV *) sv);
665 case MDEREF_AV_pop_rv2av_aelem: /* expr->[...] */
669 goto do_AV_rv2av_aelem;
670 case MDEREF_AV_gvsv_vivify_rv2av_aelem: /* $pkg->[...] */
671 sv = UNOP_AUX_item_sv(++items);
672 XSH_ASSERT(isGV_with_GP(sv));
673 sv = GvSVn((GV *) sv);
676 goto do_AV_vivify_rv2av_aelem;
677 case MDEREF_AV_padsv_vivify_rv2av_aelem: /* $lex->[...] */
678 sv = PAD_SVl((++items)->pad_offset);
680 case MDEREF_AV_vivify_rv2av_aelem: /* vivify, ->[...] */
683 do_AV_vivify_rv2av_aelem:
684 sv = a_vivify_ref(sv, 0);
686 sv = a_do_pp_rv2av(sv);
690 XSH_ASSERT(SvTYPE(sv) == SVt_PVAV);
691 switch (actions & MDEREF_INDEX_MASK) {
692 case MDEREF_INDEX_none:
694 case MDEREF_INDEX_const:
695 esv = sv_2mortal(newSViv((++items)->iv));
697 case MDEREF_INDEX_padsv:
698 esv = PAD_SVl((++items)->pad_offset);
700 case MDEREF_INDEX_gvsv:
701 esv = UNOP_AUX_item_sv(++items);
702 XSH_ASSERT(isGV_with_GP(esv));
703 esv = GvSVn((GV *) esv);
705 if (UNLIKELY(SvROK(esv) && !SvGAMAGIC(esv) && ckWARN(WARN_MISC)))
706 Perl_warner(aTHX_ packWARN(WARN_MISC),
707 "Use of reference \"%"SVf"\" as array index",
711 PL_multideref_pc = items;
712 if (actions & MDEREF_FLAG_last) {
713 switch (flags & A_HINT_DO) {
715 sv = a_do_pp_afetch(sv, esv);
718 sv = a_do_pp_afetch_lv(sv, esv);
721 sv = a_do_pp_aexists(sv, esv);
724 sv = a_do_pp_adelete(sv, esv);
729 sv = a_do_pp_afetch(sv, esv);
732 case MDEREF_HV_padhv_helem: /* $lex{...} */
733 sv = PAD_SVl((++items)->pad_offset);
737 case MDEREF_HV_gvhv_helem: /* $pkg{...} */
738 sv = UNOP_AUX_item_sv(++items);
739 XSH_ASSERT(isGV_with_GP(sv));
740 sv = (SV *) GvHVn((GV *) sv);
744 case MDEREF_HV_pop_rv2hv_helem: /* expr->{...} */
748 goto do_HV_rv2hv_helem;
749 case MDEREF_HV_gvsv_vivify_rv2hv_helem: /* $pkg->{...} */
750 sv = UNOP_AUX_item_sv(++items);
751 XSH_ASSERT(isGV_with_GP(sv));
752 sv = GvSVn((GV *) sv);
755 goto do_HV_vivify_rv2hv_helem;
756 case MDEREF_HV_padsv_vivify_rv2hv_helem: /* $lex->{...} */
757 sv = PAD_SVl((++items)->pad_offset);
759 case MDEREF_HV_vivify_rv2hv_helem: /* vivify, ->{...} */
762 do_HV_vivify_rv2hv_helem:
763 sv = a_vivify_ref(sv, 1);
765 sv = a_do_pp_rv2hv(sv);
769 XSH_ASSERT(SvTYPE(sv) == SVt_PVHV);
770 switch (actions & MDEREF_INDEX_MASK) {
771 case MDEREF_INDEX_none:
773 case MDEREF_INDEX_const:
774 key = UNOP_AUX_item_sv(++items);
776 case MDEREF_INDEX_padsv:
777 key = PAD_SVl((++items)->pad_offset);
779 case MDEREF_INDEX_gvsv:
780 key = UNOP_AUX_item_sv(++items);
781 XSH_ASSERT(isGV_with_GP(key));
782 key = GvSVn((GV *) key);
785 PL_multideref_pc = items;
786 if (actions & MDEREF_FLAG_last) {
787 switch (flags & A_HINT_DO) {
789 sv = a_do_pp_hfetch(sv, key);
792 sv = a_do_pp_hfetch_lv(sv, key);
795 sv = a_do_pp_hexists(sv, key);
798 sv = a_do_pp_hdelete(sv, key);
805 sv = a_do_pp_hfetch(sv, key);
810 actions >>= MDEREF_SHIFT;
814 if (flags & (A_HINT_NOTIFY|A_HINT_STORE))
815 a_cannot_vivify(flags);
816 if (flags & A_HINT_EXISTS)
825 #endif /* A_HAS_MULTIDEREF */
827 /* --- Check functions ----------------------------------------------------- */
829 static void a_recheck_rv2xv(pTHX_ OP *o, OPCODE type, OP *(*new_pp)(pTHX)) {
830 #define a_recheck_rv2xv(O, T, PP) a_recheck_rv2xv(aTHX_ (O), (T), (PP))
832 if (o->op_type == type && o->op_ppaddr != new_pp
833 && cUNOPo->op_first->op_type != OP_GV) {
835 const a_op_info *oi = a_map_fetch(o);
837 a_map_store(o, o->op_ppaddr, oi->next, oi->flags);
838 o->op_ppaddr = new_pp;
845 /* ... ck_pad{any,sv} ...................................................... */
847 /* Sadly, the padsv OPs we are interested in don't trigger the padsv check
848 * function, but are instead manually mutated from a padany. So we store
849 * the op entry in the op map in the padany check function, and we set their
850 * op_ppaddr member in our peephole optimizer replacement below. */
852 static OP *(*a_old_ck_padany)(pTHX_ OP *) = 0;
854 static OP *a_ck_padany(pTHX_ OP *o) {
857 o = a_old_ck_padany(aTHX_ o);
860 if (hint & A_HINT_DO)
861 a_map_store_root(o, o->op_ppaddr, hint);
868 static OP *(*a_old_ck_padsv)(pTHX_ OP *) = 0;
870 static OP *a_ck_padsv(pTHX_ OP *o) {
873 o = a_old_ck_padsv(aTHX_ o);
876 if (hint & A_HINT_DO) {
877 a_map_store_root(o, o->op_ppaddr, hint);
878 o->op_ppaddr = a_pp_deref;
885 /* ... ck_deref (aelem,helem,rv2sv) ........................................ */
887 /* Those ops appear both at the root and inside an expression but there's no
888 * way to distinguish both situations. Worse, we can't even know if we are in a
889 * modifying context, so the expression can't be resolved yet. It will be at the
890 * first invocation of a_pp_deref() for this expression. */
892 static OP *(*a_old_ck_aelem)(pTHX_ OP *) = 0;
893 static OP *(*a_old_ck_helem)(pTHX_ OP *) = 0;
894 static OP *(*a_old_ck_rv2sv)(pTHX_ OP *) = 0;
896 static OP *a_ck_deref(pTHX_ OP *o) {
897 OP * (*old_ck)(pTHX_ OP *o) = 0;
900 switch (o->op_type) {
902 old_ck = a_old_ck_aelem;
903 if ((hint & A_HINT_DO) && !(hint & A_HINT_STRICT))
904 a_recheck_rv2xv(cUNOPo->op_first, OP_RV2AV, a_pp_rv2av);
907 old_ck = a_old_ck_helem;
908 if ((hint & A_HINT_DO) && !(hint & A_HINT_STRICT))
909 a_recheck_rv2xv(cUNOPo->op_first, OP_RV2HV, a_pp_rv2hv_simple);
912 old_ck = a_old_ck_rv2sv;
918 if (old_ck == a_old_ck_rv2sv && o->op_flags & OPf_KIDS) {
919 OP *kid = cUNOPo->op_first;
920 if (kid && kid->op_type == OP_GV) {
921 if (hint & A_HINT_DO)
922 a_map_store(kid, kid->op_ppaddr, NULL, hint);
929 if (hint & A_HINT_DO) {
930 a_map_store_root(o, o->op_ppaddr, hint);
931 o->op_ppaddr = a_pp_deref;
938 /* ... ck_rv2xv (rv2av,rv2hv) .............................................. */
940 /* Those ops also appear both inisde and at the root, hence the caveats for
941 * a_ck_deref() still apply here. Since a padsv/rv2sv must appear before a
942 * rv2[ah]v, resolution is handled by the first call to a_pp_deref() in the
945 static OP *(*a_old_ck_rv2av)(pTHX_ OP *) = 0;
946 static OP *(*a_old_ck_rv2hv)(pTHX_ OP *) = 0;
948 static OP *a_ck_rv2xv(pTHX_ OP *o) {
949 OP * (*old_ck)(pTHX_ OP *o) = 0;
950 OP * (*new_pp)(pTHX) = 0;
953 switch (o->op_type) {
954 case OP_RV2AV: old_ck = a_old_ck_rv2av; new_pp = a_pp_rv2av; break;
955 case OP_RV2HV: old_ck = a_old_ck_rv2hv; new_pp = a_pp_rv2hv_simple; break;
959 if (cUNOPo->op_first->op_type == OP_GV)
963 if (hint & A_HINT_DO && !(hint & A_HINT_STRICT)) {
964 a_map_store_root(o, o->op_ppaddr, hint);
965 o->op_ppaddr = new_pp;
972 /* ... ck_xslice (aslice,hslice) ........................................... */
974 /* I think those are only found at the root, but there's nothing that really
975 * prevent them to be inside the expression too. We only need to update the
976 * root so that the rest of the expression will see the right context when
977 * resolving. That's why we don't replace the ppaddr. */
979 static OP *(*a_old_ck_aslice)(pTHX_ OP *) = 0;
980 static OP *(*a_old_ck_hslice)(pTHX_ OP *) = 0;
982 static OP *a_ck_xslice(pTHX_ OP *o) {
983 OP * (*old_ck)(pTHX_ OP *o) = 0;
986 switch (o->op_type) {
988 old_ck = a_old_ck_aslice;
991 old_ck = a_old_ck_hslice;
992 if (hint & A_HINT_DO)
993 a_recheck_rv2xv(OpSIBLING(cUNOPo->op_first), OP_RV2HV, a_pp_rv2hv);
998 if (hint & A_HINT_DO) {
999 a_map_store_root(o, 0, hint);
1006 /* ... ck_root (exists,delete,keys,values) ................................. */
1008 /* Those ops are only found at the root of a dereferencing expression. We can
1009 * then resolve at compile time if vivification must take place or not. */
1011 static OP *(*a_old_ck_exists)(pTHX_ OP *) = 0;
1012 static OP *(*a_old_ck_delete)(pTHX_ OP *) = 0;
1013 static OP *(*a_old_ck_keys) (pTHX_ OP *) = 0;
1014 static OP *(*a_old_ck_values)(pTHX_ OP *) = 0;
1016 static OP *a_ck_root(pTHX_ OP *o) {
1017 OP * (*old_ck)(pTHX_ OP *o) = 0;
1018 OP * (*new_pp)(pTHX) = 0;
1022 switch (o->op_type) {
1024 old_ck = a_old_ck_exists;
1025 new_pp = a_pp_root_binop;
1026 enabled = hint & A_HINT_EXISTS;
1029 old_ck = a_old_ck_delete;
1030 new_pp = a_pp_root_binop;
1031 enabled = hint & A_HINT_DELETE;
1034 old_ck = a_old_ck_keys;
1035 new_pp = a_pp_root_unop;
1036 enabled = hint & A_HINT_KEYS;
1039 old_ck = a_old_ck_values;
1040 new_pp = a_pp_root_unop;
1041 enabled = hint & A_HINT_VALUES;
1044 o = old_ck(aTHX_ o);
1046 if (hint & A_HINT_DO) {
1048 #if A_HAS_SCALARKEYS_OPT
1049 if ((enabled == A_HINT_KEYS) && (o->op_flags & OPf_KIDS)) {
1050 OP *kid = cUNOPo->op_first;
1051 if (kid->op_type == OP_RV2HV) {
1053 const a_op_info *koi = a_map_fetch(kid);
1054 a_map_store(kid, koi ? koi->old_pp : kid->op_ppaddr, NULL,
1055 hint | A_HINT_SECOND);
1057 kid->op_ppaddr = a_pp_rv2hv;
1061 a_map_update_flags_topdown(o, hint | A_HINT_DEREF);
1062 a_map_store_root(o, o->op_ppaddr, hint);
1063 o->op_ppaddr = new_pp;
1073 /* --- Our peephole optimizer ---------------------------------------------- */
1075 static void xsh_peep_rec(pTHX_ OP *o, ptable *seen) {
1076 for (; o; o = o->op_next) {
1078 const a_op_info *oi = NULL;
1081 if (xsh_peep_seen(o, seen))
1084 switch (o->op_type) {
1086 if (o->op_ppaddr != a_pp_deref) {
1087 oi = a_map_fetch(o);
1088 if (oi && (oi->flags & A_HINT_DO)) {
1089 a_map_store(o, o->op_ppaddr, oi->next, oi->flags);
1090 o->op_ppaddr = a_pp_deref;
1098 if (o->op_ppaddr != a_pp_deref)
1100 oi = a_map_fetch(o);
1104 if (!(flags & A_HINT_DEREF)
1105 && (flags & A_HINT_DO)
1106 && (o->op_private & OPpDEREF || flags & A_HINT_ROOT)) {
1107 /* Decide if the expression must autovivify or not. */
1108 flags = a_map_resolve(o, oi);
1110 if (flags & A_HINT_DEREF)
1111 o->op_private = ((o->op_private & ~OPpDEREF) | OPpLVAL_DEFER);
1113 o->op_ppaddr = oi->old_pp;
1116 if (o->op_ppaddr != a_pp_rv2av)
1118 oi = a_map_fetch(o);
1121 if (!(oi->flags & A_HINT_DEREF))
1122 o->op_ppaddr = oi->old_pp;
1125 if (o->op_ppaddr != a_pp_rv2hv && o->op_ppaddr != a_pp_rv2hv_simple)
1127 oi = a_map_fetch(o);
1130 if (!(oi->flags & A_HINT_DEREF)) {
1131 o->op_ppaddr = oi->old_pp;
1134 #if A_HAS_SCALARKEYS_OPT
1136 if ((flags & A_HINT_KEYS) && (flags & A_HINT_SECOND)) {
1137 U8 want = o->op_flags & OPf_WANT;
1138 if (want == OPf_WANT_VOID || want == OPf_WANT_SCALAR)
1139 o->op_ppaddr = a_pp_rv2hv_dokeys;
1140 else if (oi->old_pp == a_pp_rv2hv || oi->old_pp == a_pp_rv2hv_simple)
1141 o->op_ppaddr = oi->old_pp;
1145 #if A_HAS_MULTIDEREF
1147 if (o->op_ppaddr != a_pp_multideref) {
1148 oi = a_map_fetch(cUNOPo->op_first);
1152 if (a_do_multideref(o, flags)) {
1153 a_map_store_root(o, o->op_ppaddr, flags & ~A_HINT_DEREF);
1154 o->op_ppaddr = a_pp_multideref;
1160 xsh_peep_maybe_recurse(o, seen);
1166 /* --- Module setup/teardown ----------------------------------------------- */
1168 static void xsh_user_global_setup(pTHX) {
1169 a_op_map = ptable_new(32);
1172 MUTEX_INIT(&a_op_map_mutex);
1175 xsh_ck_replace(OP_PADANY, a_ck_padany, &a_old_ck_padany);
1176 xsh_ck_replace(OP_PADSV, a_ck_padsv, &a_old_ck_padsv);
1178 xsh_ck_replace(OP_AELEM, a_ck_deref, &a_old_ck_aelem);
1179 xsh_ck_replace(OP_HELEM, a_ck_deref, &a_old_ck_helem);
1180 xsh_ck_replace(OP_RV2SV, a_ck_deref, &a_old_ck_rv2sv);
1182 xsh_ck_replace(OP_RV2AV, a_ck_rv2xv, &a_old_ck_rv2av);
1183 xsh_ck_replace(OP_RV2HV, a_ck_rv2xv, &a_old_ck_rv2hv);
1185 xsh_ck_replace(OP_ASLICE, a_ck_xslice, &a_old_ck_aslice);
1186 xsh_ck_replace(OP_HSLICE, a_ck_xslice, &a_old_ck_hslice);
1188 xsh_ck_replace(OP_EXISTS, a_ck_root, &a_old_ck_exists);
1189 xsh_ck_replace(OP_DELETE, a_ck_root, &a_old_ck_delete);
1190 xsh_ck_replace(OP_KEYS, a_ck_root, &a_old_ck_keys);
1191 xsh_ck_replace(OP_VALUES, a_ck_root, &a_old_ck_values);
1196 static void xsh_user_local_setup(pTHX) {
1199 stash = gv_stashpvn(XSH_PACKAGE, XSH_PACKAGE_LEN, 1);
1200 newCONSTSUB(stash, "A_HINT_STRICT", newSVuv(A_HINT_STRICT));
1201 newCONSTSUB(stash, "A_HINT_WARN", newSVuv(A_HINT_WARN));
1202 newCONSTSUB(stash, "A_HINT_FETCH", newSVuv(A_HINT_FETCH));
1203 newCONSTSUB(stash, "A_HINT_STORE", newSVuv(A_HINT_STORE));
1204 newCONSTSUB(stash, "A_HINT_KEYS", newSVuv(A_HINT_KEYS));
1205 newCONSTSUB(stash, "A_HINT_VALUES", newSVuv(A_HINT_VALUES));
1206 newCONSTSUB(stash, "A_HINT_EXISTS", newSVuv(A_HINT_EXISTS));
1207 newCONSTSUB(stash, "A_HINT_DELETE", newSVuv(A_HINT_DELETE));
1208 newCONSTSUB(stash, "A_HINT_MASK", newSVuv(A_HINT_MASK));
1209 newCONSTSUB(stash, "A_THREADSAFE", newSVuv(XSH_THREADSAFE));
1210 newCONSTSUB(stash, "A_FORKSAFE", newSVuv(XSH_FORKSAFE));
1215 static void xsh_user_local_teardown(pTHX) {
1219 static void xsh_user_global_teardown(pTHX) {
1220 xsh_ck_restore(OP_PADANY, &a_old_ck_padany);
1221 xsh_ck_restore(OP_PADSV, &a_old_ck_padsv);
1223 xsh_ck_restore(OP_AELEM, &a_old_ck_aelem);
1224 xsh_ck_restore(OP_HELEM, &a_old_ck_helem);
1225 xsh_ck_restore(OP_RV2SV, &a_old_ck_rv2sv);
1227 xsh_ck_restore(OP_RV2AV, &a_old_ck_rv2av);
1228 xsh_ck_restore(OP_RV2HV, &a_old_ck_rv2hv);
1230 xsh_ck_restore(OP_ASLICE, &a_old_ck_aslice);
1231 xsh_ck_restore(OP_HSLICE, &a_old_ck_hslice);
1233 xsh_ck_restore(OP_EXISTS, &a_old_ck_exists);
1234 xsh_ck_restore(OP_DELETE, &a_old_ck_delete);
1235 xsh_ck_restore(OP_KEYS, &a_old_ck_keys);
1236 xsh_ck_restore(OP_VALUES, &a_old_ck_values);
1238 ptable_map_free(a_op_map);
1242 MUTEX_DESTROY(&a_op_map_mutex);
1248 /* --- XS ------------------------------------------------------------------ */
1250 MODULE = autovivification PACKAGE = autovivification
1268 #endif /* XSH_THREADSAFE */
1274 RETVAL = xsh_hints_tag(SvOK(hint) ? SvUV(hint) : 0);
1284 RETVAL = newSVuv(xsh_hints_detag(tag));