X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mg.c;h=4f5f06f77a7b94d515a33f4b1846fc2d8b7c2f7e;hb=78987dedd25ff29688fc6fdb7b551d69e750279b;hp=8c678f4e815f045f40d3411a94c5cc1e2d1e257b;hpb=bbce6d69784bf43b0e69e8d312042d65f258af23;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/mg.c b/mg.c
index 8c678f4..4f5f06f 100644
--- 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.
@@ -20,18 +20,12 @@
 # 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,11 @@ typedef struct magic_state MGS;
 
 static void restore_magic _((void *p));
 
-static MGS *
-save_magic(sv)
-SV* sv;
+static void
+save_magic(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 +50,12 @@ 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;
+restore_magic(void *p)
 {
-    MGS *mgs = (MGS*)p;
+    MGS* mgs = (MGS*)p;
     SV* sv = mgs->mgs_sv;
 
     if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv))
@@ -80,14 +67,10 @@ void* p;
 	if (SvGMAGICAL(sv))
 	    SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK|SVf_POK);
     }
-
-    Safefree(mgs);
 }
 
-
 void
-mg_magical(sv)
-SV* sv;
+mg_magical(SV *sv)
 {
     MAGIC* mg;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
@@ -104,16 +87,15 @@ SV* sv;
 }
 
 int
-mg_get(sv)
-SV* sv;
+mg_get(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 +103,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))) {
@@ -138,22 +121,21 @@ SV* sv;
 }
 
 int
-mg_set(sv)
-SV* sv;
+mg_set(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);
@@ -164,8 +146,7 @@ SV* sv;
 }
 
 U32
-mg_len(sv)
-SV* sv;
+mg_len(SV *sv)
 {
     MAGIC* mg;
     char *junk;
@@ -174,8 +155,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;
@@ -187,14 +170,45 @@ 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;
 
     ENTER;
-    save_magic(sv);
+    save_magic(&mgs, sv);
 
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
 	MGVTBL* vtbl = mg->mg_virtual;
@@ -209,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) {
@@ -222,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;
@@ -240,8 +248,7 @@ I32 klen;
 }
 
 int
-mg_free(sv)
-SV* sv;
+mg_free(SV *sv)
 {
     MAGIC* mg;
     MAGIC* moremagic;
@@ -268,10 +275,9 @@ SV* sv;
 #endif
 
 U32
-magic_len(sv, mg)
-SV *sv;
-MAGIC *mg;
+magic_len(SV *sv, MAGIC *mg)
 {
+    dTHR;
     register I32 paren;
     register char *s;
     register I32 i;
@@ -289,39 +295,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;
@@ -339,10 +339,9 @@ MAGIC *mg;
 }
 
 int
-magic_get(sv, mg)
-SV *sv;
-MAGIC *mg;
+magic_get(SV *sv, MAGIC *mg)
 {
+    dTHR;
     register I32 paren;
     register char *s;
     register I32 i;
@@ -371,13 +370,32 @@ MAGIC *mg;
 	}
 #else
 #ifdef OS2
-	sv_setnv(sv, (double)Perl_rc);
-	sv_setpv(sv, os2error(Perl_rc));
+	if (!(_emx_env & 0x200)) {	/* Under DOS */
+	    sv_setnv(sv, (double)errno);
+	    sv_setpv(sv, errno ? Strerror(errno) : "");
+	} else {
+	    if (errno != errno_isOS2)
+		Perl_rc = _syserrno();
+	    sv_setnv(sv, (double)Perl_rc);
+	    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 */
@@ -398,6 +416,17 @@ MAGIC *mg;
     case '\020':		/* ^P */
 	sv_setiv(sv, (IV)perldb);
 	break;
+    case '\023':		/* ^S */
+	{
+	    dTHR;
+	    if (lex_state != LEX_NOTPARSING)
+		SvOK_off(sv);
+	    else if (in_eval)
+		sv_setiv(sv, 1);
+	    else
+		sv_setiv(sv, 0);
+	}
+	break;
     case '\024':		/* ^T */
 #ifdef BIG_TIME
  	sv_setnv(sv, basetime);
@@ -411,16 +440,27 @@ 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]) &&
 		(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_MATCH_TAINTED(rx);
 		    break;
 		}
 	    }
