X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=doop.c;h=0dbfe20c487c122cefe35811a8f2222c47bd9ae6;hb=706de38c2aa2b981f7071fda099501bf2cc8caeb;hp=36fb6b37f809d0a0674d6cb50d7263f681f4e3db;hpb=a50d7633b624bae17978449ecd97928ccd5098bb;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/doop.c b/doop.c
index 36fb6b3..0dbfe20 100644
--- a/doop.c
+++ b/doop.c
@@ -1,6 +1,6 @@
 /*    doop.c
  *
- *    Copyright (c) 1991-1999, Larry Wall
+ *    Copyright (c) 1991-2000, 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.
@@ -282,7 +282,7 @@ S_do_trans_CU_simple(pTHX_ SV *sv)
     UV extra = none + 1;
     UV final;
     UV uv;
-    U8 tmpbuf[10];
+    U8 tmpbuf[UTF8_MAXLEN];
     I32 bits = 16;
 
     s = (U8*)SvPV(sv, len);
@@ -719,7 +719,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
 		if (offset >= srclen)
 		    retnum = 0;
 		else
-		    retnum = (UV) s[offset] << 8;
+		    retnum = (UV) s[offset] <<  8;
 	    }
 	    else if (size == 32) {
 		if (offset >= srclen)
@@ -737,6 +737,58 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
 			((UV) s[offset + 1] << 16) +
 			(     s[offset + 2] <<  8);
 	    }
+#ifdef UV_IS_QUAD
+	    else if (size == 64) {
+		dTHR;
+		if (ckWARN(WARN_PORTABLE))
+		    Perl_warner(aTHX_ WARN_PORTABLE,
+				"Bit vector size > 32 non-portable");
+		if (offset >= srclen)
+		    retnum = 0;
+		else if (offset + 1 >= srclen)
+		    retnum =
+			(UV) s[offset     ] << 56;
+		else if (offset + 2 >= srclen)
+		    retnum =
+			((UV) s[offset    ] << 56) +
+			((UV) s[offset + 1] << 48);
+		else if (offset + 3 >= srclen)
+		    retnum =
+			((UV) s[offset    ] << 56) +
+			((UV) s[offset + 1] << 48) +
+			((UV) s[offset + 2] << 40);
+		else if (offset + 4 >= srclen)
+		    retnum =
+			((UV) s[offset    ] << 56) +
+			((UV) s[offset + 1] << 48) +
+			((UV) s[offset + 2] << 40) +
+			((UV) s[offset + 3] << 32);
+		else if (offset + 5 >= srclen)
+		    retnum =
+			((UV) s[offset    ] << 56) +
+			((UV) s[offset + 1] << 48) +
+			((UV) s[offset + 2] << 40) +
+			((UV) s[offset + 3] << 32) +
+			(     s[offset + 4] << 24);
+		else if (offset + 6 >= srclen)
+		    retnum =
+			((UV) s[offset    ] << 56) +
+			((UV) s[offset + 1] << 48) +
+			((UV) s[offset + 2] << 40) +
+			((UV) s[offset + 3] << 32) +
+			((UV) s[offset + 4] << 24) +
+			((UV) s[offset + 5] << 16);
+		else
+		    retnum = 
+			((UV) s[offset    ] << 56) +
+			((UV) s[offset + 1] << 48) +
+			((UV) s[offset + 2] << 40) +
+			((UV) s[offset + 3] << 32) +
+			((UV) s[offset + 4] << 24) +
+			((UV) s[offset + 5] << 16) +
+			(     s[offset + 6] <<  8);
+	    }
+#endif
 	}
     }
     else if (size < 8)
@@ -747,7 +799,7 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
 	    retnum = s[offset];
 	else if (size == 16)
 	    retnum =
-		((UV) s[offset] <<  8) +
+		((UV) s[offset] <<      8) +
 		      s[offset + 1];
 	else if (size == 32)
 	    retnum =
@@ -755,6 +807,23 @@ Perl_do_vecget(pTHX_ SV *sv, I32 offset, I32 size)
 		((UV) s[offset + 1] << 16) +
 		(     s[offset + 2] <<  8) +
 		      s[offset + 3];
+#ifdef UV_IS_QUAD
+	else if (size == 64) {
+	    dTHR;
+	    if (ckWARN(WARN_PORTABLE))
+		Perl_warner(aTHX_ WARN_PORTABLE,
+			    "Bit vector size > 32 non-portable");
+	    retnum =
+		((UV) s[offset    ] << 56) +
+		((UV) s[offset + 1] << 48) +
+		((UV) s[offset + 2] << 40) +
+		((UV) s[offset + 3] << 32) +
+		((UV) s[offset + 4] << 24) +
+		((UV) s[offset + 5] << 16) +
+		(     s[offset + 6] <<  8) +
+		      s[offset + 7];
+	}
+#endif
     }
 
     return retnum;
@@ -800,17 +869,33 @@ Perl_do_vecset(pTHX_ SV *sv)
     else {
 	offset >>= 3;			/* turn into byte offset */
 	if (size == 8)
