Minor multi-threading patches for VMS.
[p5sagit/p5-mst-13.2.git] / mg.c
diff --git a/mg.c b/mg.c
index 6bc242a..b931065 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -1,6 +1,6 @@
 /*    mg.c
  *
- *    Copyright (c) 1991-1994, Larry Wall
+ *    Copyright (c) 1991-1997, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
 # include <unistd.h>
 #endif
 
-#ifdef HAS_GETGROUPS
+#if defined(HAS_GETGROUPS) || defined(HAS_SETGROUPS)
 #  ifndef NGROUPS
 #    define NGROUPS 32
 #  endif
 #endif
 
-#define TAINT_FROM_REGEX(sv,rx) \
-       if ((rx)->exec_tainted) {       \
-           SvTAINTED_on(sv);           \
-       } else                          \
-           SvTAINTED_off(sv);
-
 /*
  * Use the "DESTRUCTOR" scope cleanup to reinstate magic.
  */
@@ -44,15 +38,13 @@ typedef struct magic_state MGS;
 
 static void restore_magic _((void *p));
 
-static MGS *
-save_magic(sv)
+static void
+save_magic(mgs, sv)
+MGS* mgs;
 SV* sv;
 {
-    MGS* mgs;
-
     assert(SvMAGICAL(sv));
 
-    mgs = (MGS*)safemalloc(sizeof(MGS));
     mgs->mgs_sv = sv;
     mgs->mgs_flags = SvMAGICAL(sv) | SvREADONLY(sv);
     SAVEDESTRUCTOR(restore_magic, mgs);
@@ -60,15 +52,13 @@ SV* sv;
     SvMAGICAL_off(sv);
     SvREADONLY_off(sv);
     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
-
-    return mgs;
 }
 
 static void
 restore_magic(p)
 void* p;
 {
-    MGS *mgs = (MGS*)p;
+    MGS* mgs = (MGS*)p;
     SV* sv = mgs->mgs_sv;
 
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
@@ -80,8 +70,6 @@ void* p;
        if (SvGMAGICAL(sv))
            SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
     }
-
-    Safefree(mgs);
 }
 
 