@@ -437,23 +477,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 +501,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 +541,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,41 +581,37 @@ 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 '*':
 	break;
     case '0':
 	break;
+#ifdef USE_THREADS
+    case '@':
+	sv_setsv(sv, thr->errsv);
+	break;
+#endif /* USE_THREADS */
     }
     return 0;
 }
 
 int
-magic_getuvar(sv, mg)
-SV *sv;
-MAGIC *mg;
+magic_getuvar(SV *sv, MAGIC *mg)
 {
     struct ufuncs *uf = (struct ufuncs *)mg->mg_ptr;
 
@@ -583,118 +621,160 @@ MAGIC *mg;
 }
 
 int
-magic_setenv(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setenv(SV *sv, 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) && !defined(MSDOS)
 			    /* 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);
+		char tmpbuf[256];
+		struct stat st;
+		s = delimcpy(tmpbuf, tmpbuf + sizeof tmpbuf,
+			     s, strend, ':', &i);
 		s++;
-		if (*tokenbuf != '/'
-		  || (Stat(tokenbuf,&statbuf) && (statbuf.st_mode & 2)) )
+		if (i >= sizeof tmpbuf   /* too long -- assume the worst */
+		      || *tmpbuf != '/'
+		      || (Stat(tmpbuf, &st) == 0 && (st.st_mode & 2)) ) {
 		    MgTAINTEDDIR_on(mg);
+		    return 0;
+		}
 	    }
 	}
     }
+#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),Nullch);
+    my_setenv(MgPV(mg,na),Nullch);
     return 0;
 }
 
-#ifdef HAS_SIGACTION
-/* set up reliable signal() clone */
-
-typedef void (*Sigfunc) _((int));
-
-static
-Sigfunc rsignal(signo,handler)
-int signo;
-Sigfunc handler;
+int
+magic_set_all_env(SV *sv, MAGIC *mg)
 {
-    struct sigaction act,oact;
-    
-    act.sa_handler = handler;
-    sigemptyset(&act.sa_mask);
-    act.sa_flags = 0;
-#ifdef SA_RESTART
-    act.sa_flags |= SA_RESTART;	/* SVR4, 4.3+BSD */
+#if defined(VMS)
+    die("Can't make list assignment to %%ENV on this system");
+#else
+    dTHR;
+    if (localizing) {
+	HE* entry;
+	magic_clear_all_env(sv,mg);
+	hv_iterinit((HV*)sv);
+	while (entry = hv_iternext((HV*)sv)) {
+	    I32 keylen;
+	    my_setenv(hv_iterkey(entry, &keylen),
+		      SvPV(hv_iterval((HV*)sv, entry), na));
+	}
+    }
 #endif
-    if (sigaction(signo, &act, &oact) < 0)
-    	return(SIG_ERR);
-    else
-    	return(oact.sa_handler);
+    return 0;
 }
 