-	    s[offset] = lval & 255;
+	    s[offset  ] = lval         & 0xff;
 	else if (size == 16) {
-	    s[offset] = (lval >> 8) & 255;
-	    s[offset+1] = lval & 255;
+	    s[offset  ] = (lval >>  8) & 0xff;
+	    s[offset+1] = lval         & 0xff;
 	}
 	else if (size == 32) {
-	    s[offset] = (lval >> 24) & 255;
-	    s[offset+1] = (lval >> 16) & 255;
-	    s[offset+2] = (lval >> 8) & 255;
-	    s[offset+3] = lval & 255;
+	    s[offset  ] = (lval >> 24) & 0xff;
+	    s[offset+1] = (lval >> 16) & 0xff;
+	    s[offset+2] = (lval >>  8) & 0xff;
+	    s[offset+3] =  lval        & 0xff;
+	}
+#ifdef UV_IS_QUAD
+	else if (size == 64) {
+	    dTHR;
+	    if (ckWARN(WARN_PORTABLE))
+		Perl_warner(aTHX_ WARN_PORTABLE,
+			    "Bit vector size > 32 non-portable");
+	    s[offset  ] = (lval >> 56) & 0xff;
+	    s[offset+1] = (lval >> 48) & 0xff;
+	    s[offset+2] = (lval >> 40) & 0xff;
+	    s[offset+3] = (lval >> 32) & 0xff;
+	    s[offset+4] = (lval >> 24) & 0xff;
+	    s[offset+5] = (lval >> 16) & 0xff;
+	    s[offset+6] = (lval >>  8) & 0xff;
+	    s[offset+7] =  lval        & 0xff;
 	}
+#endif
     }
     SvSETMAGIC(targ);
 }
@@ -848,7 +933,7 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
     s = SvPV(sv, len);
     if (len && !SvPOK(sv))
 	s = SvPV_force(sv, len);
-    if (IN_UTF8) {
+    if (DO_UTF8(sv)) {
 	if (s && len) {
 	    char *send = s + len;
 	    char *start = s;
@@ -861,22 +946,23 @@ Perl_do_chop(pTHX_ register SV *astr, register SV *sv)
 	    *s = '\0';
 	    SvCUR_set(sv, s - start);
 	    SvNIOK_off(sv);
+	    SvUTF8_on(astr);
 	}
 	else
 	    sv_setpvn(astr, "", 0);
     }
-    else
-    if (s && len) {
+    else if (s && len) {
 	s += --len;
 	sv_setpvn(astr, s, 1);
 	*s = '\0';
 	SvCUR_set(sv, len);
+	SvUTF8_off(sv);
 	SvNIOK_off(sv);
     }
     else
 	sv_setpvn(astr, "", 0);
     SvSETMAGIC(sv);
-} 
+}
 
 I32
 Perl_do_chomp(pTHX_ register SV *sv)