X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=492e35191d1065f7bf7bd2d4af4025f83b38540a;hb=43051805d53a3e4c5b2185a17655cab5bedc17ed;hp=47e05a1176b1d6273f9051b7b4d6b3beb2962f65;hpb=a863c7d16499251f020c5d26d232aa865fa0b197;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/mg.c b/mg.c
index 47e05a1..492e351 100644
--- a/mg.c
+++ b/mg.c
@@ -39,9 +39,7 @@ typedef struct magic_state MGS;
 static void restore_magic _((void *p));
 
 static void
-save_magic(mgs, sv)
-MGS* mgs;
-SV* sv;
+save_magic(MGS *mgs, SV *sv)
 {
     assert(SvMAGICAL(sv));
 
@@ -55,8 +53,7 @@ SV* sv;
 }
 
 static void
-restore_magic(p)
-void* p;
+restore_magic(void *p)
 {
     MGS* mgs = (MGS*)p;
     SV* sv = mgs->mgs_sv;
@@ -72,10 +69,8 @@ void* p;
     }
 }
 
-
 void
-mg_magical(sv)
-SV* sv;
+mg_magical(SV *sv)
 {
     MAGIC* mg;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
@@ -92,8 +87,7 @@ SV* sv;
 }
 
 int
-mg_get(sv)
-SV* sv;
+mg_get(SV *sv)
 {
     MGS mgs;
     MAGIC* mg;
@@ -127,8 +121,7 @@ SV* sv;
 }
 
 int
-mg_set(sv)
-SV* sv;
+mg_set(SV *sv)
 {
     MGS mgs;
     MAGIC* mg;
@@ -153,8 +146,7 @@ SV* sv;
 }
 
 U32
-mg_len(sv)
-SV* sv;
+mg_len(SV *sv)
 {
     MAGIC* mg;
     char *junk;
@@ -178,9 +170,39 @@ 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) {
+	    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* sv;
+mg_clear(SV *sv)
 {
     MGS mgs;
     MAGIC* mg;
@@ -201,9 +223,7 @@ SV* sv;
 }
 
 MAGIC*
-mg_find(sv, type)
-SV* sv;
-int type;
+mg_find(SV *sv, int type)
 {
     MAGIC* mg;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
@@ -214,11 +234,7 @@ int type;
 }
 
 int
-mg_copy(sv, nsv, key, klen)
-SV* sv;
-SV* nsv;
-char *key;
-I32 klen;
+mg_copy(SV *sv, SV *nsv, char *key, I32 klen)
 {
     int count = 0;
     MAGIC* mg;
@@ -232,8 +248,7 @@ I32 klen;
 }
 
 int
-mg_free(sv)
-SV* sv;
+mg_free(SV *sv)
 {
     MAGIC* mg;
     MAGIC* moremagic;
@@ -260,9 +275,7 @@ SV* sv;
 #endif
 
 U32
-magic_len(sv, mg)
-SV *sv;
-MAGIC *mg;
+magic_len(SV *sv, MAGIC *mg)
 {
     dTHR;
     register I32 paren;
@@ -326,9 +339,7 @@ MAGIC *mg;
 }
 
 int
-magic_get(sv, mg)
-SV *sv;
-MAGIC *mg;
+magic_get(SV *sv, MAGIC *mg)
 {
     dTHR;
     register I32 paren;
@@ -369,10 +380,22 @@ MAGIC *mg;
 	    sv_setpv(sv, os2error(Perl_rc));
 	}
 #else
+#ifdef WIN32
+	{
+	    DWORD dwErr = GetLastError();
+	    sv_setnv(sv, (double)dwErr);
+	    if (dwErr)
+		win32_str_os_error(sv, dwErr);
+	    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 */
@@ -437,7 +460,7 @@ MAGIC *mg;
 		    }
 		    sv_setpvn(sv,s,i);
 		    if (tainting)
-			tainted = was_tainted || rx->exec_tainted;
+			tainted = was_tainted || RX_MATCH_TAINTED(rx);
 		    break;
 		}
 	    }