+int
+magic_clear_all_env(SV *sv, MAGIC *mg)
+{
+#if defined(VMS)
+    die("Can't make list assignment to %%ENV on this system");
 #else
+#ifdef WIN32
+    char *envv = GetEnvironmentStrings();
+    char *cur = envv;
+    STRLEN len;
+    while (*cur) {
+	char *end = strchr(cur,'=');
+	if (end && end != cur) {
+	    *end = '\0';
+	    my_setenv(cur,Nullch);
+	    *end = '=';
+	    cur += strlen(end+1)+1;
+	}
+	else if ((len = strlen(cur)))
+	    cur += len+1;
+    }
+    FreeEnvironmentStrings(envv);
+#else
+    I32 i;
 
-/* ah well, so much for reliability */
-
-#define rsignal(x,y) signal(x,y)
+    if (environ == origenviron)
+	New(901, environ, 1, char*);
+    else
+	for (i = 0; environ[i]; i++)
+	    Safefree(environ[i]);
+    environ[0] = Nullch;
 
 #endif
-
-static sig_trapped;
-static
-Signal_t
-sig_trap(signo)
-int signo;
-{
-    sig_trapped++;
+#endif
+    return 0;
 }
+
 int
-magic_getsig(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getsig(SV *sv, 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 {
-    	    void (*origsig) _((int));
-    	    /* get signal state without losing signals */
-    	    sig_trapped=0;
-    	    origsig = rsignal(i,sig_trap);
-    	    rsignal(i,origsig);
-    	    if(sig_trapped)
-    	    	kill(getpid(),i);
+    	    Sighandler_t sigstate = rsignal_state(i);
+
     	    /* cache state so we don't fetch it again */
-    	    if(origsig == SIG_IGN)
+    	    if(sigstate == SIG_IGN)
     	    	sv_setpv(sv,"IGNORE");
     	    else
     	    	sv_setsv(sv,&sv_undef);
@@ -705,13 +785,11 @@ 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? */
-    i = whichsig(MgPV(mg));
+    i = whichsig(MgPV(mg,na));
     if (i) {
     	if(psig_ptr[i]) {
     	    SvREFCNT_dec(psig_ptr[i]);
@@ -726,15 +804,14 @@ MAGIC* mg;
 }
 
 int
-magic_setsig(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setsig(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;
@@ -757,18 +834,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, sighandlerp);
 	else
 	    *svp = SvREFCNT_inc(sv);
 	return 0;
@@ -776,25 +851,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, sighandlerp);
 	else
 	    *svp = SvREFCNT_inc(sv);
     }
@@ -802,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++;
@@ -825,42 +945,53 @@ 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;
-}
+}          
 
 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)
 {
     dSP;
 
-    ENTER;
-    SAVETMPS;
     PUSHMARK(sp);
-    EXTEND(sp, 2);
+    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;
+
+    if (magic_methcall(mg, meth, G_SCALAR, 2, NULL)) {
 	sv_setsv(sv, *stack_sp--);
+    }
 
     FREETMPS;
     LEAVE;
@@ -868,9 +999,7 @@ char *meth;
 }
 
 int
-magic_getpack(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getpack(SV *sv, MAGIC *mg)
 {
     magic_methpack(sv,mg,"FETCH");
     if (mg->mg_ptr)
@@ -879,59 +1008,53 @@ MAGIC* mg;
 }
 
 int
-magic_setpack(sv,mg)
-SV* sv;
-MAGIC* mg;
-{
-    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);
-
+magic_setpack(SV *sv, MAGIC *mg)
+{   
+    ENTER;
+    magic_methcall(mg, "STORE", G_SCALAR|G_DISCARD, 3, sv);
+    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)
+{         
+    dTHR;
+    U32 retval = 0;
+
+    ENTER;
+    SAVETMPS;
+    if (magic_methcall(mg, "FETCHSIZE", G_SCALAR, 2, NULL)) {
+	sv = *stack_sp--;
+	retval = (U32) SvIV(sv)-1;
+    }
+    FREETMPS;
+    LEAVE;
+    return retval;
+}
+
+int magic_wipepack(SV *sv, MAGIC *mg)
 {
     dSP;
 
     PUSHMARK(sp);
     XPUSHs(mg->mg_obj);
     PUTBACK;
-
+    ENTER;
     perl_call_method("CLEAR", G_SCALAR|G_DISCARD);
-
+    LEAVE;
     return 0;
 }
 
 int
-magic_nextpack(sv,mg,key)
-SV* sv;
-MAGIC* mg;
-SV* key;
+magic_nextpack(SV *sv, MAGIC *mg, SV *key)
 {
     dSP;
     char *meth = SvOK(key) ? "NEXTKEY" : "FIRSTKEY";
@@ -954,18 +1077,15 @@ SV* key;
 }
 
 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;
     I32 i;
     GV* gv;
@@ -974,7 +1094,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
@@ -983,33 +1103,30 @@ 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);
     return 0;
 }
 
 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);
     return 0;
 }
 
 int
-magic_getpos(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getpos(SV *sv, MAGIC *mg)
 {
     SV* lsv = LvTARG(sv);
     
     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;
 	}
@@ -1019,9 +1136,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;
@@ -1043,7 +1158,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)
@@ -1052,14 +1167,13 @@ MAGIC* mg;
     else if (pos > len)
 	pos = len;
     mg->mg_len = pos;
+    mg->mg_flags &= ~MGf_MINMATCH;
 
     return 0;
 }
 
 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);
@@ -1072,9 +1186,7 @@ MAGIC* mg;
 }
 
 int
