Make building perl on Win32 with the free VC++ toolkit easier

[perl5.git] / pp_pack.c

diff --git a/pp_pack.c b/pp_pack.c
index a5e1c8e..92d0a36 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -240,6 +240,8 @@ S_mul128(pTHX_ SV *sv, U8 m)
 # define DO_BO_PACK_N(var, type)
 # define DO_BO_UNPACK_P(var)
 # define DO_BO_PACK_P(var)
+# define DO_BO_UNPACK_PC(var)
+# define DO_BO_PACK_PC(var)
 
 #else /* PERL_PACK_CAN_BYTEORDER */
 
@@ -323,6 +325,8 @@ S_mul128(pTHX_ SV *sv, U8 m)
 # else
 #  define DO_BO_UNPACK_P(var)  BO_CANT_DOIT(unpack, pointer)
 #  define DO_BO_PACK_P(var)    BO_CANT_DOIT(pack, pointer)
+#  define DO_BO_UNPACK_PC(var) BO_CANT_DOIT(unpack, pointer)
+#  define DO_BO_PACK_PC(var)   BO_CANT_DOIT(pack, pointer)
 # endif
 
 # if defined(my_htolen) && defined(my_letohn) && \
@@ -1024,8 +1028,7 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
           Perl_croak(aTHX_ "Can't use '%c' in a group with different byte-order in %s",
                      *patptr, _action( symptr ) );
 
