X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/a1bd196e40598e773ccd679fc8778a94de7814af..abff13bb6f4392604279f83cbed17a9d16ae2d8f:/pp.c

diff --git a/pp.c b/pp.c
index ccde9b0..23510eb 100644
--- a/pp.c
+++ b/pp.c
@@ -13,6 +13,7 @@
  */
 
 #include "EXTERN.h"
+#define PERL_IN_PP_C
 #include "perl.h"
 
 /*
@@ -27,37 +28,6 @@ static double UV_MAX_cxux = ((double)UV_MAX);
 #endif
 
 /*
- * Types used in bitwise operations.
- *
- * Normally we'd just use IV and UV.  However, some hardware and
- * software combinations (e.g. Alpha and current OSF/1) don't have a
- * floating-point type to use for NV that has adequate bits to fully
- * hold an IV/UV.  (In other words, sizeof(long) == sizeof(double).)
- *
- * It just so happens that "int" is the right size almost everywhere.
- */
-typedef int IBW;
-typedef unsigned UBW;
-
-/*
- * Mask used after bitwise operations.
- *
- * There is at least one realm (Cray word machines) that doesn't
- * have an integral type (except char) small enough to be represented
- * in a double without loss; that is, it has no 32-bit type.
- */
-#if LONGSIZE > 4  && defined(_CRAY) && !defined(_CRAYMPP)
-#  define BW_BITS  32
-#  define BW_MASK  ((1 << BW_BITS) - 1)
-#  define BW_SIGN  (1 << (BW_BITS - 1))
-#  define BWi(i)  (((i) & BW_SIGN) ? ((i) | ~BW_MASK) : ((i) & BW_MASK))
-#  define BWu(u)  ((u) & BW_MASK)
-#else
-#  define BWi(i)  (i)
-#  define BWu(u)  (u)
-#endif
-
-/*
  * Offset for integer pack/unpack.
  *
  * On architectures where I16 and I32 aren't really 16 and 32 bits,
@@ -110,12 +80,6 @@ typedef unsigned UBW;
 #  define CAT32(sv,p)  sv_catpvn(sv, (char*)(p), SIZE32)
 #endif
 
-#ifndef PERL_OBJECT
-static void doencodes _((SV* sv, char* s, I32 len));
-static SV* refto _((SV* sv));
-static U32 seed _((void));
-#endif
-
 /* variations on pp_null */
 
 #ifdef I_UNISTD
@@ -191,12 +155,12 @@ PP(pp_padhv)
 	RETURN;
     gimme = GIMME_V;
     if (gimme == G_ARRAY) {
-	RETURNOP(do_kv(ARGS));
+	RETURNOP(do_kv());
     }
     else if (gimme == G_SCALAR) {
 	SV* sv = sv_newmortal();
 	if (HvFILL((HV*)TARG))
-	    sv_setpvf(sv, "%ld/%ld",
+	    Perl_sv_setpvf(aTHX_ sv, "%ld/%ld",
 		      (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG) + 1);
 	else
 	    sv_setiv(sv, 0);
@@ -207,7 +171,7 @@ PP(pp_padhv)
 
 PP(pp_padany)
 {
-    DIE("NOT IMPL LINE %d",__LINE__);
+    DIE(aTHX_ "NOT IMPL LINE %d",__LINE__);
 }
 
 /* Translations. */
@@ -229,7 +193,7 @@ PP(pp_rv2gv)
 	    sv = (SV*) gv;
 	}
 	else if (SvTYPE(sv) != SVt_PVGV)
-	    DIE("Not a GLOB reference");
+	    DIE(aTHX_ "Not a GLOB reference");
     }
     else {
 	if (SvTYPE(sv) != SVt_PVGV) {
@@ -262,9 +226,9 @@ PP(pp_rv2gv)
 		}  
 		if (PL_op->op_flags & OPf_REF ||
 		    PL_op->op_private & HINT_STRICT_REFS)
-		    DIE(PL_no_usym, "a symbol");
+		    DIE(aTHX_ PL_no_usym, "a symbol");
 		if (ckWARN(WARN_UNINITIALIZED))
-		    warner(WARN_UNINITIALIZED, PL_warn_uninit);
+		    Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
 		RETSETUNDEF;
 	    }
 	    sym = SvPV(sv, n_a);
@@ -277,7 +241,7 @@ PP(pp_rv2gv)
 	    }
 	    else {
 		if (PL_op->op_private & HINT_STRICT_REFS)
-		    DIE(PL_no_symref, sym, "a symbol");
+		    DIE(aTHX_ PL_no_symref, sym, "a symbol");
 		sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
 	    }
 	}
@@ -301,7 +265,7 @@ PP(pp_rv2sv)
 	case SVt_PVAV:
 	case SVt_PVHV:
 	case SVt_PVCV:
-	    DIE("Not a SCALAR reference");
+	    DIE(aTHX_ "Not a SCALAR reference");
 	}
     }
     else {
@@ -318,9 +282,9 @@ PP(pp_rv2sv)
 	    if (!SvOK(sv)) {
 		if (PL_op->op_flags & OPf_REF ||
 		    PL_op->op_private & HINT_STRICT_REFS)
-		    DIE(PL_no_usym, "a SCALAR");
+		    DIE(aTHX_ PL_no_usym, "a SCALAR");
 		if (ckWARN(WARN_UNINITIALIZED))
-		    warner(WARN_UNINITIALIZED, PL_warn_uninit);
+		    Perl_warner(aTHX_ WARN_UNINITIALIZED, PL_warn_uninit);
 		RETSETUNDEF;
 	    }
 	    sym = SvPV(sv, n_a);
@@ -333,7 +297,7 @@ PP(pp_rv2sv)
 	    }
 	    else {
 		if (PL_op->op_private & HINT_STRICT_REFS)
-		    DIE(PL_no_symref, sym, "a SCALAR");
+		    DIE(aTHX_ PL_no_symref, sym, "a SCALAR");
 		gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
 	    }
 	}
@@ -411,6 +375,8 @@ PP(pp_rv2cv)
     if (cv) {
 	if (CvCLONE(cv))
 	    cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
+	if ((PL_op->op_private & OPpLVAL_INTRO) && !CvLVALUE(cv))
+	    Perl_croak(aTHX_ "Can't modify non-lvalue subroutine call");
     }
     else
 	cv = (CV*)&PL_sv_undef;
@@ -472,7 +438,7 @@ PP(pp_prototype)
 		goto set;
 	    else {			/* None such */
 	      nonesuch:
-		croak("Cannot find an opnumber for \"%s\"", s+6);
+		Perl_croak(aTHX_ "Can't find an opnumber for \"%s\"", s+6);
 	    }
 	}
     }
@@ -521,7 +487,7 @@ PP(pp_refgen)
 }
 
 STATIC SV*
-refto(SV *sv)
+S_refto(pTHX_ SV *sv)
 {
     SV* rv;
 
@@ -531,7 +497,7 @@ refto(SV *sv)
 	if (!(sv = LvTARG(sv)))
 	    sv = &PL_sv_undef;
 	else
-	    SvREFCNT_inc(sv);
+	    (void)SvREFCNT_inc(sv);
     }
     else if (SvPADTMP(sv))
 	sv = newSVsv(sv);
@@ -578,7 +544,7 @@ PP(pp_bless)
 	STRLEN len;
 	char *ptr = SvPV(ssv,len);
 	if (ckWARN(WARN_UNSAFE) && len == 0)
-	    warner(WARN_UNSAFE, 
+	    Perl_warner(aTHX_ WARN_UNSAFE, 
 		   "Explicit blessing to '' (assuming package main)");
 	stash = gv_stashpvn(ptr, len, TRUE);
     }
@@ -694,7 +660,7 @@ PP(pp_study)
     snext = PL_screamnext;
 
     if (!sfirst || !snext)
-	DIE("do_study: out of memory");
+	DIE(aTHX_ "do_study: out of memory");
 
     for (ch = 256; ch; --ch)
 	*sfirst++ = -1;
@@ -825,7 +791,7 @@ PP(pp_undef)
 	break;
     case SVt_PVCV:
 	if (ckWARN(WARN_UNSAFE) && cv_const_sv((CV*)sv))