-magic_setglob(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setglob(SV *sv, MAGIC *mg)
 {
     register char *s;
     GV* gv;
@@ -1090,19 +1202,11 @@ 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;
 }
 
 int
-magic_setsubstr(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_setsubstr(SV *sv, MAGIC *mg)
 {
     STRLEN len;
     char *tmps = SvPV(sv,len);
@@ -1111,20 +1215,18 @@ MAGIC* mg;
 }
 
 int
-magic_gettaint(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_gettaint(SV *sv, MAGIC *mg)
 {
+    dTHR;
     TAINT_IF((mg->mg_len & 1) ||
 	     (mg->mg_len & 2) && mg->mg_obj == sv);	/* kludge */
     return 0;
 }
 
 int
-magic_settaint(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_settaint(SV *sv, MAGIC *mg)
 {
+    dTHR;
     if (localizing) {
 	if (localizing == 1)
 	    mg->mg_len <<= 1;
@@ -1139,18 +1241,100 @@ 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_setmglob(sv,mg)
-SV* sv;
-MAGIC* mg;
+magic_getdefelem(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 *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 *sv, MAGIC *mg)
+{
+    SvREFCNT_dec(LvTARG(sv));
+    return 0;
+}
+
+void
+vivify_defelem(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));
+	}
+    }
+    (void)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 *sv, MAGIC *mg)
 {
     mg->mg_len = -1;
     SvSCREAM_off(sv);
@@ -1158,9 +1342,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);
@@ -1168,9 +1350,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);
@@ -1178,9 +1358,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;
 
@@ -1190,23 +1368,34 @@ MAGIC* mg;
 }
 
 int
-magic_setcollxfrm(sv,mg)
-SV* sv;
-MAGIC* mg;
+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)
 {
     /*
      * 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;
+magic_set(SV *sv, MAGIC *mg)
 {
+    dTHR;
     register char *s;
     I32 i;
     STRLEN len;
@@ -1222,7 +1411,12 @@ 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? */
+#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 */
@@ -1248,14 +1442,7 @@ MAGIC* mg;
 	    osname = Nullch;
 	break;
     case '\020':	/* ^P */
-	i = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
-	if (i != perldb) {
-	    if (perldb)
-		oldlastpm = curpm;
-	    else
-		curpm = oldlastpm;
-	}
-	perldb = i;
+	perldb = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
 	break;
     case '\024':	/* ^T */
 #ifdef BIG_TIME
@@ -1297,9 +1484,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 '*':
@@ -1315,7 +1511,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)
@@ -1331,10 +1532,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) : SvOK(sv) ? sv_2iv(sv) : 0,
+		 (SvIV(sv) == EVMSERR) ? 4 : vaxc$errno);
 	break;
     case '<':
 	uid = SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv);
@@ -1418,7 +1632,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 */
@@ -1453,16 +1690,28 @@ MAGIC* mg;
 	    s += strlen(s);
 	    /* See if all the arguments are contiguous in memory */
 	    for (i = 1; i < origargc; i++) {
-		if (origargv[i] == s + 1)
+		if (origargv[i] == s + 1
+#ifdef OS2
+		    || origargv[i] == s + 2
+#endif 
+		   )
 		    s += strlen(++s);	/* this one is ok too */
+		else
+		    break;
 	    }
 	    /* can grab env area too? */
-	    if (origenviron && origenviron[0] == s + 1) {
-		my_setenv("NoNeSuCh", Nullch);
+	    if (origenviron && (origenviron[0] == s + 1
+#ifdef OS2
+				|| (origenviron[0] == s + 9 && (s += 8))
+#endif 
+	       )) {
+		my_setenv("NoNe  SuCh", Nullch);
 					    /* force copy of environment */
 		for (i = 0; origenviron[i]; i++)
 		    if (origenviron[i] == s + 1)
 			s += strlen(++s);
+		    else
+			break;
 	    }
 	    origalen = s - origargv[0];
 	}