-        if (ckWARN(WARN_UNPACK)) {
-          if (code & modifier)
+        if ((code & modifier) && ckWARN(WARN_UNPACK)) {
            Perl_warner(aTHX_ packWARN(WARN_UNPACK),
                         "Duplicate modifier '%c' after '%c' in %s",
                         *patptr, (int) TYPE_NO_MODIFIERS(code),
@@ -1117,7 +1120,6 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
    version of the string. Users are advised to upgrade their pack string
    themselves if they need to do a lot of unpacks like this on it
 */
-/* XXX These can be const */
 STATIC bool
 need_utf8(const char *pat, const char *patend)
 {
@@ -1492,7 +1494,7 @@ S_unpack_rec(pTHX_ tempsym_t* symptr, const char *s, const char *strbeg, const c
            if (checksum) {
                if (!PL_bitcount) {
                    int bits;
-                   Newz(601, PL_bitcount, 256, char);
+                   Newxz(PL_bitcount, 256, char);
                    for (bits = 1; bits < 256; bits++) {
                        if (bits & 1)   PL_bitcount[bits]++;
                        if (bits & 2)   PL_bitcount[bits]++;
@@ -2392,8 +2394,8 @@ S_div128(pTHX_ SV *pnum, bool *done)
 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 */
-
+=cut
+*/
 
 void
 Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
@@ -2413,8 +2415,8 @@ Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **
 
 The engine implementing pack() Perl function.
 
-=cut */
-
+=cut
+*/
 
 void
 Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist )
@@ -2427,7 +2429,8 @@ Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, register SV **
     /* We're going to do changes through SvPVX(cat). Make sure it's valid.
        Also make sure any UTF8 flag is loaded */
     SvPV_force(cat, no_len);
-    if (DO_UTF8(cat)) sym.flags |= FLAG_PARSE_UTF8 | FLAG_DO_UTF8;
+    if (DO_UTF8(cat))
+       sym.flags |= FLAG_PARSE_UTF8 | FLAG_DO_UTF8;
 
     (void)pack_rec( cat, &sym, beglist, endlist );
 }
@@ -2453,11 +2456,11 @@ marked_upgrade(pTHX_ SV *sv, tempsym_t *sym_ptr) {
     }
 
     len = (from_end-from_ptr)*UTF8_EXPAND+(from_ptr-from_start)+1;
-    New('U', to_start, len, char);
+    Newx(to_start, len, char);
     Copy(from_start, to_start, from_ptr-from_start, char);
     to_ptr = to_start + (from_ptr-from_start);
 
-    New('U', marks, sym_ptr->level+2, const char *);
+    Newx(marks, sym_ptr->level+2, const char *);
     for (group=sym_ptr; group; group = group->previous)
        marks[group->level] = from_start + group->strbeg;
     marks[sym_ptr->level+1] = from_end+1;
@@ -2518,6 +2521,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
     I32 items  = endlist - beglist;
     bool found = next_symbol(symptr);
     bool utf8 = (symptr->flags & FLAG_PARSE_UTF8) ? 1 : 0;
+    bool warn_utf8 = ckWARN(WARN_UTF8);
 
     if (symptr->level == 0 && found && symptr->code == 'U') {
        marked_upgrade(aTHX_ cat, symptr);
@@ -2843,7 +2847,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            end = str + fromlen;
            if (DO_UTF8(fromstr)) {
                utf8_source = TRUE;
-               utf8_flags  = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
+               utf8_flags  = warn_utf8 ? 0 : UTF8_ALLOW_ANY;
            } else {
                utf8_source = FALSE;
                utf8_flags  = 0; /* Unused, but keep compilers happy */
@@ -2912,7 +2916,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            end = str + fromlen;
            if (DO_UTF8(fromstr)) {
                utf8_source = TRUE;
-               utf8_flags  = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
+               utf8_flags  = warn_utf8 ? 0 : UTF8_ALLOW_ANY;
            } else {
                utf8_source = FALSE;
                utf8_flags  = 0; /* Unused, but keep compilers happy */
@@ -3025,7 +3029,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    }
                    cur = (char *) uvuni_to_utf8_flags((U8 *) cur,
                                                       NATIVE_TO_UNI(auv),
-                                                      ckWARN(WARN_UTF8) ?
+                                                      warn_utf8 ?
                                                       0 : UNICODE_ALLOW_ANY);
                } else {
                    if (auv >= 0x100) {
@@ -3079,7 +3083,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                if (utf8) {
                    U8 buffer[UTF8_MAXLEN], *endb;
                    endb = uvuni_to_utf8_flags(buffer, auv,
-                                              ckWARN(WARN_UTF8) ?
+                                              warn_utf8 ?
                                               0 : UNICODE_ALLOW_ANY);
                    if (cur+(endb-buffer)*UTF8_EXPAND >= end) {
                        *cur = '\0';
@@ -3097,7 +3101,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                        end = start+SvLEN(cat)-UTF8_MAXLEN;
                    }
                    cur = (char *) uvuni_to_utf8_flags((U8 *) cur, auv,
-                                                      ckWARN(WARN_UTF8) ?
+                                                      warn_utf8 ?
                                                       0 : UNICODE_ALLOW_ANY);
                }
            }
@@ -3392,7 +3396,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    if ((norm = is_an_int(from, len)) == NULL)
                        Perl_croak(aTHX_ "Can only compress unsigned integers in pack");
 
-                   New('w', result, len, char);
+                   Newx(result, len, char);
                    in = result + len;
                    done = FALSE;
                    while (!done) *--in = div128(norm, &done) | 0x80;
@@ -3518,22 +3522,20 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                SvGETMAGIC(fromstr);
                if (!SvOK(fromstr)) aptr = NULL;
                else {
-                   STRLEN n_a;
                    /* XXX better yet, could spirit away the string to
                     * a safe spot and hang on to it until the result
                     * of pack() (and all copies of the result) are
                     * gone.
                     */
-                   if (ckWARN(WARN_PACK) &&
-                       (SvTEMP(fromstr) || (SvPADTMP(fromstr) &&
-                                            !SvREADONLY(fromstr)))) {
+                   if ((SvTEMP(fromstr) || (SvPADTMP(fromstr) &&
+                            !SvREADONLY(fromstr))) && ckWARN(WARN_PACK)) {
                        Perl_warner(aTHX_ packWARN(WARN_PACK),
                                    "Attempt to pack pointer to temporary value");
                    }
                    if (SvPOK(fromstr) || SvNIOK(fromstr))
-                       aptr = SvPV_nomg_const(fromstr, n_a);
+                       aptr = SvPV_nomg_const_nolen(fromstr);
                    else
-                       aptr = SvPV_force_flags(fromstr, n_a, 0);
+                       aptr = SvPV_force_flags_nolen(fromstr, 0);
                }
                DO_BO_PACK_PC(aptr);
                PUSH_VAR(utf8, cur, aptr);