X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pp_pack.c;h=7d7bd32736e2723f9a39b23d47f52b1fc93c8aba;hb=d44161bfbb2e964e9675634d6bf5e566d1d1d4f7;hp=4752e667d7d119e5de669bd51ff944058de0ee71;hpb=4bb101f2758f169969171dfe6b70f68a406dcc1e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pp_pack.c b/pp_pack.c
index 4752e66..7d7bd32 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -418,7 +418,7 @@ S_next_symbol(pTHX_ register tempsym_t* symptr )
         if (strchr(natstr, code))
  	  code |= TYPE_IS_SHRIEKING;
         else
-   	  Perl_croak(aTHX_ "'!' allowed only after types %s in pack/unpack",
+   	  Perl_croak(aTHX_ "'!' allowed only after types %s in %s",
                      natstr, symptr->flags & FLAG_PACK ? "pack" : "unpack" );
       }
 
@@ -494,7 +494,8 @@ S_next_symbol(pTHX_ register tempsym_t* symptr )
 /*
 =for apidoc unpack_str
 
-The engine implementing unpack() Perl function.
+The engine implementing unpack() Perl function. Note: parameters strbeg, new_s
+and ocnt are not used. This call should not be used, use unpackstring instead.
 
 =cut */
 
@@ -509,6 +510,24 @@ Perl_unpack_str(pTHX_ char *pat, register char *patend, register char *s, char *
     return unpack_rec(&sym, s, s, strend, NULL );
 }
 
+/*
+=for apidoc unpackstring
+
+The engine implementing unpack() Perl function.
+
+=cut */
+
+I32
+Perl_unpackstring(pTHX_ char *pat, register char *patend, register char *s, char *strend, U32 flags)
+{
+    tempsym_t sym = { 0 };
+    sym.patptr = pat;
+    sym.patend = patend;
+    sym.flags  = flags;
+
+    return unpack_rec(&sym, s, s, strend, NULL );
+}
+
 STATIC
 I32
 S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, char *strend, char **new_s )
@@ -877,11 +896,11 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
 		}
 	    }
 	    else {
+		short ashort;
                 if (len && unpack_only_one)
                     len = 1;
 		EXTEND(SP, len);
 		EXTEND_MORTAL(len);
-		short ashort;
 		while (len-- > 0) {
 		    COPYNN(s, &ashort, sizeof(short));
 		    s += sizeof(short);
@@ -933,7 +952,7 @@ S_unpack_rec(pTHX_ register tempsym_t* symptr, register char *s, char *strbeg, c
 	    break;
 	case 'S' | TYPE_IS_SHRIEKING:
 #if SHORTSIZE != SIZE16
-	    along = (strend - s) / SIZE16;
+	    along = (strend - s) / sizeof(unsigned short);
 	    if (len > along)
 		len = along;
 	    if (checksum) {
@@ -1705,7 +1724,7 @@ PP(pp_unpack)
     register I32 cnt;
 
     PUTBACK;
-    cnt = unpack_str(pat, patend, s, s, strend, NULL, 0,
+    cnt = unpackstring(pat, patend, s, strend,
 		     ((gimme == G_SCALAR) ? FLAG_UNPACK_ONLY_ONE : 0)
 		     | (DO_UTF8(right) ? FLAG_UNPACK_DO_UTF8 : 0));
 
@@ -1824,7 +1843,8 @@ S_div128(pTHX_ SV *pnum, bool *done)
 /*
 =for apidoc pack_cat
 
-The engine implementing pack() Perl function.
+The engine implementing pack() Perl function. Note: parameters next_in_list and
+flags are not used. This call should not be used; use packlist instead.
 
 =cut */
 
@@ -1835,7 +1855,27 @@ Perl_pack_cat(pTHX_ SV *cat, char *pat, register char *patend, register SV **beg
     tempsym_t sym = { 0 };
     sym.patptr = pat;
     sym.patend = patend;
-    sym.flags  = flags;
+    sym.flags  = FLAG_PACK;
+
+    (void)pack_rec( cat, &sym, beglist, endlist );
+}
+
+
+/*
+=for apidoc packlist
+
+The engine implementing pack() Perl function.
+
+=cut */
+
+
+void
+Perl_packlist(pTHX_ SV *cat, char *pat, register char *patend, register SV **beglist, SV **endlist )
+{
+    tempsym_t sym = { 0 };
+    sym.patptr = pat;
+    sym.patend = patend;
+    sym.flags  = FLAG_PACK;
 
     (void)pack_rec( cat, &sym, beglist, endlist );
 }
@@ -2589,7 +2629,7 @@ PP(pp_pack)
     MARK++;
     sv_setpvn(cat, "", 0);
 
-    pack_cat(cat, pat, patend, MARK, SP + 1, NULL, FLAG_PACK);
+    packlist(cat, pat, patend, MARK, SP + 1);
 
     SvSETMAGIC(cat);
     SP = ORIGMARK;