applied patch, tweaked doc, and regen regnodes.h
[p5sagit/p5-mst-13.2.git] / mg.c
diff --git a/mg.c b/mg.c
index ea46b68..d6ea1d2 100644 (file)
--- a/mg.c
+++ b/mg.c
  * Use the "DESTRUCTOR" scope cleanup to reinstate magic.
  */
 
+#ifdef PERL_OBJECT
+
+#define VTBL            this->*vtbl
+
+#else
 struct magic_state {
     SV* mgs_sv;
     U32 mgs_flags;
@@ -37,8 +42,11 @@ struct magic_state {
 typedef struct magic_state MGS;
 
 static void restore_magic _((void *p));
+#define VTBL                   *vtbl
+
+#endif
 
-static void
+STATIC void
 save_magic(MGS *mgs, SV *sv)
 {
     assert(SvMAGICAL(sv));
@@ -52,7 +60,7 @@ save_magic(MGS *mgs, SV *sv)
     SvFLAGS(sv) |= (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK)) >> PRIVSHIFT;
 }
 
-static void
+STATIC void
 restore_magic(void *p)
 {
     MGS* mgs = (MGS*)p;
@@ -69,7 +77,6 @@ restore_magic(void *p)
     }
 }
 
-
 void
 mg_magical(SV *sv)
 {
@@ -77,11 +84,11 @@ mg_magical(SV *sv)
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
        MGVTBL* vtbl = mg->mg_virtual;
        if (vtbl) {
-           if (vtbl->svt_get && !(mg->mg_flags & MGf_GSKIP))
+           if ((vtbl->svt_get != NULL) && !(mg->mg_flags & MGf_GSKIP))
                SvGMAGICAL_on(sv);
            if (vtbl->svt_set)
                SvSMAGICAL_on(sv);
-           if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || vtbl->svt_clear)
+           if (!(SvFLAGS(sv) & (SVs_GMG|SVs_SMG)) || (vtbl->svt_clear != NULL))
                SvRMAGICAL_on(sv);
        }
     }
@@ -101,8 +108,8 @@ mg_get(SV *sv)
     mgp = &SvMAGIC(sv);
     while ((mg = *mgp) != 0) {
        MGVTBL* vtbl = mg->mg_virtual;
-       if (!(mg->mg_flags & MGf_GSKIP) && vtbl && vtbl->svt_get) {
-           (*vtbl->svt_get)(sv, mg);
+       if (!(mg->mg_flags & MGf_GSKIP) && vtbl && (vtbl->svt_get != NULL)) {
+           (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))
@@ -138,8 +145,8 @@ mg_set(SV *sv)
            mg->mg_flags &= ~MGf_GSKIP; /* setting requires another read */
            mgs.mgs_flags = 0;
        }
-       if (vtbl && vtbl->svt_set)
-           (*vtbl->svt_set)(sv, mg);
+       if (vtbl && (vtbl->svt_set != NULL))
+           (VTBL->svt_set)(sv, mg);
     }
 
     LEAVE;
@@ -147,7 +154,7 @@ mg_set(SV *sv)
 }
 
 U32