-	    warner(WARN_UNSAFE, "Constant subroutine %s undefined",
+	    Perl_warner(aTHX_ WARN_UNSAFE, "Constant subroutine %s undefined",
 		 CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
 	/* FALL THROUGH */
     case SVt_PVFM:
@@ -868,8 +834,8 @@ PP(pp_predec)
 {
     djSP;
     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
-	croak(PL_no_modify);
-    if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+	Perl_croak(aTHX_ PL_no_modify);
+    if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
     	SvIVX(TOPs) != IV_MIN)
     {
 	--SvIVX(TOPs);
@@ -885,9 +851,9 @@ PP(pp_postinc)
 {
     djSP; dTARGET;
     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
-	croak(PL_no_modify);
+	Perl_croak(aTHX_ PL_no_modify);
     sv_setsv(TARG, TOPs);
-    if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+    if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
     	SvIVX(TOPs) != IV_MAX)
     {
 	++SvIVX(TOPs);
@@ -905,10 +871,10 @@ PP(pp_postinc)
 PP(pp_postdec)
 {
     djSP; dTARGET;
-    if(SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
-	croak(PL_no_modify);
+    if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
+	Perl_croak(aTHX_ PL_no_modify);
     sv_setsv(TARG, TOPs);
-    if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
+    if (SvIOK_notUV(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
     	SvIVX(TOPs) != IV_MIN)
     {
 	--SvIVX(TOPs);
@@ -948,15 +914,15 @@ PP(pp_divide)
     djSP; dATARGET; tryAMAGICbin(div,opASSIGN);
     {
       dPOPPOPnnrl;
-      double value;
+      NV value;
       if (right == 0.0)
-	DIE("Illegal division by zero");
+	DIE(aTHX_ "Illegal division by zero");
 #ifdef SLOPPYDIVIDE
       /* insure that 20./5. == 4. */
       {
 	IV k;
-	if ((double)I_V(left)  == left &&
-	    (double)I_V(right) == right &&
+	if ((NV)I_V(left)  == left &&
+	    (NV)I_V(right) == right &&
 	    (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) {
 	    value = k;
 	}
@@ -981,8 +947,8 @@ PP(pp_modulo)
 	bool left_neg;
 	bool right_neg;
 	bool use_double = 0;
-	double dright;
-	double dleft;
+	NV dright;
+	NV dleft;
 
 	if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
 	    IV i = SvIVX(POPs);
@@ -1012,7 +978,7 @@ PP(pp_modulo)
 	}
 
 	if (use_double) {
-	    double dans;
+	    NV dans;
 
 #if 1
 /* Somehow U_V is pessimized even if CASTFLAGS is 0 */
@@ -1037,9 +1003,9 @@ PP(pp_modulo)
 	    dleft  = floor(dleft + 0.5);
 
 	    if (!dright)
-		DIE("Illegal modulus zero");
+		DIE(aTHX_ "Illegal modulus zero");
 
-	    dans = fmod(dleft, dright);
+	    dans = Perl_fmod(dleft, dright);
 	    if ((left_neg != right_neg) && dans)
 		dans = dright - dans;
 	    if (right_neg)
@@ -1051,7 +1017,7 @@ PP(pp_modulo)
 
 	do_uv:
 	    if (!right)
-		DIE("Illegal modulus zero");
+		DIE(aTHX_ "Illegal modulus zero");
 
 	    ans = left % right;
 	    if ((left_neg != right_neg) && ans)
@@ -1062,7 +1028,7 @@ PP(pp_modulo)
 		if (ans <= ~((UV)IV_MAX)+1)
 		    sv_setiv(TARG, ~ans+1);
 		else
-		    sv_setnv(TARG, -(double)ans);
+		    sv_setnv(TARG, -(NV)ans);
 	    }
 	    else
 		sv_setuv(TARG, ans);
@@ -1136,17 +1102,11 @@ PP(pp_left_shift)
 {
     djSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
     {
-      IBW shift = POPi;
-      if (PL_op->op_private & HINT_INTEGER) {
-	IBW i = TOPi;
-	i = BWi(i) << shift;
-	SETi(BWi(i));
-      }
-      else {
-	UBW u = TOPu;
-	u <<= shift;
-	SETu(BWu(u));
-      }
+      IV shift = POPi;
+      if (PL_op->op_private & HINT_INTEGER)
+	SETi(TOPi << shift);
+      else
+	SETu(TOPu << shift);
       RETURN;
     }
 }
@@ -1155,17 +1115,11 @@ PP(pp_right_shift)
 {
     djSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
     {
-      IBW shift = POPi;
-      if (PL_op->op_private & HINT_INTEGER) {
-	IBW i = TOPi;
-	i = BWi(i) >> shift;
-	SETi(BWi(i));
-      }
-      else {
-	UBW u = TOPu;
-	u >>= shift;
-	SETu(BWu(u));
-      }
+      IV shift = POPi;
+      if (PL_op->op_private & HINT_INTEGER)
+	SETi(TOPi >> shift);
+      else
+	SETu(TOPu >> shift);
       RETURN;
     }
 }
@@ -1333,14 +1287,10 @@ PP(pp_bit_and)
     {
       dPOPTOPssrl;
       if (SvNIOKp(left) || SvNIOKp(right)) {
-	if (PL_op->op_private & HINT_INTEGER) {
-	  IBW value = SvIV(left) & SvIV(right);
-	  SETi(BWi(value));
-	}
-	else {
-	  UBW value = SvUV(left) & SvUV(right);
-	  SETu(BWu(value));
-	}
+	if (PL_op->op_private & HINT_INTEGER)
+	  SETi( SvIV(left) & SvIV(right) );
+	else
+	  SETu( SvUV(left) & SvUV(right) );
       }
       else {
 	do_vop(PL_op->op_type, TARG, left, right);
@@ -1356,14 +1306,10 @@ PP(pp_bit_xor)
     {
       dPOPTOPssrl;
       if (SvNIOKp(left) || SvNIOKp(right)) {
-	if (PL_op->op_private & HINT_INTEGER) {
-	  IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
-	  SETi(BWi(value));
-	}
-	else {
-	  UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
-	  SETu(BWu(value));
-	}
+	if (PL_op->op_private & HINT_INTEGER)
+	  SETi( (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right) );
+	else
+	  SETu( (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right) );
       }
       else {
 	do_vop(PL_op->op_type, TARG, left, right);
@@ -1379,14 +1325,10 @@ PP(pp_bit_or)
     {
       dPOPTOPssrl;
       if (SvNIOKp(left) || SvNIOKp(right)) {
-	if (PL_op->op_private & HINT_INTEGER) {
-	  IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
-	  SETi(BWi(value));
-	}
-	else {
-	  UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
-	  SETu(BWu(value));
-	}
+	if (PL_op->op_private & HINT_INTEGER)
+	  SETi( (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right) );
+	else
+	  SETu( (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right) );
       }
       else {
 	do_vop(PL_op->op_type, TARG, left, right);
@@ -1445,14 +1387,10 @@ PP(pp_complement)
     {
       dTOPss;
       if (SvNIOKp(sv)) {
-	if (PL_op->op_private & HINT_INTEGER) {
-	  IBW value = ~SvIV(sv);
-	  SETi(BWi(value));
-	}
-	else {
-	  UBW value = ~SvUV(sv);
-	  SETu(BWu(value));
-	}
+	if (PL_op->op_private & HINT_INTEGER)
+	  SETi( ~SvIV(sv) );
+	else
+	  SETu( ~SvUV(sv) );
       }
       else {
 	register char *tmps;
@@ -1498,7 +1436,7 @@ PP(pp_i_divide)
     {
       dPOPiv;
       if (value == 0)
-	DIE("Illegal division by zero");
+	DIE(aTHX_ "Illegal division by zero");
       value = POPi / value;
       PUSHi( value );
       RETURN;
@@ -1511,7 +1449,7 @@ PP(pp_i_modulo)
     {
       dPOPTOPiirl;
       if (!right)
-	DIE("Illegal modulus zero");
+	DIE(aTHX_ "Illegal modulus zero");
       SETi( left % right );
       RETURN;
     }
@@ -1629,7 +1567,7 @@ PP(pp_atan2)
     djSP; dTARGET; tryAMAGICbin(atan2,0);
     {
       dPOPTOPnnrl;
-      SETn(atan2(left, right));
+      SETn(Perl_atan2(left, right));
       RETURN;
     }
 }
@@ -1638,9 +1576,9 @@ PP(pp_sin)
 {
     djSP; dTARGET; tryAMAGICun(sin);
     {
-      double value;
+      NV value;
       value = POPn;
-      value = sin(value);
+      value = Perl_sin(value);
       XPUSHn(value);
       RETURN;
     }
@@ -1650,9 +1588,9 @@ PP(pp_cos)
 {
     djSP; dTARGET; tryAMAGICun(cos);
     {
-      double value;
+      NV value;
       value = POPn;
-      value = cos(value);
+      value = Perl_cos(value);
       XPUSHn(value);
       RETURN;
     }
@@ -1670,13 +1608,13 @@ PP(pp_cos)
  */
 
 #ifndef HAS_DRAND48_PROTO
-extern double drand48 _((void));
+extern double drand48 (void);
 #endif
 
 PP(pp_rand)
 {
     djSP; dTARGET;
-    double value;
+    NV value;
     if (MAXARG < 1)
 	value = 1.0;
     else
@@ -1707,7 +1645,7 @@ PP(pp_srand)
 }
 
 STATIC U32
-seed(void)
+S_seed(pTHX)
 {
     /*
      * This is really just a quick hack which grabs various garbage
@@ -1792,9 +1730,9 @@ PP(pp_exp)
 {
     djSP; dTARGET; tryAMAGICun(exp);
     {
-      double value;
+      NV value;
       value = POPn;
-      value = exp(value);
+      value = Perl_exp(value);
       XPUSHn(value);
       RETURN;
     }
@@ -1804,13 +1742,13 @@ PP(pp_log)
 {
     djSP; dTARGET; tryAMAGICun(log);
     {
-      double value;
+      NV value;
       value = POPn;
       if (value <= 0.0) {
-	SET_NUMERIC_STANDARD();
-	DIE("Can't take log of %g", value);
+	RESTORE_NUMERIC_STANDARD();
+	DIE(aTHX_ "Can't take log of %g", value);
       }
-      value = log(value);
+      value = Perl_log(value);
       XPUSHn(value);
       RETURN;
     }
@@ -1820,13 +1758,13 @@ PP(pp_sqrt)
 {
     djSP; dTARGET; tryAMAGICun(sqrt);
     {
-      double value;
+      NV value;
       value = POPn;
       if (value < 0.0) {
-	SET_NUMERIC_STANDARD();
-	DIE("Can't take sqrt of %g", value);
+	RESTORE_NUMERIC_STANDARD();
+	DIE(aTHX_ "Can't take sqrt of %g", value);
       }
-      value = sqrt(value);
+      value = Perl_sqrt(value);
       XPUSHn(value);
       RETURN;
     }
@@ -1836,7 +1774,7 @@ PP(pp_int)
 {
     djSP; dTARGET;
     {
-      double value = TOPn;
+      NV value = TOPn;
       IV iv;
 
       if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs)) {
@@ -1845,9 +1783,9 @@ PP(pp_int)
       }
       else {
 	if (value >= 0.0)
-	  (void)modf(value, &value);
+	  (void)Perl_modf(value, &value);
 	else {
-	  (void)modf(-value, &value);
+	  (void)Perl_modf(-value, &value);
 	  value = -value;
 	}
 	iv = I_V(value);
@@ -1864,7 +1802,7 @@ PP(pp_abs)
 {
     djSP; dTARGET; tryAMAGICun(abs);
     {
-      double value = TOPn;
+      NV value = TOPn;
       IV iv;
 
       if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs) &&
@@ -1890,14 +1828,14 @@ PP(pp_hex)
     STRLEN n_a;
 
     tmps = POPpx;
-    XPUSHu(scan_hex(tmps, 99, &argtype));
+    XPUSHn(scan_hex(tmps, 99, &argtype));
     RETURN;
 }
 
 PP(pp_oct)
 {
     djSP; dTARGET;
-    UV value;
+    NV value;
     I32 argtype;
     char *tmps;
     STRLEN n_a;
@@ -1913,7 +1851,7 @@ PP(pp_oct)
 	value = scan_bin(++tmps, 99, &argtype);
     else
 	value = scan_oct(tmps, 99, &argtype);
-    XPUSHu(value);
+    XPUSHn(value);
     RETURN;
 }
 
@@ -2005,7 +1943,7 @@ PP(pp_substr)
     }
     if (fail < 0) {
 	if (ckWARN(WARN_SUBSTR) || lvalue || repl)
-	    warner(WARN_SUBSTR, "substr outside of string");
+	    Perl_warner(aTHX_ WARN_SUBSTR, "substr outside of string");
 	RETPUSHUNDEF;
     }
     else {
@@ -2019,7 +1957,7 @@ PP(pp_substr)
 		    STRLEN n_a;
 		    SvPV_force(sv,n_a);
 		    if (ckWARN(WARN_SUBSTR))
-			warner(WARN_SUBSTR,
+			Perl_warner(aTHX_ WARN_SUBSTR,
 				"Attempt to use reference as lvalue in substr");
 		}
 		if (SvOK(sv))		/* is it defined ? */
@@ -2057,74 +1995,24 @@ PP(pp_vec)
     register I32 offset = POPi;
     register SV *src = POPs;
     I32 lvalue = PL_op->op_flags & OPf_MOD;
-    STRLEN srclen;
-    unsigned char *s = (unsigned char*)SvPV(src, srclen);
-    unsigned long retnum;
-    I32 len;
-
-    SvTAINTED_off(TARG);			/* decontaminate */
-    offset *= size;		/* turn into bit offset */
-    len = (offset + size + 7) / 8;
-    if (offset < 0 || size < 1)
-	retnum = 0;
-    else {
-	if (lvalue) {                      /* it's an lvalue! */
-	    if (SvTYPE(TARG) < SVt_PVLV) {
-		sv_upgrade(TARG, SVt_PVLV);
-		sv_magic(TARG, Nullsv, 'v', Nullch, 0);
-	    }
 
-	    LvTYPE(TARG) = 'v';
-	    if (LvTARG(TARG) != src) {
-		if (LvTARG(TARG))
-		    SvREFCNT_dec(LvTARG(TARG));
-		LvTARG(TARG) = SvREFCNT_inc(src);
-	    }
-	    LvTARGOFF(TARG) = offset;
-	    LvTARGLEN(TARG) = size;
-	}
-	if (len > srclen) {
-	    if (size <= 8)
-		retnum = 0;
-	    else {
-		offset >>= 3;
-		if (size == 16) {
-		    if (offset >= srclen)
-			retnum = 0;
-		    else
-			retnum = (unsigned long) s[offset] << 8;
-		}
-		else if (size == 32) {
-		    if (offset >= srclen)
-			retnum = 0;
-		    else if (offset + 1 >= srclen)
-			retnum = (unsigned long) s[offset] << 24;
-		    else if (offset + 2 >= srclen)
-			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);
-		}
-	    }
+    SvTAINTED_off(TARG);		/* decontaminate */
+    if (lvalue) {			/* it's an lvalue! */
+	if (SvTYPE(TARG) < SVt_PVLV) {
+	    sv_upgrade(TARG, SVt_PVLV);
+	    sv_magic(TARG, Nullsv, 'v', Nullch, 0);
 	}
-	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];
+	LvTYPE(TARG) = 'v';
+	if (LvTARG(TARG) != src) {
+	    if (LvTARG(TARG))
+		SvREFCNT_dec(LvTARG(TARG));
+	    LvTARG(TARG) = SvREFCNT_inc(src);
 	}
+	LvTARGOFF(TARG) = offset;
+	LvTARGLEN(TARG) = size;
     }
 
-    sv_setuv(TARG, (UV)retnum);
+    sv_setuv(TARG, do_vecget(src, offset, size));
     PUSHs(TARG);
     RETURN;
 }
@@ -2209,12 +2097,6 @@ PP(pp_rindex)
 PP(pp_sprintf)
 {
     djSP; dMARK; dORIGMARK; dTARGET;
-#ifdef USE_LOCALE_NUMERIC
-    if (PL_op->op_private & OPpLOCALE)
-	SET_NUMERIC_LOCAL();
-    else
-	SET_NUMERIC_STANDARD();
-#endif
     do_sprintf(TARG, SP-MARK, MARK+1);
     TAINT_IF(SvTAINTED(TARG));
     SP = ORIGMARK;
@@ -2279,7 +2161,7 @@ PP(pp_crypt)
     sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
 #endif
 #else
-    DIE(
+    DIE(aTHX_ 
       "The crypt() function is unimplemented due to excessive paranoia.");
 #endif
     SETs(TARG);
@@ -2319,26 +2201,27 @@ PP(pp_ucfirst)
 	    s = (U8*)SvPV_force(sv, slen);
 	    Copy(tmpbuf, s, ulen, U8);
 	}
-	RETURN;
-    }
-
-    if (!SvPADTMP(sv)) {
-	dTARGET;
-	sv_setsv(TARG, sv);
-	sv = TARG;
-	SETs(sv);
     }
-    s = (U8*)SvPV_force(sv, slen);
-    if (*s) {
-	if (PL_op->op_private & OPpLOCALE) {
-	    TAINT;
-	    SvTAINTED_on(sv);
-	    *s = toUPPER_LC(*s);
+    else {
+	if (!SvPADTMP(sv)) {
+	    dTARGET;
+	    sv_setsv(TARG, sv);
+	    sv = TARG;
+	    SETs(sv);
+	}
+	s = (U8*)SvPV_force(sv, slen);
+	if (*s) {
+	    if (PL_op->op_private & OPpLOCALE) {
+		TAINT;
+		SvTAINTED_on(sv);
+		*s = toUPPER_LC(*s);
+	    }
+	    else
+		*s = toUPPER(*s);
 	}
-	else
-	    *s = toUPPER(*s);
     }
-
+    if (SvSMAGICAL(sv))
+	mg_set(sv);
     RETURN;
 }
 
@@ -2375,27 +2258,28 @@ PP(pp_lcfirst)
 	    s = (U8*)SvPV_force(sv, slen);
 	    Copy(tmpbuf, s, ulen, U8);
 	}
-	RETURN;
-    }
-
-    if (!SvPADTMP(sv)) {
-	dTARGET;
-	sv_setsv(TARG, sv);
-	sv = TARG;
-	SETs(sv);
     }
-    s = (U8*)SvPV_force(sv, slen);
-    if (*s) {
-	if (PL_op->op_private & OPpLOCALE) {
-	    TAINT;
-	    SvTAINTED_on(sv);
-	    *s = toLOWER_LC(*s);
+    else {
+	if (!SvPADTMP(sv)) {
+	    dTARGET;
+	    sv_setsv(TARG, sv);
+	    sv = TARG;
+	    SETs(sv);
 	}
-	else
-	    *s = toLOWER(*s);
+	s = (U8*)SvPV_force(sv, slen);
+	if (*s) {
+	    if (PL_op->op_private & OPpLOCALE) {
+		TAINT;
+		SvTAINTED_on(sv);
+		*s = toLOWER_LC(*s);
+	    }
+	    else
+		*s = toLOWER(*s);
+	}
+	SETs(sv);
     }
-
-    SETs(sv);
+    if (SvSMAGICAL(sv))
+	mg_set(sv);
     RETURN;
 }
 
@@ -2416,56 +2300,57 @@ PP(pp_uc)
 	if (!len) {
 	    sv_setpvn(TARG, "", 0);
 	    SETs(TARG);
-	    RETURN;
-	}
-
-	(void)SvUPGRADE(TARG, SVt_PV);
-	SvGROW(TARG, (len * 2) + 1);
-	(void)SvPOK_only(TARG);
-	d = (U8*)SvPVX(TARG);
-	send = s + len;
-	if (PL_op->op_private & OPpLOCALE) {
-	    TAINT;
-	    SvTAINTED_on(TARG);
-	    while (s < send) {
-		d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, &ulen)));
-		s += ulen;
-	    }
 	}
 	else {
-	    while (s < send) {
-		d = uv_to_utf8(d, toUPPER_utf8( s ));
-		s += UTF8SKIP(s);
+	    (void)SvUPGRADE(TARG, SVt_PV);
+	    SvGROW(TARG, (len * 2) + 1);
+	    (void)SvPOK_only(TARG);
+	    d = (U8*)SvPVX(TARG);
+	    send = s + len;
+	    if (PL_op->op_private & OPpLOCALE) {
+		TAINT;
+		SvTAINTED_on(TARG);
+		while (s < send) {
+		    d = uv_to_utf8(d, toUPPER_LC_uni( utf8_to_uv(s, &ulen)));
+		    s += ulen;
+		}
+	    }
+	    else {
+		while (s < send) {
+		    d = uv_to_utf8(d, toUPPER_utf8( s ));
+		    s += UTF8SKIP(s);
+		}
 	    }
+	    *d = '\0';
+	    SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
+	    SETs(TARG);
 	}
-	*d = '\0';
-	SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
-	SETs(TARG);
-	RETURN;
-    }
-
-    if (!SvPADTMP(sv)) {
-	dTARGET;
-	sv_setsv(TARG, sv);
-	sv = TARG;
-	SETs(sv);
     }
-
-    s = (U8*)SvPV_force(sv, len);
-    if (len) {
-	register U8 *send = s + len;
-
-	if (PL_op->op_private & OPpLOCALE) {
-	    TAINT;
-	    SvTAINTED_on(sv);
-	    for (; s < send; s++)
-		*s = toUPPER_LC(*s);
+    else {
+	if (!SvPADTMP(sv)) {
+	    dTARGET;
+	    sv_setsv(TARG, sv);
+	    sv = TARG;
+	    SETs(sv);
 	}
-	else {
-	    for (; s < send; s++)
-		*s = toUPPER(*s);
+	s = (U8*)SvPV_force(sv, len);
+	if (len) {
+	    register U8 *send = s + len;
+
+	    if (PL_op->op_private & OPpLOCALE) {
+		TAINT;
+		SvTAINTED_on(sv);
+		for (; s < send; s++)
+		    *s = toUPPER_LC(*s);
+	    }
+	    else {
+		for (; s < send; s++)
+		    *s = toUPPER(*s);
+	    }
 	}
     }
+    if (SvSMAGICAL(sv))
+	mg_set(sv);
     RETURN;
 }
 
@@ -2486,56 +2371,58 @@ PP(pp_lc)
 	if (!len) {
 	    sv_setpvn(TARG, "", 0);
 	    SETs(TARG);
-	    RETURN;
-	}
-
-	(void)SvUPGRADE(TARG, SVt_PV);
-	SvGROW(TARG, (len * 2) + 1);
-	(void)SvPOK_only(TARG);
-	d = (U8*)SvPVX(TARG);
-	send = s + len;
-	if (PL_op->op_private & OPpLOCALE) {
-	    TAINT;
-	    SvTAINTED_on(TARG);
-	    while (s < send) {
-		d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, &ulen)));
-		s += ulen;
-	    }
 	}
 	else {
-	    while (s < send) {
-		d = uv_to_utf8(d, toLOWER_utf8(s));
-		s += UTF8SKIP(s);
+	    (void)SvUPGRADE(TARG, SVt_PV);
+	    SvGROW(TARG, (len * 2) + 1);
+	    (void)SvPOK_only(TARG);
+	    d = (U8*)SvPVX(TARG);
+	    send = s + len;
+	    if (PL_op->op_private & OPpLOCALE) {
+		TAINT;
+		SvTAINTED_on(TARG);
+		while (s < send) {
+		    d = uv_to_utf8(d, toLOWER_LC_uni( utf8_to_uv(s, &ulen)));
+		    s += ulen;
+		}
+	    }
+	    else {
+		while (s < send) {
+		    d = uv_to_utf8(d, toLOWER_utf8(s));
+		    s += UTF8SKIP(s);
+		}
 	    }
+	    *d = '\0';
+	    SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
+	    SETs(TARG);
 	}
-	*d = '\0';
-	SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
-	SETs(TARG);
-	RETURN;
-    }
-
-    if (!SvPADTMP(sv)) {
-	dTARGET;
-	sv_setsv(TARG, sv);
-	sv = TARG;
-	SETs(sv);
     }
+    else {
+	if (!SvPADTMP(sv)) {
+	    dTARGET;
+	    sv_setsv(TARG, sv);
+	    sv = TARG;
+	    SETs(sv);
+	}
 
-    s = (U8*)SvPV_force(sv, len);
-    if (len) {
-	register U8 *send = s + len;
+	s = (U8*)SvPV_force(sv, len);
+	if (len) {
+	    register U8 *send = s + len;
 
-	if (PL_op->op_private & OPpLOCALE) {
-	    TAINT;
-	    SvTAINTED_on(sv);
-	    for (; s < send; s++)
-		*s = toLOWER_LC(*s);
-	}
-	else {
-	    for (; s < send; s++)
-		*s = toLOWER(*s);
+	    if (PL_op->op_private & OPpLOCALE) {
+		TAINT;
+		SvTAINTED_on(sv);
+		for (; s < send; s++)
+		    *s = toLOWER_LC(*s);
+	    }
+	    else {
+		for (; s < send; s++)
+		    *s = toLOWER(*s);
+	    }
 	}
     }
+    if (SvSMAGICAL(sv))
+	mg_set(sv);
     RETURN;
 }
 
@@ -2583,6 +2470,8 @@ PP(pp_quotemeta)
     else
 	sv_setpvn(TARG, s, len);
     SETs(TARG);
+    if (SvSMAGICAL(TARG))
+	mg_set(TARG);
     RETURN;
 }
 
@@ -2616,7 +2505,7 @@ PP(pp_aslice)
 	    svp = av_fetch(av, elem, lval);
 	    if (lval) {
 		if (!svp || *svp == &PL_sv_undef)
-		    DIE(PL_no_aelem, elem);
+		    DIE(aTHX_ PL_no_aelem, elem);
 		if (PL_op->op_private & OPpLVAL_INTRO)
 		    save_aelem(av, elem, svp);
 	    }
@@ -2635,7 +2524,7 @@ PP(pp_aslice)
 
 PP(pp_each)
 {
-    djSP; dTARGET;
+    djSP;
     HV *hash = (HV*)POPs;
     HE *entry;
     I32 gimme = GIMME_V;
@@ -2650,12 +2539,13 @@ PP(pp_each)
     if (entry) {
 	PUSHs(hv_iterkeysv(entry));	/* won't clobber stack_sp */
 	if (gimme == G_ARRAY) {
+	    SV *val;
 	    PUTBACK;
 	    /* might clobber stack_sp */
-	    sv_setsv(TARG, realhv ?
-		     hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry));
+	    val = realhv ?
+		  hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry);
 	    SPAGAIN;
-	    PUSHs(TARG);
+	    PUSHs(val);
 	}
     }
     else if (gimme == G_SCALAR)
@@ -2666,12 +2556,12 @@ PP(pp_each)
 
 PP(pp_values)
 {
-    return do_kv(ARGS);
+    return do_kv();
 }
 
 PP(pp_keys)
 {
-    return do_kv(ARGS);
+    return do_kv();
 }
 
 PP(pp_delete)
@@ -2691,7 +2581,7 @@ PP(pp_delete)
 	    if (hvtype == SVt_PVHV)
 		sv = hv_delete_ent(hv, *MARK, discard, 0);
 	    else
-		DIE("Not a HASH reference");
+		DIE(aTHX_ "Not a HASH reference");
 	    *MARK = sv ? sv : &PL_sv_undef;
 	}
 	if (discard)
@@ -2708,7 +2598,7 @@ PP(pp_delete)
 	if (SvTYPE(hv) == SVt_PVHV)
 	    sv = hv_delete_ent(hv, keysv, discard, 0);
 	else
-	    DIE("Not a HASH reference");
+	    DIE(aTHX_ "Not a HASH reference");
 	if (!sv)
 	    sv = &PL_sv_undef;
 	if (!discard)
@@ -2731,7 +2621,7 @@ PP(pp_exists)
 	    RETPUSHYES;
     }
     else {
-	DIE("Not a HASH reference");
+	DIE(aTHX_ "Not a HASH reference");
     }
     RETPUSHNO;
 }
@@ -2744,7 +2634,7 @@ PP(pp_hslice)
     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
 
     if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
-	DIE("Can't localize pseudo-hash element");
+	DIE(aTHX_ "Can't localize pseudo-hash element");
 
     if (realhv || SvTYPE(hv) == SVt_PVAV) {
 	while (++MARK <= SP) {
@@ -2760,7 +2650,7 @@ PP(pp_hslice)
 	    if (lval) {
 		if (!svp || *svp == &PL_sv_undef) {
 		    STRLEN n_a;
-		    DIE(PL_no_helem, SvPV(keysv, n_a));
+		    DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
 		}
 		if (PL_op->op_private & OPpLVAL_INTRO)
 		    save_helem(hv, keysv, svp);
@@ -2827,20 +2717,17 @@ PP(pp_lslice)
 
     for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
 	ix = SvIVx(*lelem);
-	if (ix < 0) {
+	if (ix < 0)
 	    ix += max;
-	    if (ix < 0)
-		*lelem = &PL_sv_undef;
-	    else if (!(*lelem = firstrelem[ix]))
-		*lelem = &PL_sv_undef;
-	}
-	else {
+	else 
 	    ix -= arybase;
-	    if (ix >= max || !(*lelem = firstrelem[ix]))
+	if (ix < 0 || ix >= max)
+	    *lelem = &PL_sv_undef;
+	else {
+	    is_something_there = TRUE;
+	    if (!(*lelem = firstrelem[ix]))
 		*lelem = &PL_sv_undef;
 	}
-	if (!is_something_there && (SvOK(*lelem) || SvGMAGICAL(*lelem)))
-	    is_something_there = TRUE;
     }
     if (is_something_there)
 	SP = lastlelem;
@@ -2870,7 +2757,7 @@ PP(pp_anonhash)
 	if (MARK < SP)
 	    sv_setsv(val, *++MARK);
 	else if (ckWARN(WARN_UNSAFE))
-	    warner(WARN_UNSAFE, "Odd number of elements in hash assignment");
+	    Perl_warner(aTHX_ WARN_UNSAFE, "Odd number of elements in hash assignment");
 	(void)hv_store_ent(hv,key,val,0);
     }
     SP = ORIGMARK;
@@ -2898,7 +2785,7 @@ PP(pp_splice)
 	PUSHMARK(MARK);
 	PUTBACK;
 	ENTER;
-	perl_call_method("SPLICE",GIMME_V);
+	call_method("SPLICE",GIMME_V);
 	LEAVE;
 	SPAGAIN;
 	RETURN;
@@ -2913,7 +2800,7 @@ PP(pp_splice)
 	else
 	    offset -= PL_curcop->cop_arybase;
 	if (offset < 0)
-	    DIE(PL_no_aelem, i);
+	    DIE(aTHX_ PL_no_aelem, i);
 	if (++MARK < SP) {
 	    length = SvIVx(*MARK++);
 	    if (length < 0) {
@@ -3092,7 +2979,7 @@ PP(pp_push)
 	PUSHMARK(MARK);
 	PUTBACK;
 	ENTER;
-	perl_call_method("PUSH",G_SCALAR|G_DISCARD);
+	call_method("PUSH",G_SCALAR|G_DISCARD);
 	LEAVE;
 	SPAGAIN;
     }
@@ -3148,7 +3035,7 @@ PP(pp_unshift)
 	PUSHMARK(MARK);
 	PUTBACK;
 	ENTER;
-	perl_call_method("UNSHIFT",G_SCALAR|G_DISCARD);
+	call_method("UNSHIFT",G_SCALAR|G_DISCARD);
 	LEAVE;
 	SPAGAIN;
     }
@@ -3206,7 +3093,9 @@ PP(pp_reverse)
 			s += UTF8SKIP(s);
 			down = (char*)(s - 1);
 			if (s > send || !((*down & 0xc0) == 0x80)) {
-			    warn("Malformed UTF-8 character");
+			    if (ckWARN_d(WARN_UTF8))
+				Perl_warner(aTHX_ WARN_UTF8,
+					    "Malformed UTF-8 character");
 			    break;
 			}
 			while (down > up) {
@@ -3232,8 +3121,8 @@ PP(pp_reverse)
     RETURN;
 }
 
-STATIC SV      *
-mul128(SV *sv, U8 m)
+STATIC SV *
+S_mul128(pTHX_ SV *sv, U8 m)
 {
   STRLEN          len;
   char           *s = SvPV(sv, len);
@@ -3308,7 +3197,7 @@ PP(pp_unpack)
     double adouble;
     I32 checksum = 0;
     register U32 culong;
-    double cdouble;
+    NV cdouble;
     int commas = 0;
 #ifdef PERL_NATINT_PACK
     int natint;		/* native integer */
@@ -3344,7 +3233,7 @@ PP(pp_unpack)
 		pat++;
 	    }
 	    else
-		croak("'!' allowed only after types %s", natstr);
+		Perl_croak(aTHX_ "'!' allowed only after types %s", natstr);
 	}
 	if (pat >= patend)
 	    len = 1;
@@ -3354,17 +3243,20 @@ PP(pp_unpack)
 	}
 	else if (isDIGIT(*pat)) {
 	    len = *pat++ - '0';
-	    while (isDIGIT(*pat))
+	    while (isDIGIT(*pat)) {
 		len = (len * 10) + (*pat++ - '0');
+		if (len < 0)
+		    Perl_croak(aTHX_ "Repeat count in unpack overflows");
+	    }
 	}
 	else
 	    len = (datumtype != '@');
 	switch(datumtype) {
 	default:
-	    croak("Invalid type in unpack: '%c'", (int)datumtype);
+	    Perl_croak(aTHX_ "Invalid type in unpack: '%c'", (int)datumtype);
 	case ',': /* grandfather in commas but with a warning */
 	    if (commas++ == 0 && ckWARN(WARN_UNSAFE))
-		warner(WARN_UNSAFE, "Invalid type in unpack: '%c'", (int)datumtype);
+		Perl_warner(aTHX_ WARN_UNSAFE, "Invalid type in unpack: '%c'", (int)datumtype);
 	    break;
 	case '%':
 	    if (len == 1 && pat[-1] != '1')
@@ -3377,19 +3269,31 @@ PP(pp_unpack)
 	    break;
 	case '@':
 	    if (len > strend - strbeg)
-		DIE("@ outside of string");
+		DIE(aTHX_ "@ outside of string");
 	    s = strbeg + len;
 	    break;
 	case 'X':
 	    if (len > s - strbeg)
-		DIE("X outside of string");
+		DIE(aTHX_ "X outside of string");
 	    s -= len;
 	    break;
 	case 'x':
 	    if (len > strend - s)
-		DIE("x outside of string");
+		DIE(aTHX_ "x outside of string");
 	    s += len;
 	    break;
+	case '#':
+	    if (oldsp >= SP)
+		DIE(aTHX_ "# must follow a numeric type");
+	    if (*pat != 'a' && *pat != 'A' && *pat != 'Z')
+		DIE(aTHX_ "# must be followed by a, A or Z");
+	    datumtype = *pat++;
+	    if (*pat == '*')
+		pat++;		/* ignore '*' for compatibility with pack */
+	    if (isDIGIT(*pat))
+		DIE(aTHX_ "# cannot take a count" );
+	    len = POPi;
+	    /* drop through */
 	case 'A':
 	case 'Z':
 	case 'a':
@@ -3572,7 +3476,7 @@ PP(pp_unpack)
 		    auint = utf8_to_uv((U8*)s, &along);
 		    s += along;
 		    if (checksum > 32)
-			cdouble += (double)auint;
+			cdouble += (NV)auint;
 		    else
 			culong += auint;
 		}
@@ -3600,6 +3504,7 @@ PP(pp_unpack)
 	    if (checksum) {
 #if SHORTSIZE != SIZE16
 		if (natint) {
+		    short ashort;
 		    while (len-- > 0) {
 			COPYNN(s, &ashort, sizeof(short));
 			s += sizeof(short);
@@ -3626,6 +3531,7 @@ PP(pp_unpack)
 		EXTEND_MORTAL(len);
 #if SHORTSIZE != SIZE16
 		if (natint) {
+		    short ashort;
 		    while (len-- > 0) {
 			COPYNN(s, &ashort, sizeof(short));
 			s += sizeof(short);
@@ -3665,6 +3571,7 @@ PP(pp_unpack)
 	    if (checksum) {
 #if SHORTSIZE != SIZE16
 		if (unatint) {
+		    unsigned short aushort;
 		    while (len-- > 0) {
 			COPYNN(s, &aushort, sizeof(unsigned short));
 			s += sizeof(unsigned short);
@@ -3694,6 +3601,7 @@ PP(pp_unpack)
 		EXTEND_MORTAL(len);
 #if SHORTSIZE != SIZE16
 		if (unatint) {
+		    unsigned short aushort;
 		    while (len-- > 0) {
 			COPYNN(s, &aushort, sizeof(unsigned short));
 			s += sizeof(unsigned short);
@@ -3732,7 +3640,7 @@ PP(pp_unpack)
 		    Copy(s, &aint, 1, int);
 		    s += sizeof(int);
 		    if (checksum > 32)
-			cdouble += (double)aint;
+			cdouble += (NV)aint;
 		    else
 			culong += aint;
 		}
@@ -3783,7 +3691,7 @@ PP(pp_unpack)
 		    Copy(s, &auint, 1, unsigned int);
 		    s += sizeof(unsigned int);
 		    if (checksum > 32)
-			cdouble += (double)auint;
+			cdouble += (NV)auint;
 		    else
 			culong += auint;
 		}
@@ -3818,11 +3726,12 @@ PP(pp_unpack)
 	    if (checksum) {
 #if LONGSIZE != SIZE32
 		if (natint) {
+		    long along;
 		    while (len-- > 0) {
 			COPYNN(s, &along, sizeof(long));
 			s += sizeof(long);
 			if (checksum > 32)
-			    cdouble += (double)along;
+			    cdouble += (NV)along;
 			else
 			    culong += along;
 		    }
@@ -3838,7 +3747,7 @@ PP(pp_unpack)
 #endif
 			s += SIZE32;
 			if (checksum > 32)
-			    cdouble += (double)along;
+			    cdouble += (NV)along;
 			else
 			    culong += along;
 		    }
@@ -3849,6 +3758,7 @@ PP(pp_unpack)
 		EXTEND_MORTAL(len);
 #if LONGSIZE != SIZE32
 		if (natint) {
+		    long along;
 		    while (len-- > 0) {
 			COPYNN(s, &along, sizeof(long));
 			s += sizeof(long);
@@ -3888,11 +3798,12 @@ PP(pp_unpack)
 	    if (checksum) {
 #if LONGSIZE != SIZE32
 		if (unatint) {
+		    unsigned long aulong;
 		    while (len-- > 0) {
 			COPYNN(s, &aulong, sizeof(unsigned long));
 			s += sizeof(unsigned long);
 			if (checksum > 32)
-			    cdouble += (double)aulong;
+			    cdouble += (NV)aulong;
 			else
 			    culong += aulong;
 		    }
@@ -3912,7 +3823,7 @@ PP(pp_unpack)
 			    aulong = vtohl(aulong);
 #endif
 			if (checksum > 32)
-			    cdouble += (double)aulong;
+			    cdouble += (NV)aulong;
 			else
 			    culong += aulong;
 		    }
@@ -3923,6 +3834,7 @@ PP(pp_unpack)
 		EXTEND_MORTAL(len);
 #if LONGSIZE != SIZE32
 		if (unatint) {
+		    unsigned long aulong;
 		    while (len-- > 0) {
 			COPYNN(s, &aulong, sizeof(unsigned long));
 			s += sizeof(unsigned long);
@@ -3992,7 +3904,7 @@ PP(pp_unpack)
 			char *t;
 			STRLEN n_a;
 
-			sv = newSVpvf("%.*Vu", (int)TYPE_DIGITS(UV), auv);
+			sv = Perl_newSVpvf(aTHX_ "%.*Vu", (int)TYPE_DIGITS(UV), auv);
 			while (s < strend) {
 			    sv = mul128(sv, *s & 0x7f);
 			    if (!(*s++ & 0x80)) {
@@ -4010,7 +3922,7 @@ PP(pp_unpack)
 		    }
 		}
 		if ((s >= strend) && bytes)
-		    croak("Unterminated compressed integer");
+		    Perl_croak(aTHX_ "Unterminated compressed integer");
 	    }
 	    break;
 	case 'P':
@@ -4044,7 +3956,7 @@ PP(pp_unpack)
 		if (aquad >= IV_MIN && aquad <= IV_MAX)
 		    sv_setiv(sv, (IV)aquad);
 		else
-		    sv_setnv(sv, (double)aquad);
+		    sv_setnv(sv, (NV)aquad);
 		PUSHs(sv_2mortal(sv));
 	    }
 	    break;
@@ -4065,7 +3977,7 @@ PP(pp_unpack)
 		if (auquad <= UV_MAX)
 		    sv_setuv(sv, (UV)auquad);
 		else
-		    sv_setnv(sv, (double)auquad);
+		    sv_setnv(sv, (NV)auquad);
 		PUSHs(sv_2mortal(sv));
 	    }
 	    break;
@@ -4090,7 +4002,7 @@ PP(pp_unpack)
 		    Copy(s, &afloat, 1, float);
 		    s += sizeof(float);
 		    sv = NEWSV(47, 0);
-		    sv_setnv(sv, (double)afloat);
+		    sv_setnv(sv, (NV)afloat);
 		    PUSHs(sv_2mortal(sv));
 		}
 	    }
@@ -4114,7 +4026,7 @@ PP(pp_unpack)
 		    Copy(s, &adouble, 1, double);
 		    s += sizeof(double);
 		    sv = NEWSV(48, 0);
-		    sv_setnv(sv, (double)adouble);
+		    sv_setnv(sv, (NV)adouble);
 		    PUSHs(sv_2mortal(sv));
 		}
 	    }
@@ -4182,7 +4094,7 @@ PP(pp_unpack)
 	    sv = NEWSV(42, 0);
 	    if (strchr("fFdD", datumtype) ||
 	      (checksum > 32 && strchr("iIlLNU", datumtype)) ) {
-		double trouble;
+		NV trouble;
 
 		adouble = 1.0;
 		while (checksum >= 16) {
@@ -4198,7 +4110,7 @@ PP(pp_unpack)
 		along = (1 << checksum) - 1;
 		while (cdouble < 0.0)
 		    cdouble += adouble;
-		cdouble = modf(cdouble / adouble, &trouble) * adouble;
+		cdouble = Perl_modf(cdouble / adouble, &trouble) * adouble;
 		sv_setnv(sv, cdouble);
 	    }
 	    else {
@@ -4218,7 +4130,7 @@ PP(pp_unpack)
 }
 
 STATIC void
-doencodes(register SV *sv, register char *s, register I32 len)
+S_doencodes(pTHX_ register SV *sv, register char *s, register I32 len)
 {
     char hunk[5];
 
@@ -4246,7 +4158,7 @@ doencodes(register SV *sv, register char *s, register I32 len)
 }
 
 STATIC SV *
-is_an_int(char *s, STRLEN l)
+S_is_an_int(pTHX_ char *s, STRLEN l)
 {
   STRLEN	 n_a;
   SV             *result = newSVpvn(s, l);
@@ -4294,10 +4206,9 @@ is_an_int(char *s, STRLEN l)
   return (result);
 }
 
+/* pnum must be '\0' terminated */
 STATIC int
-div128(SV *pnum, bool *done)
-                          		    /* must be '\0' terminated */
-
+S_div128(pTHX_ SV *pnum, bool *done)
 {
   STRLEN          len;
   char           *s = SvPV(pnum, len);
@@ -4361,7 +4272,8 @@ PP(pp_pack)
     MARK++;
     sv_setpvn(cat, "", 0);
     while (pat < patend) {
-#define NEXTFROM (items-- > 0 ? *MARK++ : &PL_sv_no)
+	SV *lengthcode = Nullsv;
+#define NEXTFROM ( lengthcode ? lengthcode : items-- > 0 ? *MARK++ : &PL_sv_no)
 	datumtype = *pat++ & 0xFF;
 #ifdef PERL_NATINT_PACK
 	natint = 0;
@@ -4378,7 +4290,7 @@ PP(pp_pack)
 		pat++;
 	    }
 	    else
-		croak("'!' allowed only after types %s", natstr);
+		Perl_croak(aTHX_ "'!' allowed only after types %s", natstr);
 	}
 	if (*pat == '*') {
 	    len = strchr("@Xxu", datumtype) ? 0 : items;
@@ -4386,20 +4298,31 @@ PP(pp_pack)
 	}
 	else if (isDIGIT(*pat)) {
 	    len = *pat++ - '0';
-	    while (isDIGIT(*pat))
+	    while (isDIGIT(*pat)) {
 		len = (len * 10) + (*pat++ - '0');
+		if (len < 0)
+		    Perl_croak(aTHX_ "Repeat count in pack overflows");
+	    }
 	}
 	else
 	    len = 1;
+	if (*pat == '#') {
+	    ++pat;
+	    if (*pat != 'a' && *pat != 'A' && *pat != 'Z' || pat[1] != '*')
+		DIE(aTHX_ "# must be followed by a*, A* or Z*");
+	    lengthcode = sv_2mortal(newSViv(sv_len(items > 0
+						   ? *MARK : &PL_sv_no)));
+	}
 	switch(datumtype) {
 	default:
-	    croak("Invalid type in pack: '%c'", (int)datumtype);
+	    Perl_croak(aTHX_ "Invalid type in pack: '%c'", (int)datumtype);
 	case ',': /* grandfather in commas but with a warning */
 	    if (commas++ == 0 && ckWARN(WARN_UNSAFE))
-		warner(WARN_UNSAFE, "Invalid type in pack: '%c'", (int)datumtype);
+		Perl_warner(aTHX_ WARN_UNSAFE,
+			    "Invalid type in pack: '%c'", (int)datumtype);
 	    break;
 	case '%':
-	    DIE("%% may only be used in unpack");
+	    DIE(aTHX_ "%% may only be used in unpack");
 	case '@':
 	    len -= SvCUR(cat);
 	    if (len > 0)
@@ -4411,7 +4334,7 @@ PP(pp_pack)
 	case 'X':
 	  shrink:
 	    if (SvCUR(cat) < len)
-		DIE("X outside of string");
+		DIE(aTHX_ "X outside of string");
 	    SvCUR(cat) -= len;
 	    *SvEND(cat) = '\0';
 	    break;
@@ -4650,6 +4573,8 @@ PP(pp_pack)
 	case 's':
 #if SHORTSIZE != SIZE16
 	    if (natint) {
+		short ashort;
+
 		while (len-- > 0) {
 		    fromstr = NEXTFROM;
 		    ashort = SvIV(fromstr);
@@ -4676,10 +4601,10 @@ PP(pp_pack)
 	case 'w':
             while (len-- > 0) {
 		fromstr = NEXTFROM;
-		adouble = floor(SvNV(fromstr));
+		adouble = Perl_floor(SvNV(fromstr));
 
 		if (adouble < 0)
-		    croak("Cannot compress negative numbers");
+		    Perl_croak(aTHX_ "Cannot compress negative numbers");
 
 		if (
 #ifdef BW_BITS
@@ -4695,7 +4620,7 @@ PP(pp_pack)
 		{
 		    char   buf[1 + sizeof(UV)];
 		    char  *in = buf + sizeof(buf);
-		    UV     auv = U_V(adouble);;
+		    UV     auv = U_V(adouble);
 
 		    do {
 			*--in = (auv & 0x7f) | 0x80;
@@ -4713,7 +4638,7 @@ PP(pp_pack)
 		    /* Copy string and check for compliance */
 		    from = SvPV(fromstr, len);
 		    if ((norm = is_an_int(from, len)) == NULL)
-			croak("can compress only unsigned integer");
+			Perl_croak(aTHX_ "can compress only unsigned integer");
 
 		    New('w', result, len, char);
 		    in = result + len;
@@ -4733,14 +4658,14 @@ PP(pp_pack)
 			double next = floor(adouble / 128);
 			*--in = (unsigned char)(adouble - (next * 128)) | 0x80;
 			if (--in < buf)  /* this cannot happen ;-) */
-			    croak ("Cannot compress integer");
+			    Perl_croak(aTHX_ "Cannot compress integer");
 			adouble = next;
 		    } while (adouble > 0);
 		    buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
 		    sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
 		}
 		else
-		    croak("Cannot compress non integer");
+		    Perl_croak(aTHX_ "Cannot compress non integer");
 	    }
             break;
 	case 'i':
@@ -4773,6 +4698,8 @@ PP(pp_pack)
 	case 'L':
 #if LONGSIZE != SIZE32
 	    if (natint) {
+		unsigned long aulong;
+
 		while (len-- > 0) {
 		    fromstr = NEXTFROM;
 		    aulong = SvUV(fromstr);
@@ -4792,6 +4719,8 @@ PP(pp_pack)
 	case 'l':
 #if LONGSIZE != SIZE32
 	    if (natint) {
+		long along;
+
 		while (len-- > 0) {
 		    fromstr = NEXTFROM;
 		    along = SvIV(fromstr);
@@ -4812,7 +4741,7 @@ PP(pp_pack)
 	case 'Q':
 	    while (len-- > 0) {
 		fromstr = NEXTFROM;
-		auquad = (Uquad_t)SvIV(fromstr);
+		auquad = (Uquad_t)SvUV(fromstr);
 		sv_catpvn(cat, (char*)&auquad, sizeof(Uquad_t));
 	    }
 	    break;
@@ -4840,7 +4769,7 @@ PP(pp_pack)
 		     * gone.
 		     */
 		    if (ckWARN(WARN_UNSAFE) && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
-			warner(WARN_UNSAFE,
+			Perl_warner(aTHX_ WARN_UNSAFE,
 				"Attempt to pack pointer to temporary value");
 		    if (SvPOK(fromstr) || SvNIOK(fromstr))
 			aptr = SvPV(fromstr,n_a);
@@ -4912,7 +4841,7 @@ PP(pp_split)
     pm = (PMOP*)POPs;
 #endif
     if (!pm || !s)
-	DIE("panic: do_split");
+	DIE(aTHX_ "panic: do_split");
     rx = pm->op_pmregexp;
 
     TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
@@ -4941,6 +4870,7 @@ PP(pp_split)
 	else {
 	    if (!AvREAL(ary)) {
 		AvREAL_on(ary);
+		AvREIFY_off(ary);
 		for (i = AvFILLp(ary); i >= 0; i--)
 		    AvARRAY(ary)[i] = &PL_sv_undef;	/* don't free mere refs */
 	    }
@@ -5006,15 +4936,19 @@ PP(pp_split)
 	    s = m;
 	}
     }
-    else if (rx->check_substr && !rx->nparens
+    else if ((rx->reganch & RE_USE_INTUIT) && !rx->nparens
 	     && (rx->reganch & ROPT_CHECK_ALL)
 	     && !(rx->reganch & ROPT_ANCH)) {
-	i = SvCUR(rx->check_substr);
-	if (i == 1 && !SvTAIL(rx->check_substr)) {
-	    i = *SvPVX(rx->check_substr);
+	int tail = (rx->reganch & RE_INTUIT_TAIL);
+	SV *csv = CALLREG_INTUIT_STRING(aTHX_ rx);
+	char c;
+
+	len = rx->minlen;
+	if (len == 1 && !tail) {
+	    c = *SvPV(csv,len);
 	    while (--limit) {
 		/*SUPPRESS 530*/
-		for (m = s; m < strend && *m != i; m++) ;
+		for (m = s; m < strend && *m != c; m++) ;
 		if (m >= strend)
 		    break;
 		dstr = NEWSV(30, m-s);
@@ -5028,8 +4962,8 @@ PP(pp_split)
 	else {
 #ifndef lint
 	    while (s < strend && --limit &&
-	      (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
-		    rx->check_substr, 0)) )
+	      (m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
+			     csv, PL_multiline ? FBMrf_MULTILINE : 0)) )
 #endif
 	    {
 		dstr = NEWSV(31, m-s);
@@ -5037,25 +4971,28 @@ PP(pp_split)
 		if (make_mortal)
 		    sv_2mortal(dstr);
 		XPUSHs(dstr);
-		s = m + i;
+		s = m + len;		/* Fake \n at the end */
 	    }
 	}
     }
     else {
 	maxiters += (strend - s) * rx->nparens;
-	while (s < strend && --limit &&
-	       CALLREGEXEC(rx, s, strend, orig, 1, sv, NULL, 0))
+	while (s < strend && --limit
+/*	       && (!rx->check_substr 
+		   || ((s = CALLREG_INTUIT_START(aTHX_ rx, sv, s, strend,
+						 0, NULL))))
+*/	       && CALLREGEXEC(aTHX_ rx, s, strend, orig,
+			      1 /* minend */, sv, NULL, 0))
 	{
 	    TAINT_IF(RX_MATCH_TAINTED(rx));
-	    if (rx->subbase
-	      && rx->subbase != orig) {
+	    if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
 		m = s;
 		s = orig;
-		orig = rx->subbase;
+		orig = rx->subbeg;
 		s = orig + (m - s);
 		strend = s + (strend - m);
 	    }
-	    m = rx->startp[0];
+	    m = rx->startp[0] + orig;
 	    dstr = NEWSV(32, m-s);
 	    sv_setpvn(dstr, s, m-s);
 	    if (make_mortal)
@@ -5063,8 +5000,8 @@ PP(pp_split)
 	    XPUSHs(dstr);
 	    if (rx->nparens) {
 		for (i = 1; i <= rx->nparens; i++) {
-		    s = rx->startp[i];
-		    m = rx->endp[i];
+		    s = rx->startp[i] + orig;
+		    m = rx->endp[i] + orig;
 		    if (m && s) {
 			dstr = NEWSV(33, m-s);
 			sv_setpvn(dstr, s, m-s);
@@ -5076,14 +5013,14 @@ PP(pp_split)
 		    XPUSHs(dstr);
 		}
 	    }
-	    s = rx->endp[0];
+	    s = rx->endp[0] + orig;
 	}
     }
 
     LEAVE_SCOPE(oldsave);
     iters = (SP - PL_stack_base) - base;
     if (iters > maxiters)
-	DIE("Split loop");
+	DIE(aTHX_ "Split loop");
 
     /* keep field after final delim? */
     if (s < strend || (iters && origlimit)) {
@@ -5117,7 +5054,7 @@ PP(pp_split)
 	else {
 	    PUTBACK;
 	    ENTER;
-	    perl_call_method("PUSH",G_SCALAR|G_DISCARD);
+	    call_method("PUSH",G_SCALAR|G_DISCARD);
 	    LEAVE;
 	    SPAGAIN;
 	    if (gimme == G_ARRAY) {
@@ -5145,16 +5082,16 @@ PP(pp_split)
 
 #ifdef USE_THREADS
 void
-unlock_condpair(void *svv)
+Perl_unlock_condpair(pTHX_ void *svv)
 {
     dTHR;
     MAGIC *mg = mg_find((SV*)svv, 'm');
 
     if (!mg)
-	croak("panic: unlock_condpair unlocking non-mutex");
+	Perl_croak(aTHX_ "panic: unlock_condpair unlocking non-mutex");
     MUTEX_LOCK(MgMUTEXP(mg));
     if (MgOWNER(mg) != thr)
-	croak("panic: unlock_condpair unlocking mutex that we don't own");
+	Perl_croak(aTHX_ "panic: unlock_condpair unlocking mutex that we don't own");
     MgOWNER(mg) = 0;
     COND_SIGNAL(MgOWNERCONDP(mg));
     DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n",
@@ -5185,7 +5122,7 @@ PP(pp_lock)
 	DEBUG_S(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
 			      (unsigned long)thr, (unsigned long)sv);)
 	MUTEX_UNLOCK(MgMUTEXP(mg));
-	save_destructor(unlock_condpair, sv);
+	SAVEDESTRUCTOR(Perl_unlock_condpair, sv);
     }
 #endif /* USE_THREADS */
     if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
@@ -5207,6 +5144,6 @@ PP(pp_threadsv)
 	PUSHs(THREADSV(PL_op->op_targ));
     RETURN;
 #else
-    DIE("tried to access per-thread data in non-threaded perl");
+    DIE(aTHX_ "tried to access per-thread data in non-threaded perl");
 #endif /* USE_THREADS */
 }