@@ -580,7 +603,7 @@ MAGIC *mg;
 	break;
 #ifdef USE_THREADS
     case '@':
-	sv_setsv(sv, errsv);
+	sv_setsv(sv, thr->errsv);
 	break;
 #endif /* USE_THREADS */
     }
@@ -588,9 +611,7 @@ MAGIC *mg;
 }
 
 int
-magic_getuvar(sv, mg)
-SV *sv;
-MAGIC *mg;
+magic_getuvar(SV *sv, MAGIC *mg)
 {
     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
 
@@ -600,9 +621,7 @@ MAGIC *mg;
 }
 
 int
-magic_setenv(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setenv(SV *sv, MAGIC *mg)
 {
     register char *s;
     char *ptr;
@@ -623,7 +642,7 @@ 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) {
@@ -665,31 +684,27 @@ 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;
 }
 
 int
-magic_clearenv(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_clearenv(SV *sv, MAGIC *mg)
 {
     my_setenv(MgPV(mg,na),Nullch);
     return 0;
 }
 
 int
-magic_set_all_env(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_set_all_env(SV *sv, MAGIC *mg)
 {
 #if defined(VMS)
     die("Can't make list assignment to %%ENV on this system");
@@ -710,9 +725,7 @@ MAGIC* mg;
 }
 
 int
-magic_clear_all_env(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_clear_all_env(SV *sv, MAGIC *mg)
 {
 #if defined(VMS)
     die("Can't make list assignment to %%ENV on this system");
@@ -749,9 +762,7 @@ MAGIC* mg;
 }
 
 int
-magic_getsig(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getsig(SV *sv, MAGIC *mg)
 {
     I32 i;
     /* Are we fetching a signal entry? */
@@ -774,9 +785,7 @@ MAGIC* mg;
     return 0;
 }
 int
-magic_clearsig(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_clearsig(SV *sv, MAGIC *mg)
 {
     I32 i;
     /* Are we clearing a signal entry? */
@@ -795,9 +804,7 @@ MAGIC* mg;
 }
 
 int
-magic_setsig(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setsig(SV *sv, MAGIC *mg)
 {
     dTHR;
     register char *s;
@@ -871,20 +878,64 @@ MAGIC* mg;
 }
 
 int
-magic_setisa(sv,mg)
-SV* sv;
-MAGIC* mg;
+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;
 }
 
 #ifdef OVERLOAD
 
 int
-magic_setamagic(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setamagic(SV *sv, MAGIC *mg)
 {
     /* HV_badAMAGIC_on(Sv_STASH(sv)); */
     amagic_generation++;
@@ -894,53 +945,64 @@ MAGIC* mg;
 #endif /* OVERLOAD */
 
 int
-magic_setnkeys(sv,mg)
-SV* sv;
-MAGIC* mg;
+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_methpack(sv,mg,meth)
-SV* sv;
-MAGIC* mg;
-char *meth;
+magic_methcall(MAGIC *mg, char *meth, I32 flags, int n, SV *val)
 {
-    dTHR;
     dSP;
 
-    ENTER;
-    SAVETMPS;
-    PUSHMARK(sp);
-    EXTEND(sp, 2);
+    PUSHMARK(SP);
+    EXTEND(SP, n);
     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);
+    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);
     }
-    else if (mg->mg_type == 'p')
-	PUSHs(sv_2mortal(newSViv(mg->mg_len)));
     PUTBACK;
 
-    if (perl_call_method(meth, G_SCALAR))
+    return perl_call_method(meth, flags);
+}
+
+static int
+magic_methpack(SV *sv, MAGIC *mg, char *meth)
+{
+    dSP;
+
+    ENTER;
+    SAVETMPS;
+    PUSHSTACK(SI_MAGIC);
+
+    if (magic_methcall(mg, meth, G_SCALAR, 2, NULL)) {
 	sv_setsv(sv, *stack_sp--);
+    }
 
+    POPSTACK();
     FREETMPS;
     LEAVE;
     return 0;
 }
 
 int
-magic_getpack(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getpack(SV *sv, MAGIC *mg)
 {
     magic_methpack(sv,mg,"FETCH");
     if (mg->mg_ptr)
@@ -949,70 +1011,69 @@ MAGIC* mg;
 }
 
 int
-magic_setpack(sv,mg)
-SV* sv;
-MAGIC* mg;
+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;
 }
 
 int
-magic_clearpack(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_clearpack(SV *sv, MAGIC *mg)
 {
     return magic_methpack(sv,mg,"DELETE");
 }
 
-int magic_wipepack(sv,mg)
-SV* sv;
-MAGIC* mg;
+
+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,mg,key)
-SV* sv;
-MAGIC* mg;
-SV* key;
+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);
@@ -1021,23 +1082,20 @@ SV* key;
     if (perl_call_method(meth, G_SCALAR))
 	sv_setsv(key, *stack_sp--);
 
+    POPSTACK();
     FREETMPS;
     LEAVE;
     return 0;
 }
 
 int
-magic_existspack(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_existspack(SV *sv, MAGIC *mg)
 {
     return magic_methpack(sv,mg,"EXISTS");
 } 
 
 int
-magic_setdbline(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setdbline(SV *sv, MAGIC *mg)
 {
     dTHR;
     OP *o;
@@ -1057,9 +1115,7 @@ MAGIC* mg;
 }
 
 int
-magic_getarylen(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getarylen(SV *sv, MAGIC *mg)
 {
     dTHR;
     sv_setiv(sv, AvFILL((AV*)mg->mg_obj) + curcop->cop_arybase);
@@ -1067,9 +1123,7 @@ MAGIC* mg;
 }
 
 int
-magic_setarylen(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setarylen(SV *sv, MAGIC *mg)
 {
     dTHR;
     av_fill((AV*)mg->mg_obj, SvIV(sv) - curcop->cop_arybase);
@@ -1077,9 +1131,7 @@ MAGIC* mg;
 }
 
 int
-magic_getpos(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getpos(SV *sv, MAGIC *mg)
 {
     SV* lsv = LvTARG(sv);
     
@@ -1096,9 +1148,7 @@ MAGIC* mg;
 }
 
 int
-magic_setpos(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setpos(SV *sv, MAGIC *mg)
 {
     SV* lsv = LvTARG(sv);
     SSize_t pos;
@@ -1135,9 +1185,7 @@ MAGIC* mg;
 }
 
 int
-magic_getglob(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getglob(SV *sv, MAGIC *mg)
 {
     if (SvFAKE(sv)) {			/* FAKE globs can get coerced */
 	SvFAKE_off(sv);
@@ -1150,9 +1198,7 @@ MAGIC* mg;
 }
 
 int
-magic_setglob(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setglob(SV *sv, MAGIC *mg)
 {
     register char *s;
     GV* gv;
@@ -1172,9 +1218,7 @@ MAGIC* mg;
 }
 
 int
-magic_setsubstr(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setsubstr(SV *sv, MAGIC *mg)
 {
     STRLEN len;
     char *tmps = SvPV(sv,len);
@@ -1183,9 +1227,7 @@ MAGIC* mg;
 }
 
 int
-magic_gettaint(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_gettaint(SV *sv, MAGIC *mg)
 {
     dTHR;
     TAINT_IF((mg->mg_len & 1) ||
@@ -1194,9 +1236,7 @@ MAGIC* mg;
 }
 
 int
-magic_settaint(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_settaint(SV *sv, MAGIC *mg)
 {
     dTHR;
     if (localizing) {
@@ -1213,18 +1253,14 @@ MAGIC* mg;
 }
 
 int
-magic_setvec(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setvec(SV *sv, MAGIC *mg)
 {
     do_vecset(sv);	/* XXX slurp this routine */
     return 0;
 }
 
 int
-magic_getdefelem(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getdefelem(SV *sv, MAGIC *mg)
 {
     SV *targ = Nullsv;
     if (LvTARGLEN(sv)) {
@@ -1235,7 +1271,7 @@ MAGIC* mg;
 		targ = HeVAL(he);
 	}
 	else {
-	    AV* av = (AV*)LvTARG(sv);
+	    AV* av = (AV*)LvTARG(sv); 
 	    if ((I32)LvTARGOFF(sv) <= AvFILL(av))
 		targ = AvARRAY(av)[LvTARGOFF(sv)];
 	}
@@ -1257,9 +1293,7 @@ MAGIC* mg;
 }
 
 int
-magic_setdefelem(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setdefelem(SV *sv, MAGIC *mg)
 {
     if (LvTARGLEN(sv))
 	vivify_defelem(sv);
@@ -1271,17 +1305,14 @@ MAGIC* mg;
 }
 
 int
-magic_freedefelem(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_freedefelem(SV *sv, MAGIC *mg)
 {
     SvREFCNT_dec(LvTARG(sv));
     return 0;
 }
 
 void
-vivify_defelem(sv)
-SV* sv;
+vivify_defelem(SV *sv)
 {
     dTHR;			/* just for SvREFCNT_inc and SvREFCNT_dec*/
     MAGIC* mg;
@@ -1315,9 +1346,7 @@ SV* sv;
 }
 
 int
-magic_setmglob(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setmglob(SV *sv, MAGIC *mg)
 {
     mg->mg_len = -1;
     SvSCREAM_off(sv);
@@ -1325,9 +1354,7 @@ MAGIC* mg;
 }
 
 int
-magic_setbm(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setbm(SV *sv, MAGIC *mg)
 {
     sv_unmagic(sv, 'B');
     SvVALID_off(sv);
@@ -1335,9 +1362,7 @@ MAGIC* mg;
 }
 
 int
-magic_setfm(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setfm(SV *sv, MAGIC *mg)
 {
     sv_unmagic(sv, 'f');
     SvCOMPILED_off(sv);
@@ -1345,9 +1370,7 @@ MAGIC* mg;
 }
 
 int
-magic_setuvar(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setuvar(SV *sv, MAGIC *mg)
 {
     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
 
@@ -1356,11 +1379,17 @@ 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,mg)
-SV* sv;
-MAGIC* mg;
+magic_setcollxfrm(SV *sv, MAGIC *mg)
 {
     /*
      * René Descartes said "I think not."
@@ -1376,9 +1405,7 @@ MAGIC* mg;
 #endif /* USE_LOCALE_COLLATE */
 
 int
-magic_set(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_set(SV *sv, MAGIC *mg)
 {
     dTHR;
     register char *s;
@@ -1396,9 +1423,13 @@ 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);
@@ -1528,7 +1559,7 @@ 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 '<':
@@ -1719,7 +1750,7 @@ MAGIC* mg;
 	break;
 #ifdef USE_THREADS
     case '@':
-	sv_setsv(errsv, sv);
+	sv_setsv(thr->errsv, sv);
 	break;
 #endif /* USE_THREADS */
     }
@@ -1728,9 +1759,7 @@ MAGIC* mg;
 
 #ifdef USE_THREADS
 int
-magic_mutexfree(sv, mg)
-SV *sv;
-MAGIC *mg;
+magic_mutexfree(SV *sv, MAGIC *mg)
 {
     dTHR;
     DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: magic_mutexfree 0x%lx\n",
@@ -1745,8 +1774,7 @@ MAGIC *mg;
 #endif /* USE_THREADS */
 
 I32
-whichsig(sig)
-char *sig;
+whichsig(char *sig)
 {
     register char **sigv;
 
@@ -1767,8 +1795,7 @@ char *sig;
 static SV* sig_sv;
 
 static void
-unwind_handler_stack(p)
-    void *p;
+unwind_handler_stack(void *p)
 {
     dTHR;
     U32 flags = *(U32*)p;
@@ -1781,26 +1808,20 @@ unwind_handler_stack(p)
 }
 
 Signal_t
-sighandler(sig)
-int sig;
+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)
@@ -1808,12 +1829,6 @@ 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]);
@@ -1841,15 +1856,13 @@ 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;
@@ -1858,19 +1871,18 @@ 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) 
@@ -1885,3 +1897,5 @@ int sig;
     Xpv = tXpv;
     return;
 }
+
+