-mg_len(SV *sv)
+mg_length(SV *sv)
 {
     MAGIC* mg;
     char *junk;
@@ -155,13 +162,13 @@ mg_len(SV *sv)
 
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
        MGVTBL* vtbl = mg->mg_virtual;
-       if (vtbl && vtbl->svt_len) {
+       if (vtbl && (vtbl->svt_len != NULL)) {
            MGS mgs;
 
            ENTER;
            save_magic(&mgs, sv);
            /* omit MGf_GSKIP -- not changed here */
-           len = (*vtbl->svt_len)(sv, mg);
+           len = (VTBL->svt_len)(sv, mg);
            LEAVE;
            return len;
        }
@@ -171,6 +178,37 @@ mg_len(SV *sv)
     return len;
 }
 
+I32
+mg_size(SV *sv)
+{
+    MAGIC* mg;
+    I32 len;
+    
+    for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
+       MGVTBL* vtbl = mg->mg_virtual;
+       if (vtbl && (vtbl->svt_len != NULL)) {
+           MGS mgs;
+           ENTER;
+           /* omit MGf_GSKIP -- not changed here */
+           len = (VTBL->svt_len)(sv, mg);
+           LEAVE;
+           return len;
+       }
+    }
+
+    switch(SvTYPE(sv)) {
+       case SVt_PVAV:
+           len = AvFILLp((AV *) sv); /* Fallback to non-tied array */
+           return len;
+       case SVt_PVHV:
+           /* FIXME */
+       default:
+           croak("Size magic not implemented");
+           break;
+    }
+    return 0;
+}
+
 int
 mg_clear(SV *sv)
 {
@@ -184,8 +222,8 @@ mg_clear(SV *sv)
        MGVTBL* vtbl = mg->mg_virtual;
        /* omit GSKIP -- never set here */
        
-       if (vtbl && vtbl->svt_clear)
-           (*vtbl->svt_clear)(sv, mg);
+       if (vtbl && (vtbl->svt_clear != NULL))
+           (VTBL->svt_clear)(sv, mg);
     }
 
     LEAVE;
@@ -225,8 +263,8 @@ mg_free(SV *sv)
     for (mg = SvMAGIC(sv); mg; mg = moremagic) {
        MGVTBL* vtbl = mg->mg_virtual;
        moremagic = mg->mg_moremagic;
-       if (vtbl && vtbl->svt_free)
-           (*vtbl->svt_free)(sv, mg);
+       if (vtbl && (vtbl->svt_free != NULL))
+           (VTBL->svt_free)(sv, mg);
        if (mg->mg_ptr && mg->mg_type != 'g')
            if (mg->mg_len >= 0)
                Safefree(mg->mg_ptr);
@@ -247,6 +285,7 @@ mg_free(SV *sv)
 U32
 magic_len(SV *sv, MAGIC *mg)
 {
+    dTHR;
     register I32 paren;
     register char *s;
     register I32 i;
@@ -310,6 +349,7 @@ magic_len(SV *sv, MAGIC *mg)
 int
 magic_get(SV *sv, MAGIC *mg)
 {
+    dTHR;
     register I32 paren;
     register char *s;
     register I32 i;
@@ -348,10 +388,32 @@ magic_get(SV *sv, MAGIC *mg)
            sv_setpv(sv, os2error(Perl_rc));
        }
 #else
+#ifdef WIN32
+       {
+           DWORD dwErr = GetLastError();
+           sv_setnv(sv, (double)dwErr);
+           if (dwErr)
+           {
+#ifdef PERL_OBJECT
+               char *sMsg;
+               DWORD dwLen;
+               PerlProc_GetSysMsg(sMsg, dwLen, dwErr);
+               sv_setpvn(sv, sMsg, dwLen);
+               PerlProc_FreeBuf(sMsg);
+#else
+               win32_str_os_error(sv, dwErr);
+#endif
+           }
+           else
+               sv_setpv(sv, "");
+           SetLastError(dwErr);
+       }
+#else
        sv_setnv(sv, (double)errno);
        sv_setpv(sv, errno ? Strerror(errno) : "");
 #endif
 #endif
+#endif
        SvNOK_on(sv);   /* what a wonderful hack! */
        break;
     case '\006':               /* ^F */
@@ -396,7 +458,11 @@ magic_get(SV *sv, MAGIC *mg)
     case '1': case '2': case '3': case '4':
     case '5': case '6': case '7': case '8': case '9': case '&':
        if (curpm && (rx = curpm->op_pmregexp)) {
-           paren = atoi(GvENAME((GV*)mg->mg_obj));
+           /*
+            * Pre-threads, this was paren = atoi(GvENAME((GV*)mg->mg_obj));
+            * XXX Does the new way break anything?
+            */
+           paren = atoi(mg->mg_ptr);
          getparen:
            if (paren <= rx->nparens &&
                (s = rx->startp[paren]) &&
@@ -412,7 +478,8 @@ magic_get(SV *sv, MAGIC *mg)
                    }
                    sv_setpvn(sv,s,i);
                    if (tainting)
-                       tainted = was_tainted || rx->exec_tainted;
+                       tainted = (was_tainted || RX_MATCH_TAINTED(rx) ||
+                                  (curpm->op_pmflags & PMf_TAINTMEM));
                    break;
                }
            }
@@ -553,6 +620,11 @@ magic_get(SV *sv, MAGIC *mg)
        break;
     case '0':
        break;
+#ifdef USE_THREADS
+    case '@':
+       sv_setsv(sv, thr->errsv);
+       break;
+#endif /* USE_THREADS */
     }
     return 0;
 }
