Lines Matching defs:mg
1 /* mg.c
104 /* guard against sv getting freed midway through the mg clearing,
135 const MAGIC* mg;
139 if ((mg = SvMAGIC(sv))) {
141 const MGVTBL* const vtbl = mg->mg_virtual;
143 if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
150 } while ((mg = mg->mg_moremagic));
172 MAGIC *newmg, *head, *cur, *mg;
178 /* We must call svt_get(sv, mg) for each valid entry in the linked
182 newmg = cur = head = mg = SvMAGIC(sv);
183 while (mg) {
184 const MGVTBL * const vtbl = mg->mg_virtual;
185 MAGIC * const nextmg = mg->mg_moremagic; /* it may delete itself */
187 if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
189 /* taint's mg get is so dumb it doesn't need flag saving */
190 if (mg->mg_type != PERL_MAGIC_taint) {
198 vtbl->svt_get(aTHX_ sv, mg);
209 if (mg->mg_flags & MGf_GSKIP)
230 magic_setutf8(sv, mg);
233 mg = nextmg;
238 if (mg == head) {
240 mg = cur;
248 cur = mg;
249 mg = newmg;
273 MAGIC* mg;
282 for (mg = SvMAGIC(sv); mg; mg = nextmg) {
283 const MGVTBL* vtbl = mg->mg_virtual;
284 nextmg = mg->mg_moremagic; /* it may delete itself */
285 if (mg->mg_flags & MGf_GSKIP) {
286 mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */
290 && PERL_MAGIC_TYPE_IS_VALUE_MAGIC(mg->mg_type))
293 vtbl->svt_set(aTHX_ sv, mg);
303 MAGIC* mg;
307 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
308 const MGVTBL* const vtbl = mg->mg_virtual;
314 len = vtbl->svt_len(aTHX_ sv, mg);
344 MAGIC* mg;
351 for (mg = SvMAGIC(sv); mg; mg = nextmg) {
352 const MGVTBL* const vtbl = mg->mg_virtual;
355 nextmg = mg->mg_moremagic; /* it may delete itself */
358 vtbl->svt_clear(aTHX_ sv, mg);
371 MAGIC *mg;
373 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
374 if (mg->mg_type == type && (!flags || mg->mg_virtual == vtbl)) {
375 return mg;
439 MAGIC* mg;
443 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
444 const MGVTBL* const vtbl = mg->mg_virtual;
445 if ((mg->mg_flags & MGf_COPY) && vtbl->svt_copy){
446 count += vtbl->svt_copy(aTHX_ sv, mg, nsv, key, klen);
449 const char type = mg->mg_type;
453 ? SvTIED_obj(sv, mg)
454 : mg->mg_obj,
481 MAGIC *mg;
488 for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
489 const MGVTBL* const vtbl = mg->mg_virtual;
490 if (PERL_MAGIC_TYPE_IS_VALUE_MAGIC(mg->mg_type))
493 if ((mg->mg_flags & MGf_LOCAL) && vtbl->svt_local)
494 (void)vtbl->svt_local(aTHX_ nsv, mg);
496 sv_magicext(nsv, mg->mg_obj, mg->mg_type, vtbl,
497 mg->mg_ptr, mg->mg_len);
513 #define mg_free_struct(sv, mg) S_mg_free_struct(aTHX_ sv, mg)
515 S_mg_free_struct(pTHX_ SV *sv, MAGIC *mg)
517 const MGVTBL* const vtbl = mg->mg_virtual;
519 vtbl->svt_free(aTHX_ sv, mg);
521 if (mg->mg_len > 0)
522 Safefree(mg->mg_ptr);
523 else if (mg->mg_len == HEf_SVKEY)
524 SvREFCNT_dec(MUTABLE_SV(mg->mg_ptr));
526 if (mg->mg_flags & MGf_REFCOUNTED)
527 SvREFCNT_dec(mg->mg_obj);
528 Safefree(mg);
542 MAGIC* mg;
547 for (mg = SvMAGIC(sv); mg; mg = moremagic) {
548 moremagic = mg->mg_moremagic;
549 mg_free_struct(sv, mg);
568 MAGIC *mg, *prevmg, *moremg;
570 for (prevmg = NULL, mg = SvMAGIC(sv); mg; prevmg = mg, mg = moremg) {
571 moremg = mg->mg_moremagic;
572 if (mg->mg_type == how) {
578 mg->mg_moremagic = SvMAGIC(sv);
579 SvMAGIC_set(sv, mg);
581 newhead = mg->mg_moremagic;
582 mg_free_struct(sv, mg);
584 mg = prevmg;
604 MAGIC *mg, *prevmg, *moremg;
606 for (prevmg = NULL, mg = SvMAGIC(sv); mg; prevmg = mg, mg = moremg) {
608 moremg = mg->mg_moremagic;
609 if (mg->mg_type == how && (vtbl == NULL || mg->mg_virtual == vtbl)) {
614 mg->mg_moremagic = SvMAGIC(sv);
615 SvMAGIC_set(sv, mg);
617 newhead = mg->mg_moremagic;
618 mg_free_struct(sv, mg);
620 mg = prevmg;
629 Perl_magic_regdata_cnt(pTHX_ SV *sv, MAGIC *mg)
638 const SSize_t n = (SSize_t)mg->mg_obj;
667 Perl_magic_regdatum_get(pTHX_ SV *sv, MAGIC *mg)
673 const SSize_t n = (SSize_t)mg->mg_obj;
675 const I32 paren = mg->mg_len
732 Perl_magic_regdatum_set(pTHX_ SV *sv, MAGIC *mg)
737 PERL_UNUSED_ARG(mg);
884 Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
893 const char * const remaining = (mg->mg_ptr)
894 ? mg->mg_ptr + 1
897 if (!mg->mg_ptr) {
898 paren = mg->mg_len;
909 switch (*mg->mg_ptr) {
1234 if (isGV(mg->mg_obj) || SvIV(mg->mg_obj) != pid) {
1288 Perl_magic_getuvar(pTHX_ SV *sv, MAGIC *mg)
1290 struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr;
1300 Perl_magic_setenv(pTHX_ SV *sv, MAGIC *mg)
1307 SV *keysv = MgSV(mg);
1310 key = mg->mg_ptr;
1311 klen = mg->mg_len;
1352 MgTAINTEDDIR_off(mg);
1365 MgTAINTEDDIR_on(mg);
1393 MgTAINTEDDIR_on(mg);
1417 MgTAINTEDDIR_on(mg);
1429 Perl_magic_clearenv(pTHX_ SV *sv, MAGIC *mg)
1433 my_setenv(MgPV_nolen_const(mg),NULL);
1438 Perl_magic_set_all_env(pTHX_ SV *sv, MAGIC *mg)
1441 PERL_UNUSED_ARG(mg);
1460 Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg)
1464 PERL_UNUSED_ARG(mg);
1482 Perl_magic_getsig(pTHX_ SV *sv, MAGIC *mg)
1485 int i = (I16)mg->mg_private;
1491 const char * sig = MgPV_const(mg, siglen);
1492 mg->mg_private = i = whichsig_pvn(sig, siglen);
1520 Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
1524 magic_setsig(NULL, mg);
1525 return sv_unmagic(sv, mg->mg_type);
1719 Perl_magic_setsig(pTHX_ SV *sv, MAGIC *mg)
1733 const char *s = MgPV_const(mg,len);
1762 i = (I16)mg->mg_private;
1765 mg->mg_private = (U16)i;
1875 Perl_magic_setsigall(pTHX_ SV* sv, MAGIC* mg)
1878 PERL_UNUSED_ARG(mg);
1893 Perl_magic_clearhook(pTHX_ SV *sv, MAGIC *mg)
1897 magic_sethook(NULL, mg);
1898 return sv_unmagic(sv, mg->mg_type);
1903 Perl_magic_sethook(pTHX_ SV *sv, MAGIC *mg)
1907 const char *s = MgPV_const(mg,len);
1939 Perl_magic_sethookall(pTHX_ SV* sv, MAGIC* mg)
1942 PERL_UNUSED_ARG(mg);
1964 Perl_magic_clearhookall(pTHX_ SV* sv, MAGIC* mg)
1967 PERL_UNUSED_ARG(mg);
1979 Perl_magic_setisa(pTHX_ SV *sv, MAGIC *mg)
1985 if (PL_delaymagic & DM_ARRAY_ISA && mg->mg_type == PERL_MAGIC_isaelem)
1988 return magic_clearisa(NULL, mg);
1993 Perl_magic_clearisa(pTHX_ SV *sv, MAGIC *mg)
2004 if (SvTYPE(mg->mg_obj) != SVt_PVGV && SvSMAGICAL(mg->mg_obj))
2007 mg = mg_find(mg->mg_obj, PERL_MAGIC_isa);
2009 assert(mg);
2010 if (SvTYPE(mg->mg_obj) == SVt_PVAV) { /* multiple stashes */
2011 SV **svp = AvARRAY((AV *)mg->mg_obj);
2012 I32 items = AvFILLp((AV *)mg->mg_obj) + 1;
2022 (const GV *)mg->mg_obj
2034 Perl_magic_getnkeys(pTHX_ SV *sv, MAGIC *mg)
2040 PERL_UNUSED_ARG(mg);
2057 Perl_magic_setnkeys(pTHX_ SV *sv, MAGIC *mg)
2060 PERL_UNUSED_ARG(mg);
2073 C<sv> and C<mg> are the tied thingy and the tie magic.
2095 Perl_magic_methcall(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
2119 PUSHs(SvTIED_obj(sv, mg));
2153 S_magic_methcall1(pTHX_ SV *sv, const MAGIC *mg, SV *meth, U32 flags,
2160 if (mg->mg_ptr) {
2161 if (mg->mg_len >= 0) {
2162 arg1 = newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP);
2164 else if (mg->mg_len == HEf_SVKEY)
2165 arg1 = MUTABLE_SV(mg->mg_ptr);
2167 else if (mg->mg_type == PERL_MAGIC_tiedelem) {
2168 arg1 = newSViv((IV)(mg->mg_len));
2172 return Perl_magic_methcall(aTHX_ sv, mg, meth, flags, n - 1, val);
2174 return Perl_magic_methcall(aTHX_ sv, mg, meth, flags, n, arg1, val);
2178 S_magic_methpack(pTHX_ SV *sv, const MAGIC *mg, SV *meth)
2184 ret = magic_methcall1(sv, mg, meth, 0, 1, NULL);
2191 Perl_magic_getpack(pTHX_ SV *sv, MAGIC *mg)
2195 if (mg->mg_type == PERL_MAGIC_tiedelem)
2196 mg->mg_flags |= MGf_GSKIP;
2197 magic_methpack(sv,mg,SV_CONST(FETCH));
2202 Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg)
2228 magic_methcall1(sv, mg, SV_CONST(STORE), G_DISCARD, 2, val);
2233 Perl_magic_clearpack(pTHX_ SV *sv, MAGIC *mg)
2237 if (mg->mg_type == PERL_MAGIC_tiedscalar) return 0;
2238 return magic_methpack(sv,mg,SV_CONST(DELETE));
2243 Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg)
2250 retsv = magic_methcall1(sv, mg, SV_CONST(FETCHSIZE), 0, 1, NULL);
2260 Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg)
2264 Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(CLEAR), G_DISCARD, 0);
2269 Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key)
2275 ret = SvOK(key) ? Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(NEXTKEY), 0, 1, key)
2276 : Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(FIRSTKEY), 0, 0);
2283 Perl_magic_existspack(pTHX_ SV *sv, const MAGIC *mg)
2287 return magic_methpack(sv,mg,SV_CONST(EXISTS));
2291 Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
2294 SV * const tied = SvTIED_obj(MUTABLE_SV(hv), mg);
2306 magic_nextpack(MUTABLE_SV(hv), mg, key);
2312 retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(hv), mg, SV_CONST(SCALAR), 0, 0);
2319 Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg)
2326 if (UNLIKELY(mg->mg_len != HEf_SVKEY)) {
2328 (IV)mg->mg_len, mg->mg_ptr);
2333 svp = av_fetch(MUTABLE_AV(mg->mg_obj),
2334 sv_2iv(MUTABLE_SV((mg)->mg_ptr)), FALSE);
2356 Perl_magic_getarylen(pTHX_ SV *sv, const MAGIC *mg)
2358 AV * const obj = MUTABLE_AV(mg->mg_obj);
2371 Perl_magic_setarylen(pTHX_ SV *sv, MAGIC *mg)
2373 AV * const obj = MUTABLE_AV(mg->mg_obj);
2387 Perl_magic_cleararylen_p(pTHX_ SV *sv, MAGIC *mg)
2395 *((IV *) &(mg->mg_len)) = 0;
2397 if (mg->mg_ptr)
2398 *((IV *) mg->mg_ptr) = 0;
2405 Perl_magic_freearylen_p(pTHX_ SV *sv, MAGIC *mg)
2414 mg = mg_find (mg->mg_obj, PERL_MAGIC_arylen);
2416 if (mg) {
2422 mg->mg_obj = 0;
2428 Perl_magic_getpos(pTHX_ SV *sv, MAGIC *mg)
2434 PERL_UNUSED_ARG(mg);
2448 Perl_magic_setpos(pTHX_ SV *sv, MAGIC *mg)
2457 PERL_UNUSED_ARG(mg);
2494 Perl_magic_getsubstr(pTHX_ SV *sv, MAGIC *mg)
2505 PERL_UNUSED_ARG(mg);
2526 Perl_magic_setsubstr(pTHX_ SV *sv, MAGIC *mg)
2537 PERL_UNUSED_ARG(mg);
2579 Perl_magic_gettaint(pTHX_ SV *sv, MAGIC *mg)
2584 PERL_UNUSED_ARG(mg);
2587 TAINT_IF((PL_localizing != 1) && (mg->mg_len & 1) && IN_PERL_RUNTIME);
2592 Perl_magic_settaint(pTHX_ SV *sv, MAGIC *mg)
2599 mg->mg_len |= 1;
2601 mg->mg_len &= ~1;
2606 Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg)
2612 PERL_UNUSED_ARG(mg);
2622 Perl_magic_setvec(pTHX_ SV *sv, MAGIC *mg)
2625 PERL_UNUSED_ARG(mg);
2631 Perl_defelem_target(pTHX_ SV *sv, MAGIC *mg)
2635 if (!mg) mg = mg_find(sv, PERL_MAGIC_defelem);
2636 assert(mg);
2638 if (mg->mg_obj) {
2640 HE * const he = hv_fetch_ent(MUTABLE_HV(ahv), mg->mg_obj, FALSE, 0);
2661 SvREFCNT_dec(mg->mg_obj);
2662 mg->mg_obj = NULL;
2663 mg->mg_flags &= ~MGf_REFCOUNTED;
2672 Perl_magic_getdefelem(pTHX_ SV *sv, MAGIC *mg)
2676 sv_setsv(sv, defelem_target(sv, mg));
2681 Perl_magic_setdefelem(pTHX_ SV *sv, MAGIC *mg)
2684 PERL_UNUSED_ARG(mg);
2697 MAGIC *mg;
2702 if (!LvTARGLEN(sv) || !(mg = mg_find(sv, PERL_MAGIC_defelem)))
2704 if (mg->mg_obj) {
2706 HE * const he = hv_fetch_ent(MUTABLE_HV(ahv), mg->mg_obj, TRUE, 0);
2710 Perl_croak(aTHX_ PL_no_helem_sv, SVfARG(mg->mg_obj));
2728 SvREFCNT_dec(mg->mg_obj);
2729 mg->mg_obj = NULL;
2730 mg->mg_flags &= ~MGf_REFCOUNTED;
2734 Perl_magic_setnonelem(pTHX_ SV *sv, MAGIC *mg)
2737 PERL_UNUSED_ARG(mg);
2743 Perl_magic_killbackrefs(pTHX_ SV *sv, MAGIC *mg)
2746 Perl_sv_kill_backrefs(aTHX_ sv, MUTABLE_AV(mg->mg_obj));
2751 Perl_magic_setmglob(pTHX_ SV *sv, MAGIC *mg)
2756 mg->mg_len = -1;
2762 Perl_magic_freemglob(pTHX_ SV *sv, MAGIC *mg)
2770 assert(mg->mg_type == PERL_MAGIC_regex_global && mg->mg_len >= -1);
2771 mg->mg_ptr = NULL;
2777 Perl_magic_setuvar(pTHX_ SV *sv, MAGIC *mg)
2779 const struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr;
2789 Perl_magic_setregexp(pTHX_ SV *sv, MAGIC *mg)
2791 const char type = mg->mg_type;
2803 Perl_magic_setcollxfrm(pTHX_ SV *sv, MAGIC *mg)
2813 if (mg->mg_ptr) {
2814 Safefree(mg->mg_ptr);
2815 mg->mg_ptr = NULL;
2816 mg->mg_len = -1;
2822 Perl_magic_freecollxfrm(pTHX_ SV *sv, MAGIC *mg)
2830 if (mg->mg_len >= 0) {
2831 assert(mg->mg_type == PERL_MAGIC_collxfrm);
2832 Safefree(mg->mg_ptr);
2833 mg->mg_ptr = NULL;
2842 Perl_magic_setutf8(pTHX_ SV *sv, MAGIC *mg)
2847 Safefree(mg->mg_ptr); /* The mg_ptr holds the pos cache. */
2848 mg->mg_ptr = NULL;
2849 mg->mg_len = -1; /* The mg_len holds the len cache. */
2854 Perl_magic_freeutf8(pTHX_ SV *sv, MAGIC *mg)
2862 assert(mg->mg_type == PERL_MAGIC_utf8 && mg->mg_len >= -1);
2863 Safefree(mg->mg_ptr);
2864 mg->mg_ptr = NULL;
2870 Perl_magic_setlvref(pTHX_ SV *sv, MAGIC *mg)
2875 switch (mg->mg_private & OPpLVREF_TYPE) {
2895 switch (mg->mg_obj ? SvTYPE(mg->mg_obj) : 0) {
2898 SV * const old = PAD_SV(mg->mg_len);
2899 PAD_SETSV(mg->mg_len, SvREFCNT_inc_NN(SvRV(sv)));
2904 gv_setref(mg->mg_obj, sv);
2905 SvSETMAGIC(mg->mg_obj);
2908 av_store((AV *)mg->mg_obj, SvIV((SV *)mg->mg_ptr),
2912 (void)hv_store_ent((HV *)mg->mg_obj, (SV *)mg->mg_ptr,
2915 if (mg->mg_flags & MGf_PERSIST)
3004 Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
3014 if (!mg->mg_ptr) {
3015 paren = mg->mg_len;
3031 switch (*mg->mg_ptr) {
3069 if (*(mg->mg_ptr+1) == '\0') {
3081 else if (strEQ(mg->mg_ptr + 1, "NCODING") && SvOK(sv))
3085 if (mg->mg_ptr[1] == '\0') {
3109 if (*(mg->mg_ptr+1) == '\0') {
3117 else if (strEQ(mg->mg_ptr, "\017PEN")) {
3154 if (strEQ(mg->mg_ptr+1, "TF8CACHE")) {
3159 if (*(mg->mg_ptr+1) == '\0') {
3166 else if (strEQ(mg->mg_ptr+1, "ARNING_BITS")) {
3516 /* Store the pid in mg->mg_obj so we can tell when a fork has
3517 occurred. mg->mg_obj points to *$ by default, so clear it. */
3518 if (isGV(mg->mg_obj)) {
3519 if (mg->mg_flags & MGf_REFCOUNTED) /* probably never true */
3520 SvREFCNT_dec(mg->mg_obj);
3521 mg->mg_flags |= MGf_REFCOUNTED;
3522 mg->mg_obj = newSViv((IV)PerlProc_getpid());
3524 else sv_setiv(mg->mg_obj, (IV)PerlProc_getpid());
3532 sv_utf8_encode(GvSV(mg->mg_obj));
3915 Perl_magic_sethint(pTHX_ SV *sv, MAGIC *mg)
3917 SV *key = (mg->mg_len == HEf_SVKEY) ? MUTABLE_SV(mg->mg_ptr)
3918 : newSVpvn_flags(mg->mg_ptr, mg->mg_len, SVs_TEMP);
3922 /* mg->mg_obj isn't being used. If needed, it would be possible to store
3946 Perl_magic_clearhint(pTHX_ SV *sv, MAGIC *mg)
3953 mg->mg_len == HEf_SVKEY
3955 MUTABLE_SV(mg->mg_ptr), 0, 0)
3957 mg->mg_ptr, mg->mg_len, 0, 0));
3958 if (mg->mg_len == HEf_SVKEY)
3959 magic_sethint_feature(MUTABLE_SV(mg->mg_ptr), NULL, 0, NULL, FALSE);
3961 magic_sethint_feature(NULL, mg->mg_ptr, mg->mg_len, NULL, FALSE);
3973 Perl_magic_clearhints(pTHX_ SV *sv, MAGIC *mg)
3977 PERL_UNUSED_ARG(mg);
3985 Perl_magic_copycallchecker(pTHX_ SV *sv, MAGIC *mg, SV *nsv,
3995 sv_magic(nsv, &PL_sv_undef, mg->mg_type, NULL, 0);
3996 nmg = mg_find(nsv, mg->mg_type);
3999 nmg->mg_ptr = mg->mg_ptr;
4000 nmg->mg_obj = SvREFCNT_inc_simple(mg->mg_obj);
4006 Perl_magic_setdebugvar(pTHX_ SV *sv, MAGIC *mg) {
4010 assert(mg->mg_private >= DBVARMG_SINGLE);
4012 assert(mg->mg_private < DBVARMG_COUNT);
4014 PL_DBcontrol[mg->mg_private] = SvIV_nomg(sv);
4020 Perl_magic_getdebugvar(pTHX_ SV *sv, MAGIC *mg) {
4024 assert(mg->mg_private >= DBVARMG_SINGLE);
4026 assert(mg->mg_private < DBVARMG_COUNT);
4027 sv_setiv(sv, PL_DBcontrol[mg->mg_private]);