@@ -107,13 +95,13 @@ int
 mg_get(sv)
 SV* sv;
 {
-    MGS* mgs;
+    MGS mgs;
     MAGIC* mg;
     MAGIC** mgp;
     int mgp_valid = 0;
 
     ENTER;
-    mgs = save_magic(sv);
+    save_magic(&mgs, sv);
 
     mgp = &SvMAGIC(sv);
     while ((mg = *mgp) != 0) {
@@ -121,8 +109,9 @@ SV* sv;
        if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
            (*vtbl->svt_get)(sv, mg);
            /* Ignore this magic if it's been deleted */
-           if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) && (mg->mg_flags & MGf_GSKIP))
-               mgs->mgs_flags = 0;
+           if ((mg == (mgp_valid ? *mgp : SvMAGIC(sv))) &&
+                 (mg->mg_flags & MGf_GSKIP))
+               mgs.mgs_flags = 0;
        }
        /* Advance to next magic (complicated by possible deletion) */
        if (mg == (mgp_valid ? *mgp : SvMAGIC(sv))) {
@@ -141,19 +130,19 @@ int
 mg_set(sv)
 SV* sv;
 {
-    MGS* mgs;
+    MGS mgs;
     MAGIC* mg;
     MAGIC* nextmg;
 
     ENTER;
-    mgs = save_magic(sv);
+    save_magic(&mgs, sv);
 
     for (mg = SvMAGIC(sv); mg; mg = nextmg) {
        MGVTBL* vtbl = mg->mg_virtual;
        nextmg = mg->mg_moremagic;      /* it may delete itself */
        if (mg->mg_flags & MGf_GSKIP) {
            mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */
-           mgs->mgs_flags = 0;
+           mgs.mgs_flags = 0;
        }
        if (vtbl && vtbl->svt_set)
            (*vtbl->svt_set)(sv, mg);
@@ -174,8 +163,10 @@ SV* sv;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
        MGVTBL* vtbl = mg->mg_virtual;
        if (vtbl && vtbl->svt_len) {
+           MGS mgs;
+
            ENTER;
-           save_magic(sv);
+           save_magic(&mgs, sv);
            /* omit MGf_GSKIP -- not changed here */
            len = (*vtbl->svt_len)(sv, mg);
            LEAVE;
@@ -191,10 +182,11 @@ int
 mg_clear(sv)
 SV* sv;
 {
+    MGS mgs;
     MAGIC* mg;
 
     ENTER;
-    save_magic(sv);
+    save_magic(&mgs, sv);
 
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
        MGVTBL* vtbl = mg->mg_virtual;
@@ -289,39 +281,33 @@ MAGIC *mg;
                (t = rx->endp[paren]))
            {
                i = t - s;
-               if (i >= 0) {
-                   TAINT_IF(rx->exec_tainted);
+               if (i >= 0)
                    return i;
-               }
            }
        }
        return 0;
-       break;
     case '+':
        if (curpm && (rx = curpm->op_pmregexp)) {
            paren = rx->lastparen;
-           if (!paren)
-               return 0;
-           goto getparen;
+           if (paren)
+               goto getparen;
        }
        return 0;
-       break;
     case '`':
        if (curpm && (rx = curpm->op_pmregexp)) {
-           if ((s = rx->subbeg)) {
+           if ((s = rx->subbeg) && rx->startp[0]) {
                i = rx->startp[0] - s;
-               if (i >= 0) {
-                   TAINT_IF(rx->exec_tainted);
+               if (i >= 0)
                    return i;
-               }
            }
        }
        return 0;
     case '\'':
        if (curpm && (rx = curpm->op_pmregexp)) {
-           if ((s = rx->endp[0])) {
-               TAINT_IF(rx->exec_tainted);
-               return (STRLEN) (rx->subend - s);
+           if (rx->subend && (s = rx->endp[0])) {
+               i = rx->subend - s;
+               if (i >= 0)
+                   return i;
            }
        }
        return 0;
@@ -418,9 +404,16 @@ MAGIC *mg;
                (t = rx->endp[paren]))
            {
                i = t - s;
+             getrx:
                if (i >= 0) {
+                   bool was_tainted;
+                   if (tainting) {
+                       was_tainted = tainted;
+                       tainted = FALSE;
+                   }
                    sv_setpvn(sv,s,i);
-                   TAINT_FROM_REGEX(sv,rx);
+                   if (tainting)
+                       tainted = was_tainted || rx->exec_tainted;
                    break;
                }
            }
@@ -437,23 +430,18 @@ MAGIC *mg;
        break;
     case '`':
        if (curpm && (rx = curpm->op_pmregexp)) {
-           if ((s = rx->subbeg)) {
+           if ((s = rx->subbeg) && rx->startp[0]) {
                i = rx->startp[0] - s;
-               if (i >= 0) {
-                   sv_setpvn(sv,s,i);
-                   TAINT_FROM_REGEX(sv,rx);
-                   break;
-               }
+               goto getrx;
            }
        }
        sv_setsv(sv,&sv_undef);
        break;
     case '\'':
        if (curpm && (rx = curpm->op_pmregexp)) {
-           if ((s = rx->endp[0])) {
-               sv_setpvn(sv,s, rx->subend - s);
-               TAINT_FROM_REGEX(sv,rx);
-               break;
+           if (rx->subend && (s = rx->endp[0])) {
+               i = rx->subend - s;
+               goto getrx;
            }
        }
        sv_setsv(sv,&sv_undef);
@@ -466,7 +454,14 @@ MAGIC *mg;
 #endif
        break;
     case '?':
-       sv_setiv(sv, (IV)statusvalue);
+       {
+           dTHR;
+           sv_setiv(sv, (IV)STATUS_CURRENT);
+#ifdef COMPLEX_STATUS
+           LvTARGOFF(sv) = statusvalue;
+           LvTARGLEN(sv) = statusvalue_vms;
+#endif
+       }
        break;
     case '^':
        s = IoTOP_NAME(GvIOp(defoutgv));
@@ -499,7 +494,7 @@ MAGIC *mg;
     case '/':
        break;
     case '[':
-       sv_setiv(sv, (IV)curcop->cop_arybase);
+       WITH_THR(sv_setiv(sv, (IV)curcop->cop_arybase));
        break;
     case '|':
        sv_setiv(sv, (IV)(IoFLAGS(GvIOp(defoutgv)) & IOf_FLUSH) != 0 );
@@ -539,27 +534,20 @@ MAGIC *mg;
        break;
     case '(':
        sv_setiv(sv, (IV)gid);
-       s = buf;
-       (void)sprintf(s,"%d",(int)gid);
+       sv_setpvf(sv, "%Vd", (IV)gid);
        goto add_groups;
     case ')':
        sv_setiv(sv, (IV)egid);
-       s = buf;
-       (void)sprintf(s,"%d",(int)egid);
+       sv_setpvf(sv, "%Vd", (IV)egid);
       add_groups:
-       while (*s) s++;
 #ifdef HAS_GETGROUPS
        {
            Groups_t gary[NGROUPS];
-
            i = getgroups(NGROUPS,gary);
-           while (--i >= 0) {
-               (void)sprintf(s," %d", (int)gary[i]);
-               while (*s) s++;
-           }
+           while (--i >= 0)
+               sv_catpvf(sv, " %Vd", (IV)gary[i]);
        }
 #endif
-       sv_setpv(sv,buf);
        SvIOK_on(sv);   /* what a wonderful hack! */
        break;
     case '*':
@@ -589,39 +577,73 @@ MAGIC* mg;
 {
     register char *s;
     char *ptr;
-    STRLEN len;
+    STRLEN len, klen;
     I32 i;
+
     s = SvPV(sv,len);
-    ptr = MgPV(mg);
+    ptr = MgPV(mg,klen);
     my_setenv(ptr, s);
+
 #ifdef DYNAMIC_ENV_FETCH
      /* We just undefd an environment var.  Is a replacement */
      /* waiting in the wings? */
     if (!len) {
-       HE *envhe;
-       SV *keysv;
-       if (mg->mg_len == HEf_SVKEY) keysv = (SV *)mg->mg_ptr;
-       else keysv = newSVpv(mg->mg_ptr,mg->mg_len);
-       if (envhe = hv_fetch_ent(GvHVn(envgv),keysv,FALSE,0))
-           s = SvPV(HeVAL(envhe),len);
-       if (mg->mg_len != HEf_SVKEY) SvREFCNT_dec(keysv);
+       SV **valp;
+       if ((valp = hv_fetch(GvHVn(envgv), ptr, klen, FALSE)))
+           s = SvPV(*valp, len);
     }
 #endif
+
+#if !defined(OS2) && !defined(AMIGAOS) && !defined(_WIN32)
                            /* And you'll never guess what the dog had */
                            /*   in its mouth... */
     if (tainting) {
-       if (s && strEQ(ptr,"PATH")) {
+       MgTAINTEDDIR_off(mg);
+#ifdef VMS
+       if (s && klen == 8 && strEQ(ptr, "DCL$PATH")) {
+           char pathbuf[256], eltbuf[256], *cp, *elt = s;
+           struct stat sbuf;
+           int i = 0, j = 0;
+
+           do {          /* DCL$PATH may be a search list */
+               while (1) {   /* as may dev portion of any element */
+                   if ( ((cp = strchr(elt,'[')) || (cp = strchr(elt,'<'))) ) {
+                       if ( *(cp+1) == '.' || *(cp+1) == '-' ||
+                            cando_by_name(S_IWUSR,0,elt) ) {
+                           MgTAINTEDDIR_on(mg);
+                           return 0;
+                       }
+                   }
+                   if ((cp = strchr(elt, ':')) != Nullch)
+                       *cp = '\0';
+                   if (my_trnlnm(elt, eltbuf, j++))
+                       elt = eltbuf;
+                   else
+                       break;
+               }
+               j = 0;
+           } while (my_trnlnm(s, pathbuf, i++) && (elt = pathbuf));
+       }
+#endif /* VMS */
+       if (s && klen == 4 && strEQ(ptr,"PATH")) {
            char *strend = s + len;
 
            while (s < strend) {
-               s = cpytill(tokenbuf,s,strend,':',&i);
+               struct stat st;
+               s = delimcpy(tokenbuf, tokenbuf + sizeof tokenbuf,
+                            s, strend, ':', &i);
                s++;
-               if (*tokenbuf != '/'
-                 || (Stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
+               if (i >= sizeof tokenbuf   /* too long -- assume the worst */
+                     || *tokenbuf != '/'
+                     || (Stat(tokenbuf, &st) == 0 && (st.st_mode & 2)) ) {
                    MgTAINTEDDIR_on(mg);
+                   return 0;
+               }
            }
        }
     }
+#endif /* neither OS2 nor AMIGAOS nor _WIN32 */
+
     return 0;
 }
 
@@ -630,7 +652,7 @@ magic_clearenv(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
-    my_setenv(MgPV(mg),Nullch);
+    my_setenv(MgPV(mg,na),Nullch);
     return 0;
 }
 
@@ -641,13 +663,13 @@ MAGIC* mg;
 {
     I32 i;
     /* Are we fetching a signal entry? */
-    i = whichsig(MgPV(mg));
+    i = whichsig(MgPV(mg,na));
     if (i) {
        if(psig_ptr[i])
            sv_setsv(sv,psig_ptr[i]);
        else {
-           Sighandler_t sigstate;
-           sigstate = rsignalstate(i);
+           dTHR;               /* just for SvREFCNT_inc */
+           Sighandler_t sigstate = rsignal_state(i);
 
            /* cache state so we don't fetch it again */
            if(sigstate == SIG_IGN)
@@ -667,7 +689,7 @@ MAGIC* mg;
 {
     I32 i;
     /* Are we clearing a signal entry? */
-    i = whichsig(MgPV(mg));
+    i = whichsig(MgPV(mg,na));
     if (i) {
        if(psig_ptr[i]) {
            SvREFCNT_dec(psig_ptr[i]);
@@ -686,11 +708,12 @@ magic_setsig(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     register char *s;
     I32 i;
     SV** svp;
 
-    s = MgPV(mg);
+    s = MgPV(mg,na);
     if (*s == '_') {
        if (strEQ(s,"__DIE__"))
            svp = &diehook;
@@ -713,18 +736,16 @@ MAGIC* mg;
                warn("No such signal: SIG%s", s);
            return 0;
        }
-        if(psig_ptr[i])
-           SvREFCNT_dec(psig_ptr[i]);
+       SvREFCNT_dec(psig_name[i]);
+       SvREFCNT_dec(psig_ptr[i]);
        psig_ptr[i] = SvREFCNT_inc(sv);
-       if(psig_name[i])
-           SvREFCNT_dec(psig_name[i]);
-       psig_name[i] = newSVpv(s,strlen(s));
        SvTEMP_off(sv); /* Make sure it doesn't go away on us */
+       psig_name[i] = newSVpv(s, strlen(s));
        SvREADONLY_on(psig_name[i]);
     }
     if (SvTYPE(sv) == SVt_PVGV || SvROK(sv)) {
        if (i)
-           (void)rsignal(i,sighandler);
+           (void)rsignal(i, sighandler);
        else
            *svp = SvREFCNT_inc(sv);
        return 0;
@@ -732,25 +753,26 @@ MAGIC* mg;
     s = SvPV_force(sv,na);
     if (strEQ(s,"IGNORE")) {
        if (i)
-           (void)rsignal(i,SIG_IGN);
+           (void)rsignal(i, SIG_IGN);
        else
            *svp = 0;
     }
     else if (strEQ(s,"DEFAULT") || !*s) {
        if (i)
-           (void)rsignal(i,SIG_DFL);
+           (void)rsignal(i, SIG_DFL);
        else
            *svp = 0;
     }
     else {
-       if(hints & HINT_STRICT_REFS)
-               die(no_symref,s,"a subroutine");
-       if (!strchr(s,':') && !strchr(s,'\'')) {
-           sprintf(tokenbuf, "main::%s",s);
-           sv_setpv(sv,tokenbuf);
-       }
+       /*
+        * We should warn if HINT_STRICT_REFS, but without
+        * access to a known hint bit in a known OP, we can't
+        * tell whether HINT_STRICT_REFS is in force or not.
+        */
+       if (!strchr(s,':') && !strchr(s,'\''))
+           sv_setpv(sv, form("main::%s", s));
        if (i)
-           (void)rsignal(i,sighandler);
+           (void)rsignal(i, sighandler);
        else
            *svp = SvREFCNT_inc(sv);
     }
@@ -798,6 +820,7 @@ SV* sv;
 MAGIC* mg;
 char *meth;
 {
+    dTHR;
     dSP;
 
     ENTER;
@@ -839,6 +862,7 @@ magic_setpack(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     dSP;
 
     PUSHMARK(sp);
@@ -872,6 +896,7 @@ int magic_wipepack(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     dSP;
 
     PUSHMARK(sp);
@@ -889,6 +914,7 @@ SV* sv;
 MAGIC* mg;
 SV* key;
 {
+    dTHR;
     dSP;
     char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
 
@@ -922,6 +948,7 @@ magic_setdbline(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     OP *o;
     I32 i;
     GV* gv;
@@ -930,7 +957,7 @@ MAGIC* mg;
     gv = DBline;
     i = SvTRUE(sv);
     svp = av_fetch(GvAV(gv),
-                    atoi(MgPV(mg)), FALSE);
+                    atoi(MgPV(mg,na)), FALSE);
     if (svp && SvIOKp(*svp) && (o = (OP*)SvSTASH(*svp)))
        o->op_private = i;
     else
@@ -943,6 +970,7 @@ magic_getarylen(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + curcop->cop_arybase);
     return 0;
 }
@@ -952,6 +980,7 @@ magic_setarylen(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     av_fill((AV*)mg->mg_obj, SvIV(sv) - curcop->cop_arybase);
     return 0;
 }
@@ -966,6 +995,7 @@ MAGIC* mg;
     if (SvTYPE(lsv) >= SVt_PVMG && SvMAGIC(lsv)) {
        mg = mg_find(lsv, 'g');
        if (mg && mg->mg_len >= 0) {
+           dTHR;
            sv_setiv(sv, mg->mg_len + curcop->cop_arybase);
            return 0;
        }
@@ -999,7 +1029,7 @@ MAGIC* mg;
     }
     len = SvPOK(lsv) ? SvCUR(lsv) : sv_len(lsv);
 
-    pos = SvIV(sv) - curcop->cop_arybase;
+    WITH_THR(pos = SvIV(sv) - curcop->cop_arybase);
     if (pos < 0) {
        pos += len;
        if (pos < 0)
@@ -1008,6 +1038,7 @@ MAGIC* mg;
     else if (pos > len)
        pos = len;
     mg->mg_len = pos;
+    mg->mg_flags &= ~MGf_MINMATCH;
 
     return 0;
 }
@@ -1046,12 +1077,6 @@ MAGIC* mg;
     if (GvGP(sv))
        gp_free((GV*)sv);
     GvGP(sv) = gp_ref(GvGP(gv));
-    if (!GvAV(gv))
-       gv_AVadd(gv);
-    if (!GvHV(gv))
-       gv_HVadd(gv);
-    if (!GvIOp(gv))
-       GvIOp(gv) = newIO();
     return 0;
 }
 
@@ -1081,6 +1106,7 @@ magic_settaint(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     if (localizing) {
        if (localizing == 1)
            mg->mg_len <<= 1;
@@ -1104,6 +1130,99 @@ MAGIC* mg;
 }
 
 int
+magic_getdefelem(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    SV *targ = Nullsv;
+    if (LvTARGLEN(sv)) {
+       if (mg->mg_obj) {
+           HV* hv = (HV*)LvTARG(sv);
+           HE* he = hv_fetch_ent(hv, mg->mg_obj, FALSE, 0);
+           if (he)
+               targ = HeVAL(he);
+       }
+       else {
+           AV* av = (AV*)LvTARG(sv);
+           if ((I32)LvTARGOFF(sv) <= AvFILL(av))
+               targ = AvARRAY(av)[LvTARGOFF(sv)];
+       }
+       if (targ && targ != &sv_undef) {
+           dTHR;               /* just for SvREFCNT_dec */
+           /* somebody else defined it for us */
+           SvREFCNT_dec(LvTARG(sv));
+           LvTARG(sv) = SvREFCNT_inc(targ);
+           LvTARGLEN(sv) = 0;
+           SvREFCNT_dec(mg->mg_obj);
+           mg->mg_obj = Nullsv;
+           mg->mg_flags &= ~MGf_REFCOUNTED;
+       }
+    }
+    else
+       targ = LvTARG(sv);
+    sv_setsv(sv, targ ? targ : &sv_undef);
+    return 0;
+}
+
+int
+magic_setdefelem(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    if (LvTARGLEN(sv))
+       vivify_defelem(sv);
+    if (LvTARG(sv)) {
+       sv_setsv(LvTARG(sv), sv);
+       SvSETMAGIC(LvTARG(sv));
+    }
+    return 0;
+}
+
+int
+magic_freedefelem(sv,mg)
+SV* sv;
+MAGIC* mg;
+{
+    SvREFCNT_dec(LvTARG(sv));
+    return 0;
+}
+
+void
+vivify_defelem(sv)
+SV* sv;
+{
+    dTHR;                      /* just for SvREFCNT_inc and SvREFCNT_dec*/
+    MAGIC* mg;
+    SV* value;
+
+    if (!LvTARGLEN(sv) || !(mg = mg_find(sv, 'y')))
+       return;
+    if (mg->mg_obj) {
+       HV* hv = (HV*)LvTARG(sv);
+       HE* he = hv_fetch_ent(hv, mg->mg_obj, TRUE, 0);
+       if (!he || (value = HeVAL(he)) == &sv_undef)
+           croak(no_helem, SvPV(mg->mg_obj, na));
+    }
+    else {
+       AV* av = (AV*)LvTARG(sv);
+       if ((I32)LvTARGLEN(sv) < 0 && (I32)LvTARGOFF(sv) > AvFILL(av))
+           LvTARG(sv) = Nullsv;        /* array can't be extended */
+       else {
+           SV** svp = av_fetch(av, LvTARGOFF(sv), TRUE);
+           if (!svp || (value = *svp) == &sv_undef)
+               croak(no_aelem, (I32)LvTARGOFF(sv));
+       }
+    }
+    SvREFCNT_inc(value);
+    SvREFCNT_dec(LvTARG(sv));
+    LvTARG(sv) = value;
+    LvTARGLEN(sv) = 0;
+    SvREFCNT_dec(mg->mg_obj);
+    mg->mg_obj = Nullsv;
+    mg->mg_flags &= ~MGf_REFCOUNTED;
+}
+
+int
 magic_setmglob(sv,mg)
 SV* sv;
 MAGIC* mg;
@@ -1145,6 +1264,7 @@ MAGIC* mg;
     return 0;
 }
 
+#ifdef USE_LOCALE_COLLATE
 int
 magic_setcollxfrm(sv,mg)
 SV* sv;
@@ -1154,15 +1274,21 @@ MAGIC* mg;
      * RenĂ© Descartes said "I think not."
      * and vanished with a faint plop.
      */
-    sv_unmagic(sv, 'o');
+    if (mg->mg_ptr) {
+       Safefree(mg->mg_ptr);
+       mg->mg_ptr = NULL;
+       mg->mg_len = -1;
+    }
     return 0;
 }
+#endif /* USE_LOCALE_COLLATE */
 
 int
 magic_set(sv,mg)
 SV* sv;
 MAGIC* mg;
 {
+    dTHR;
     register char *s;
     I32 i;
     STRLEN len;
@@ -1178,7 +1304,8 @@ MAGIC* mg;
 #ifdef VMS
        set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 #else
-       SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),4);         /* will anyone ever use this? */
+       /* will anyone ever use this? */
+       SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
 #endif
        break;
     case '\006':       /* ^F */
@@ -1253,9 +1380,18 @@ MAGIC* mg;
        IoPAGE(GvIOp(defoutgv)) = (long)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
        break;
     case '|':
-       IoFLAGS(GvIOp(defoutgv)) &= ~IOf_FLUSH;
-       if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) != 0) {
-           IoFLAGS(GvIOp(defoutgv)) |= IOf_FLUSH;
+       {
+           IO *io = GvIOp(defoutgv);
+           if ((SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)) == 0)
+               IoFLAGS(io) &= ~IOf_FLUSH;
+           else {
+               if (!(IoFLAGS(io) & IOf_FLUSH)) {
+                   PerlIO *ofp = IoOFP(io);
+                   if (ofp)
+                       (void)PerlIO_flush(ofp);
+                   IoFLAGS(io) |= IOf_FLUSH;
+               }
+           }
        }
        break;
     case '*':
@@ -1271,7 +1407,12 @@ MAGIC* mg;
     case '\\':
        if (ors)
            Safefree(ors);
-       ors = savepv(SvPV(sv,orslen));
+       if (SvOK(sv) || SvGMAGICAL(sv))
+           ors = savepv(SvPV(sv,orslen));
+       else {
+           ors = Nullch;
+           orslen = 0;
+       }
        break;
     case ',':
        if (ofs)
@@ -1287,10 +1428,23 @@ MAGIC* mg;
        compiling.cop_arybase = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
        break;
     case '?':
-       statusvalue = FIXSTATUS(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
+#ifdef COMPLEX_STATUS
+       if (localizing == 2) {
+           statusvalue = LvTARGOFF(sv);
+           statusvalue_vms = LvTARGLEN(sv);
+       }
+       else
+#endif
+#ifdef VMSISH_STATUS
+       if (VMSISH_STATUS)
+           STATUS_NATIVE_SET((U32)(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv)));
+       else
+#endif
+           STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
        break;
     case '!':
-       SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),SvIV(sv) == EVMSERR ? 4 : vaxc$errno);              /* will anyone ever use this? */
+       SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),
+                (SvIV(sv) == EVMSERR) ? 4 : vaxc$errno);
        break;
     case '<':
        uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
@@ -1374,7 +1528,30 @@ MAGIC* mg;
        tainting |= (uid && (euid != uid || egid != gid));
        break;
     case ')':
+#ifdef HAS_SETGROUPS
+       {
+           char *p = SvPV(sv, na);
+           Groups_t gary[NGROUPS];
+
+           SET_NUMERIC_STANDARD();
+           while (isSPACE(*p))
+               ++p;
+           egid = I_V(atof(p));
+           for (i = 0; i < NGROUPS; ++i) {
+               while (*p && !isSPACE(*p))
+                   ++p;
+               while (isSPACE(*p))
+                   ++p;
+               if (!*p)
+                   break;
+               gary[i] = I_V(atof(p));
+           }
+           if (i)
+               (void)setgroups(i, gary);
+       }
+#else  /* HAS_SETGROUPS */
        egid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
+#endif /* HAS_SETGROUPS */
        if (delaymagic) {
            delaymagic |= DM_EGID;
            break;                              /* don't do magic till later */
@@ -1445,6 +1622,23 @@ MAGIC* mg;
     return 0;
 }
 
+#ifdef USE_THREADS
+int
+magic_mutexfree(sv, mg)
+SV *sv;
+MAGIC *mg;
+{
+    dTHR;
+    DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: magic_mutexfree 0x%lx\n",
+                         (unsigned long)thr, (unsigned long)sv);)
+    if (MgOWNER(mg))
+       croak("panic: magic_mutexfree");
+    MUTEX_DESTROY(MgMUTEXP(mg));
+    COND_DESTROY(MgCONDP(mg));
+    return 0;
+}
+#endif /* USE_THREADS */
+
 I32
 whichsig(sig)
 char *sig;
@@ -1469,16 +1663,17 @@ Signal_t
 sighandler(sig)
 int sig;
 {
+    dTHR;
     dSP;
     GV *gv;
     HV *st;
     SV *sv;
     CV *cv;
     AV *oldstack;
-    
-    if(!psig_ptr[sig])
-       die("Signal SIG%s received, but no signal handler set.\n",
-       sig_name[sig]);
+
+    if (!psig_ptr[sig])
+       die("Signal SIG%s received, but no signal handler set.\n",
+           sig_name[sig]);
 
     cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE);
     if (!cv || !CvROOT(cv)) {
@@ -1496,8 +1691,8 @@ int sig;
     if(psig_name[sig])
        sv = SvREFCNT_inc(psig_name[sig]);
     else {
-        sv = sv_newmortal();
-        sv_setpv(sv,sig_name[sig]);
+       sv = sv_newmortal();
+       sv_setpv(sv,sig_name[sig]);
     }
     PUSHMARK(sp);
     PUSHs(sv);