@@ -589,7 +661,7 @@ magic_setenv(SV *sv, MAGIC *mg)
     }
 #endif
 
-#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32)
+#if !defined(OS2) && !defined(AMIGAOS) && !defined(WIN32) && !defined(MSDOS)
                            /* And you'll never guess what the dog had */
                            /*   in its mouth... */
     if (tainting) {
@@ -631,14 +703,14 @@ magic_setenv(SV *sv, MAGIC *mg)
                s++;
                if (i >= sizeof tmpbuf   /* too long -- assume the worst */
                      || *tmpbuf != '/'
-                     || (Stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) {
+                     || (PerlLIO_stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) {
                    MgTAINTEDDIR_on(mg);
                    return 0;
                }
            }
        }
     }
-#endif /* neither OS2 nor AMIGAOS nor WIN32 */
+#endif /* neither OS2 nor AMIGAOS nor WIN32 nor MSDOS */
 
     return 0;
 }
@@ -718,7 +790,6 @@ magic_getsig(SV *sv, MAGIC *mg)
        if(psig_ptr[i])
            sv_setsv(sv,psig_ptr[i]);
        else {
-           dTHR;               /* just for SvREFCNT_inc */
            Sighandler_t sigstate = rsignal_state(i);
 
            /* cache state so we don't fetch it again */
@@ -828,7 +899,55 @@ magic_setsig(SV *sv, MAGIC *mg)
 int
 magic_setisa(SV *sv, MAGIC *mg)
 {
+    HV *stash;
+    SV **svp;
+    I32 fill;
+    HV *basefields = Nullhv;
+    GV **gvp;
+    GV *gv;
+    HE *he;
+    static char *FIELDS = "FIELDS";
+
     sub_generation++;
+
+    if (mg->mg_type == 'i')
+       return 0;       /* Ignore lower-case version of the magic */
+
+    stash = GvSTASH(mg->mg_obj);
+    svp = AvARRAY((AV*)sv);
+                
+    /* NOTE: No support for tied ISA */
+    for (fill = AvFILLp((AV*)sv); fill >= 0; fill--, svp++) {
+       HV *basestash = gv_stashsv(*svp, FALSE);
+
+       if (!basestash) {
+           if (dowarn)
+               warn("No such package \"%_\" in @ISA assignment", *svp);
+           continue;
+       }
+       gvp = (GV**)hv_fetch(basestash, FIELDS, 6, FALSE);
+       if (gvp && *gvp && GvHV(*gvp)) {
+           if (basefields)
+               croak("Can't multiply inherit %%FIELDS");
+           basefields = GvHV(*gvp);
+       }
+    }
+
+    if (!basefields)
+       return 0;
+    
+    gv = (GV*)*hv_fetch(stash, FIELDS, 6, TRUE);
+    if (!isGV(gv))
+       gv_init(gv, stash, FIELDS, 6, TRUE);
+    if (!GvHV(gv))
+       GvHV(gv) = newHV();
+    if (HvKEYS(GvHV(gv)))
+       croak("Inherited %%FIELDS can't override existing %%FIELDS");
+
+    hv_iterinit(GvHV(gv));
+    while ((he = hv_iternext(basefields)))
+       hv_store(GvHV(gv), HeKEY(he), HeKLEN(he), HeVAL(he), HeHASH(he));
+
     return 0;
 }
 
@@ -845,39 +964,79 @@ magic_setamagic(SV *sv, MAGIC *mg)
 #endif /* OVERLOAD */
 
 int
+magic_getnkeys(SV *sv, MAGIC *mg)
+{
+    HV *hv = (HV*)LvTARG(sv);
+    HE *entry;
+    I32 i = 0;
+
+    if (hv) {
+       (void) hv_iterinit(hv);
+       if (!SvRMAGICAL(hv) || !mg_find((SV*)hv,'P'))
+           i = HvKEYS(hv);
+       else {
+           /*SUPPRESS 560*/
+           while (entry = hv_iternext(hv)) {
+               i++;
+           }
+       }
+    }
+
+    sv_setiv(sv, (IV)i);
+    return 0;
+}
+
+int
 magic_setnkeys(SV *sv, MAGIC *mg)
 {
     if (LvTARG(sv)) {
        hv_ksplit((HV*)LvTARG(sv), SvIV(sv));
-       LvTARG(sv) = Nullsv;    /* Don't allow a ref to reassign this. */
     }
     return 0;
+}          
+
+/* caller is responsible for stack switching/cleanup */
+STATIC int
+magic_methcall(MAGIC *mg, char *meth, I32 flags, int n, SV *val)
+{
+    dSP;
+
+    PUSHMARK(SP);
+    EXTEND(SP, n);
+    PUSHs(mg->mg_obj);
+    if (n > 1) { 
+       if (mg->mg_ptr) {
+           if (mg->mg_len >= 0)
+               PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
+           else if (mg->mg_len == HEf_SVKEY)
+               PUSHs((SV*)mg->mg_ptr);
+       }
+       else if (mg->mg_type == 'p') {
+           PUSHs(sv_2mortal(newSViv(mg->mg_len)));
+       }
+    }
+    if (n > 2) {
+       PUSHs(val);
+    }
+    PUTBACK;
+
+    return perl_call_method(meth, flags);
 }
 
-static int
+STATIC int
 magic_methpack(SV *sv, MAGIC *mg, char *meth)
 {
-    dTHR;
     dSP;
 
     ENTER;
     SAVETMPS;
-    PUSHMARK(sp);
-    EXTEND(sp, 2);
-    PUSHs(mg->mg_obj);
-    if (mg->mg_ptr) {
-       if (mg->mg_len >= 0)
-           PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
-       else if (mg->mg_len == HEf_SVKEY)
-           PUSHs((SV*)mg->mg_ptr);
-    }
-    else if (mg->mg_type == 'p')
-       PUSHs(sv_2mortal(newSViv(mg->mg_len)));
-    PUTBACK;
+    PUSHSTACK(SI_MAGIC);
 
-    if (perl_call_method(meth, G_SCALAR))
+    if (magic_methcall(mg, meth, G_SCALAR, 2, NULL)) {
        sv_setsv(sv, *stack_sp--);
+    }
 
+    POPSTACK();
     FREETMPS;
     LEAVE;
     return 0;
@@ -895,25 +1054,12 @@ magic_getpack(SV *sv, MAGIC *mg)
 int
 magic_setpack(SV *sv, MAGIC *mg)
 {
-    dTHR;
     dSP;
-
-    PUSHMARK(sp);
-    EXTEND(sp, 3);
-    PUSHs(mg->mg_obj);
-    if (mg->mg_ptr) {
-       if (mg->mg_len >= 0)
-           PUSHs(sv_2mortal(newSVpv(mg->mg_ptr, mg->mg_len)));
-       else if (mg->mg_len == HEf_SVKEY)
-           PUSHs((SV*)mg->mg_ptr);
-    }
-    else if (mg->mg_type == 'p')
-       PUSHs(sv_2mortal(newSViv(mg->mg_len)));
-    PUSHs(sv);
-    PUTBACK;
-
-    perl_call_method("STORE", G_SCALAR|G_DISCARD);
-
+    ENTER;
+    PUSHSTACK(SI_MAGIC);
+    magic_methcall(mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
+    POPSTACK();
+    LEAVE;
     return 0;
 }
 
@@ -923,31 +1069,52 @@ magic_clearpack(SV *sv, MAGIC *mg)
     return magic_methpack(sv,mg,"DELETE");
 }
 
+
+U32
+magic_sizepack(SV *sv, MAGIC *mg)
+{         
+    dSP;
+    U32 retval = 0;
+
+    ENTER;
+    SAVETMPS;
+    PUSHSTACK(SI_MAGIC);
+    if (magic_methcall(mg, "FETCHSIZE", G_SCALAR, 2, NULL)) {
+       sv = *stack_sp--;
+       retval = (U32) SvIV(sv)-1;
+    }
+    POPSTACK();
+    FREETMPS;
+    LEAVE;
+    return retval;
+}
+
 int magic_wipepack(SV *sv, MAGIC *mg)
 {
-    dTHR;
     dSP;
 
-    PUSHMARK(sp);
+    ENTER;
+    PUSHSTACK(SI_MAGIC);
+    PUSHMARK(SP);
     XPUSHs(mg->mg_obj);
     PUTBACK;
-
     perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
-
+    POPSTACK();
+    LEAVE;
     return 0;
 }
 
 int
 magic_nextpack(SV *sv, MAGIC *mg, SV *key)
 {
-    dTHR;
     dSP;
     char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
 
     ENTER;
     SAVETMPS;
-    PUSHMARK(sp);
-    EXTEND(sp, 2);
+    PUSHSTACK(SI_MAGIC);
+    PUSHMARK(SP);
+    EXTEND(SP, 2);
     PUSHs(mg->mg_obj);
     if (SvOK(key))
        PUSHs(key);
@@ -956,6 +1123,7 @@ magic_nextpack(SV *sv, MAGIC *mg, SV *key)
     if (perl_call_method(meth, G_SCALAR))
        sv_setsv(key, *stack_sp--);
 
+    POPSTACK();
     FREETMPS;
     LEAVE;
     return 0;
@@ -1091,6 +1259,23 @@ magic_setglob(SV *sv, MAGIC *mg)
 }
 
 int
+magic_getsubstr(SV *sv, MAGIC *mg)
+{
+    STRLEN len;
+    SV *lsv = LvTARG(sv);
+    char *tmps = SvPV(lsv,len);
+    I32 offs = LvTARGOFF(sv);
+    I32 rem = LvTARGLEN(sv);
+
+    if (offs > len)
+       offs = len;
+    if (rem + offs > len)
+       rem = len - offs;
+    sv_setpvn(sv, tmps + offs, (STRLEN)rem);
+    return 0;
+}
+
+int
 magic_setsubstr(SV *sv, MAGIC *mg)
 {
     STRLEN len;
@@ -1102,6 +1287,7 @@ magic_setsubstr(SV *sv, MAGIC *mg)
 int
 magic_gettaint(SV *sv, MAGIC *mg)
 {
+    dTHR;
     TAINT_IF((mg->mg_len & 1) ||
             (mg->mg_len & 2) && mg->mg_obj == sv);     /* kludge */
     return 0;
@@ -1125,6 +1311,72 @@ magic_settaint(SV *sv, MAGIC *mg)
 }
 
 int
+magic_getvec(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);
+    return 0;
+}
+
+int
 magic_setvec(SV *sv, MAGIC *mg)
 {
     do_vecset(sv);     /* XXX slurp this routine */
@@ -1251,6 +1503,14 @@ magic_setuvar(SV *sv, MAGIC *mg)
     return 0;
 }
 
+int
+magic_freeregexp(SV *sv, MAGIC *mg)
+{
+    regexp *re = (regexp *)mg->mg_obj;
+    ReREFCNT_dec(re);
+    return 0;
+}
+
 #ifdef USE_LOCALE_COLLATE
 int
 magic_setcollxfrm(SV *sv, MAGIC *mg)
@@ -1287,9 +1547,13 @@ magic_set(SV *sv, MAGIC *mg)
 #ifdef VMS
        set_vaxc_errno(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
 #else
+#ifdef WIN32
+       SetLastError( SvIV(sv) );
+#else
        /* will anyone ever use this? */
        SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv), 4);
 #endif
+#endif
        break;
     case '\006':       /* ^F */
        maxsysfd = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
@@ -1419,7 +1683,7 @@ magic_set(SV *sv, MAGIC *mg)
            STATUS_POSIX_SET(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv));
        break;
     case '!':