@@ -1470,9 +1719,11 @@ MAGIC* mg;
 	i = len;
 	if (i >= origalen) {
 	    i = origalen;
-	    SvCUR_set(sv, i);
-	    *SvEND(sv) = '\0';
+	    /* don't allow system to limit $0 seen by script */
+	    /* SvCUR_set(sv, i); *SvEND(sv) = '\0'; */
 	    Copy(s, origargv[0], i, char);
+	    s = origargv[0]+i;
+	    *s = '\0';
 	}
 	else {
 	    Copy(s, origargv[0], i, char);
@@ -1485,13 +1736,33 @@ MAGIC* mg;
 		origargv[i] = Nullch;
 	}
 	break;
+#ifdef USE_THREADS
+    case '@':
+	sv_setsv(thr->errsv, sv);
+	break;
+#endif /* USE_THREADS */
     }
     return 0;
 }
 
+#ifdef USE_THREADS
+int
+magic_mutexfree(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));
+    SvREFCNT_dec(sv);
+    return 0;
+}
+#endif /* USE_THREADS */
+
 I32
-whichsig(sig)
-char *sig;
+whichsig(char *sig)
 {
     register char **sigv;
 
@@ -1509,39 +1780,99 @@ char *sig;
     return 0;
 }
 
+static SV* sig_sv;
+
+static void
+unwind_handler_stack(void *p)
+{
+    dTHR;
+    U32 flags = *(U32*)p;
+
+    if (flags & 1)
+	savestack_ix -= 5; /* Unprotect save in progress. */
+    /* cxstack_ix-- Not needed, die already unwound it. */
+    if (flags & 64)
+	SvREFCNT_dec(sig_sv);
+}
+
 Signal_t
-sighandler(sig)
-int sig;
+sighandler(int sig)
 {
     dSP;
-    GV *gv;
+    GV *gv = Nullgv;
     HV *st;
-    SV *sv;
-    CV *cv;
+    SV *sv, *tSv = Sv;
+    CV *cv = Nullcv;
     AV *oldstack;
+    OP *myop = op;
+    U32 flags = 0;
+    I32 o_save_i = savestack_ix, type;
+    PERL_CONTEXT *cx;
+    XPV *tXpv = Xpv;
     
-    if(!psig_ptr[sig])
-    	die("Signal SIG%s received, but no signal handler set.\n",
-    	sig_name[sig]);
+    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)
+	flags |= 8;
+    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]);
+
+    /* Max number of items pushed there is 3*n or 4. We cannot fix
+       infinity, so we fix 4 (in fact 5): */
+    if (flags & 1) {
+	savestack_ix += 5;		/* Protect save in progress. */
+	o_save_i = savestack_ix;
+	SAVEDESTRUCTOR(unwind_handler_stack, (void*)&flags);
+    }
+    if (flags & 4) 
+	markstack_ptr++;		/* Protect mark. */
+    if (flags & 8) {
+	retstack_ix++;
+	retstack[retstack_ix] = NULL;
+    }
+    if (flags & 16)
+	scopestack_ix += 1;
+    /* sv_2cv is too complicated, try a simpler variant first: */
+    if (!SvROK(psig_ptr[sig]) || !(cv = (CV*)SvRV(psig_ptr[sig])) 
+	|| SvTYPE(cv) != SVt_PVCV)
+	cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE);
 
-    cv = sv_2cv(psig_ptr[sig],&st,&gv,TRUE);
     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;
+	AvFILLp(signalstack) = 0;
     SWITCHSTACK(curstack, signalstack);
 
-    if(psig_name[sig])
+    if(psig_name[sig]) {
     	sv = SvREFCNT_inc(psig_name[sig]);
-    else {
-        sv = sv_newmortal();
-        sv_setpv(sv,sig_name[sig]);
+	flags |= 64;
+	sig_sv = sv;
+    } else {
+	sv = sv_newmortal();
+	sv_setpv(sv,sig_name[sig]);
     }
     PUSHMARK(sp);
     PUSHs(sv);
@@ -1550,6 +1881,26 @@ int sig;
     perl_call_sv((SV*)cv, G_DISCARD);
 
     SWITCHSTACK(signalstack, oldstack);
-
+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) 
+	retstack_ix--;
+    if (flags & 16)
+	scopestack_ix -= 1;
+    if (flags & 64)
+	SvREFCNT_dec(sv);
+    op = myop;			/* Apparently not needed... */
+    
+    Sv = tSv;			/* Restore global temporaries. */
+    Xpv = tXpv;
     return;
 }
+
+