X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=1923ce4d9db70dc85a9202e2e5b5add2c7445ac5;hb=0295179fdf8aa1b8c029859896e7340a11a3de74;hp=9127137359c9d2ec6e58ff10c76339c44e13264a;hpb=cf2093f6405d08be483e037b6052608c46952a75;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mg.c b/mg.c index 9127137..1923ce4 100644 --- a/mg.c +++ b/mg.c @@ -27,12 +27,6 @@ # endif #endif -#ifdef PERL_OBJECT -# define VTBL this->*vtbl -#else -# define VTBL *vtbl -#endif - static void restore_magic(pTHXo_ void *p); static void unwind_handler_stack(pTHXo_ void *p); @@ -99,7 +93,7 @@ Perl_mg_get(pTHX_ SV *sv) while ((mg = *mgp) != 0) { MGVTBL* vtbl = mg->mg_virtual; if (!(mg->mg_flags & MGf_GSKIP) && vtbl && (vtbl->svt_get != NULL)) { - (VTBL->svt_get)(aTHX_ sv, mg); + CALL_FTPR(vtbl->svt_get)(aTHX_ sv, mg); /* Ignore this magic if it's been deleted */ if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) && (mg->mg_flags & MGf_GSKIP)) @@ -137,7 +131,7 @@ Perl_mg_set(pTHX_ SV *sv) (SSPTR(mgs_ix, MGS*))->mgs_flags = 0; } if (vtbl && (vtbl->svt_set != NULL)) - (VTBL->svt_set)(aTHX_ sv, mg); + CALL_FPTR(vtbl->svt_set)(aTHX_ sv, mg); } restore_magic(aTHXo_ (void*)mgs_ix); @@ -159,7 +153,7 @@ Perl_mg_length(pTHX_ SV *sv) mgs_ix = SSNEW(sizeof(MGS)); save_magic(mgs_ix, sv); /* omit MGf_GSKIP -- not changed here */ - len = (VTBL->svt_len)(aTHX_ sv, mg); + len = CALL_FPTR(vtbl->svt_len)(aTHX_ sv, mg); restore_magic(aTHXo_ (void*)mgs_ix); return len; } @@ -183,7 +177,7 @@ Perl_mg_size(pTHX_ SV *sv) mgs_ix = SSNEW(sizeof(MGS)); save_magic(mgs_ix, sv); /* omit MGf_GSKIP -- not changed here */ - len = (VTBL->svt_len)(aTHX_ sv, mg); + len = CALL_FPTR(vtbl->svt_len)(aTHX_ sv, mg); restore_magic(aTHXo_ (void*)mgs_ix); return len; } @@ -216,7 +210,7 @@ Perl_mg_clear(pTHX_ SV *sv) /* omit GSKIP -- never set here */ if (vtbl && (vtbl->svt_clear != NULL)) - (VTBL->svt_clear)(aTHX_ sv, mg); + CALL_FPTR(vtbl->svt_clear)(aTHX_ sv, mg); } restore_magic(aTHXo_ (void*)mgs_ix); @@ -259,7 +253,7 @@ Perl_mg_free(pTHX_ SV *sv) MGVTBL* vtbl = mg->mg_virtual; moremagic = mg->mg_moremagic; if (vtbl && (vtbl->svt_free != NULL)) - (VTBL->svt_free)(aTHX_ sv, mg); + CALL_FPTR(vtbl->svt_free)(aTHX_ sv, mg); if (mg->mg_ptr && mg->mg_type != 'g') if (mg->mg_len >= 0) Safefree(mg->mg_ptr); @@ -828,7 +822,12 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) } FreeEnvironmentStrings(envv); # else -# ifndef PERL_USE_SAFE_PUTENV +# ifdef CYGWIN + I32 i; + for (i = 0; environ[i]; i++) + Safefree(environ[i]); +# else +# ifndef PERL_USE_SAFE_PUTENV I32 i; if (environ == PL_origenviron) @@ -836,7 +835,8 @@ Perl_magic_clear_all_env(pTHX_ SV *sv, MAGIC *mg) else for (i = 0; environ[i]; i++) safesysfree(environ[i]); -# endif /* PERL_USE_SAFE_PUTENV */ +# endif /* PERL_USE_SAFE_PUTENV */ +# endif /* CYGWIN */ environ[0] = Nullch; @@ -1355,65 +1355,13 @@ int Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg) { SV *lsv = LvTARG(sv); - unsigned char *s; - unsigned long retnum; - STRLEN lsvlen; - I32 len; - I32 offset; - I32 size; if (!lsv) { SvOK_off(sv); return 0; } - s = (unsigned char *) SvPV(lsv, lsvlen); - offset = LvTARGOFF(sv); - size = LvTARGLEN(sv); - len = (offset + size + 7) / 8; - - /* Copied from pp_vec() */ - - if (len > lsvlen) { - if (size <= 8) - retnum = 0; - else { - offset >>= 3; - if (size == 16) { - if (offset >= lsvlen) - retnum = 0; - else - retnum = (unsigned long) s[offset] << 8; - } - else if (size == 32) { - if (offset >= lsvlen) - retnum = 0; - else if (offset + 1 >= lsvlen) - retnum = (unsigned long) s[offset] << 24; - else if (offset + 2 >= lsvlen) - retnum = ((unsigned long) s[offset] << 24) + - ((unsigned long) s[offset + 1] << 16); - else - retnum = ((unsigned long) s[offset] << 24) + - ((unsigned long) s[offset + 1] << 16) + - (s[offset + 2] << 8); - } - } - } - else if (size < 8) - retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1); - else { - offset >>= 3; - if (size == 8) - retnum = s[offset]; - else if (size == 16) - retnum = ((unsigned long) s[offset] << 8) + s[offset+1]; - else if (size == 32) - retnum = ((unsigned long) s[offset] << 24) + - ((unsigned long) s[offset + 1] << 16) + - (s[offset + 2] << 8) + s[offset+3]; - } - sv_setuv(sv, (UV)retnum); + sv_setuv(sv, do_vecget(lsv, LvTARGOFF(sv), LvTARGLEN(sv))); return 0; } @@ -1807,13 +1755,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) if (PL_uid == PL_euid) /* special case $< = $> */ (void)PerlProc_setuid(PL_uid); else { - PL_uid = (I32)PerlProc_getuid(); + PL_uid = PerlProc_getuid(); Perl_croak(aTHX_ "setruid() not implemented"); } #endif #endif #endif - PL_uid = (I32)PerlProc_getuid(); + PL_uid = PerlProc_getuid(); PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid)); break; case '>': @@ -1834,13 +1782,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) if (PL_euid == PL_uid) /* special case $> = $< */ PerlProc_setuid(PL_euid); else { - PL_euid = (I32)PerlProc_geteuid(); + PL_euid = PerlProc_geteuid(); Perl_croak(aTHX_ "seteuid() not implemented"); } #endif #endif #endif - PL_euid = (I32)PerlProc_geteuid(); + PL_euid = PerlProc_geteuid(); PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid)); break; case '(': @@ -1861,13 +1809,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) if (PL_gid == PL_egid) /* special case $( = $) */ (void)PerlProc_setgid(PL_gid); else { - PL_gid = (I32)PerlProc_getgid(); + PL_gid = PerlProc_getgid(); Perl_croak(aTHX_ "setrgid() not implemented"); } #endif #endif #endif - PL_gid = (I32)PerlProc_getgid(); + PL_gid = PerlProc_getgid(); PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid)); break; case ')': @@ -1878,7 +1826,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) while (isSPACE(*p)) ++p; - PL_egid = I_V(Atol(p)); + PL_egid = Atol(p); for (i = 0; i < NGROUPS; ++i) { while (*p && !isSPACE(*p)) ++p; @@ -1886,7 +1834,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) ++p; if (!*p) break; - gary[i] = I_V(Atol(p)); + gary[i] = Atol(p); } if (i) (void)setgroups(i, gary); @@ -1910,13 +1858,13 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg) if (PL_egid == PL_gid) /* special case $) = $( */ (void)PerlProc_setgid(PL_egid); else { - PL_egid = (I32)PerlProc_getegid(); + PL_egid = PerlProc_getegid(); Perl_croak(aTHX_ "setegid() not implemented"); } #endif #endif #endif - PL_egid = (I32)PerlProc_getegid(); + PL_egid = PerlProc_getegid(); PL_tainting |= (PL_uid && (PL_euid != PL_uid || PL_egid != PL_gid)); break; case ':':