-       SETERRNO(SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv),
+       SETERRNO(SvIOK(sv) ? SvIVX(sv) : SvOK(sv) ? sv_2iv(sv) : 0,
                 (SvIV(sv) == EVMSERR) ? 4 : vaxc$errno);
        break;
     case '<':
@@ -1438,15 +1702,15 @@ magic_set(SV *sv, MAGIC *mg)
       (void)setresuid((Uid_t)uid, (Uid_t)-1, (Uid_t)-1);
 #else
        if (uid == euid)                /* special case $< = $> */
-           (void)setuid(uid);
+           (void)PerlProc_setuid(uid);
        else {
-           uid = (I32)getuid();
+           uid = (I32)PerlProc_getuid();
            croak("setruid() not implemented");
        }
 #endif
 #endif
 #endif
-       uid = (I32)getuid();
+       uid = (I32)PerlProc_getuid();
        tainting |= (uid && (euid != uid || egid != gid));
        break;
     case '>':
@@ -1465,15 +1729,15 @@ magic_set(SV *sv, MAGIC *mg)
        (void)setresuid((Uid_t)-1, (Uid_t)euid, (Uid_t)-1);
 #else
        if (euid == uid)                /* special case $> = $< */
-           setuid(euid);
+           PerlProc_setuid(euid);
        else {
-           euid = (I32)geteuid();
+           euid = (I32)PerlProc_geteuid();
            croak("seteuid() not implemented");
        }
 #endif
 #endif
 #endif
-       euid = (I32)geteuid();
+       euid = (I32)PerlProc_geteuid();
        tainting |= (uid && (euid != uid || egid != gid));
        break;
     case '(':
@@ -1492,15 +1756,15 @@ magic_set(SV *sv, MAGIC *mg)
       (void)setresgid((Gid_t)gid, (Gid_t)-1, (Gid_t) 1);
 #else
        if (gid == egid)                        /* special case $( = $) */
-           (void)setgid(gid);
+           (void)PerlProc_setgid(gid);
        else {
-           gid = (I32)getgid();
+           gid = (I32)PerlProc_getgid();
            croak("setrgid() not implemented");
        }
 #endif
 #endif
 #endif
-       gid = (I32)getgid();
+       gid = (I32)PerlProc_getgid();
        tainting |= (uid && (euid != uid || egid != gid));
        break;
     case ')':
@@ -1542,15 +1806,15 @@ magic_set(SV *sv, MAGIC *mg)
        (void)setresgid((Gid_t)-1, (Gid_t)egid, (Gid_t)-1);
 #else
        if (egid == gid)                        /* special case $) = $( */
-           (void)setgid(egid);
+           (void)PerlProc_setgid(egid);
        else {
-           egid = (I32)getegid();
+           egid = (I32)PerlProc_getegid();
            croak("setegid() not implemented");
        }
 #endif
 #endif
 #endif
-       egid = (I32)getegid();
+       egid = (I32)PerlProc_getegid();
        tainting |= (uid && (euid != uid || egid != gid));
        break;
     case ':':
@@ -1608,6 +1872,11 @@ magic_set(SV *sv, MAGIC *mg)
                origargv[i] = Nullch;
        }
        break;
+#ifdef USE_THREADS
+    case '@':
+       sv_setsv(thr->errsv, sv);
+       break;
+#endif /* USE_THREADS */
     }
     return 0;
 }
@@ -1649,7 +1918,7 @@ whichsig(char *sig)
 
 static SV* sig_sv;
 
-static void
+STATIC void
 unwind_handler_stack(void *p)
 {
     dTHR;
@@ -1665,23 +1934,18 @@ unwind_handler_stack(void *p)
 Signal_t
 sighandler(int sig)
 {
-    dTHR;
     dSP;
-    GV *gv;
+    GV *gv = Nullgv;
     HV *st;
     SV *sv, *tSv = Sv;
-    CV *cv;
-    AV *oldstack;
+    CV *cv = Nullcv;
     OP *myop = op;
     U32 flags = 0;
     I32 o_save_i = savestack_ix, type;
-    CONTEXT *cx;
     XPV *tXpv = Xpv;
     
     if (savestack_ix + 15 <= savestack_max)
        flags |= 1;
-    if (cxstack_ix < cxstack_max - 2)
-       flags |= 2;
     if (markstack_ptr < markstack_max - 2)
        flags |= 4;
     if (retstack_ix < retstack_max - 2)
@@ -1689,12 +1953,6 @@ sighandler(int sig)
     if (scopestack_ix < scopestack_max - 3)
        flags |= 16;
 
-    if (flags & 2) {           /* POPBLOCK may decrease cxstack too early. */
-       cxstack_ix++;           /* Protect from overwrite. */
-       cx = &cxstack[cxstack_ix];
-       type = cx->cx_type;             /* Can be during partial write. */
-       cx->cx_type = CXt_NULL;         /* Make it safe for unwind. */
-    }
     if (!psig_ptr[sig])
        die("Signal SIG%s received, but no signal handler set.\n",
            sig_name[sig]);
@@ -1722,15 +1980,13 @@ sighandler(int sig)
     if (!cv || !CvROOT(cv)) {
        if (dowarn)
            warn("SIG%s handler \"%s\" not defined.\n",
-               sig_name[sig], GvENAME(gv) );
-       return;
+               sig_name[sig], (gv ? GvENAME(gv)
+                               : ((cv && CvGV(cv))
+                                  ? GvENAME(CvGV(cv))
+                                  : "__ANON__")));
+       goto cleanup;
     }
 
-    oldstack = curstack;
-    if (curstack != signalstack)
-       AvFILL(signalstack) = 0;
-    SWITCHSTACK(curstack, signalstack);
-
     if(psig_name[sig]) {
        sv = SvREFCNT_inc(psig_name[sig]);
        flags |= 64;
@@ -1739,19 +1995,18 @@ sighandler(int sig)
        sv = sv_newmortal();
        sv_setpv(sv,sig_name[sig]);
     }
-    PUSHMARK(sp);
+
+    PUSHSTACK(SI_SIGNAL);
+    PUSHMARK(SP);
     PUSHs(sv);
     PUTBACK;
 
     perl_call_sv((SV*)cv, G_DISCARD);
 
-    SWITCHSTACK(signalstack, oldstack);
+    POPSTACK();
+cleanup:
     if (flags & 1)
        savestack_ix -= 8; /* Unprotect save in progress. */
-    if (flags & 2) {
-       cxstack[cxstack_ix].cx_type = type;
-       cxstack_ix -= 1;
-    }
     if (flags & 4) 
        markstack_ptr--;
     if (flags & 8) 
@@ -1766,3 +2021,5 @@ sighandler(int sig)
     Xpv = tXpv;
     return;
 }
+
+