Fix worrying typo in handy.h :-s
[p5sagit/p5-mst-13.2.git] / util.c
diff --git a/util.c b/util.c
index 6ef7a01..6caedaa 100644 (file)
--- a/util.c
+++ b/util.c
@@ -366,14 +366,13 @@ void
 Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
 {
     const register U8 *s;
-    register U8 *table;
     register U32 i;
     STRLEN len;
     I32 rarest = 0;
     U32 frequency = 256;
 
     if (flags & FBMcf_TAIL) {
-       MAGIC *mg = SvUTF8(sv) && SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL;
+       MAGIC * const mg = SvUTF8(sv) && SvMAGICAL(sv) ? mg_find(sv, PERL_MAGIC_utf8) : NULL;
        sv_catpvn(sv, "\n", 1);         /* Taken into account in fbm_instr() */
        if (mg && mg->mg_len >= 0)
            mg->mg_len++;
@@ -385,6 +384,7 @@ Perl_fbm_compile(pTHX_ SV *sv, U32 flags)
     if (len > 2) {
        const unsigned char *sb;
        const U8 mlen = (len>255) ? 255 : (U8)len;
+       register U8 *table;
 
        Sv_Grow(sv, len + 256 + FBM_TABLE_OFFSET);
        table = (unsigned char*)(SvPVX_mutable(sv) + len + FBM_TABLE_OFFSET);
@@ -764,7 +764,7 @@ Perl_savepv(pTHX_ const char *pv)
     else {
        char *newaddr;
        const STRLEN pvlen = strlen(pv)+1;
-       New(902,newaddr,pvlen,char);
+       Newx(newaddr,pvlen,char);
        return memcpy(newaddr,pv,pvlen);
     }
 
@@ -788,7 +788,7 @@ Perl_savepvn(pTHX_ const char *pv, register I32 len)
 {
     register char *newaddr;
 
-    New(903,newaddr,len+1,char);
+    Newx(newaddr,len+1,char);
     /* Give a meaning to NULL pointer mainly for the use in sv_magic() */
     if (pv) {
        /* might not be null terminated */
@@ -843,7 +843,7 @@ Perl_savesvpv(pTHX_ SV *sv)
     register char *newaddr;
 
     ++len;
-    New(903,newaddr,len,char);
+    Newx(newaddr,len,char);
     return (char *) CopyD(pv,newaddr,len,char);
 }
 
@@ -863,8 +863,8 @@ S_mess_alloc(pTHX)
        return PL_mess_sv;
 
     /* Create as PVMG now, to avoid any upgrading later */
-    New(905, sv, 1, SV);
-    Newz(905, any, 1, XPVMG);
+    Newx(sv, 1, SV);
+    Newxz(any, 1, XPVMG);
     SvFLAGS(sv) = SVt_PVMG;
     SvANY(sv) = (void*)any;
     SvPV_set(sv, 0);
@@ -1074,7 +1074,7 @@ S_vdie_common(pTHX_ const char *message, STRLEN msglen, I32 utf8)
     GV *gv;
     CV *cv;
     /* sv_2cv might call Perl_croak() */
-    SV *olddiehook = PL_diehook;
+    SV * const olddiehook = PL_diehook;
 
     assert(PL_diehook);
     ENTER;
@@ -1116,7 +1116,7 @@ S_vdie_croak_common(pTHX_ const char* pat, va_list* args, STRLEN* msglen,
     const char *message;
 
     if (pat) {
-       SV *msv = vmess(pat, args);
+       SV * const msv = vmess(pat, args);
        if (PL_errors && SvCUR(PL_errors)) {
            sv_catsv(PL_errors, msv);
            message = SvPV_const(PL_errors, *msglen);
@@ -1151,7 +1151,7 @@ Perl_vdie(pTHX_ const char* pat, va_list *args)
                          "%p: die: curstack = %p, mainstack = %p\n",
                          thr, PL_curstack, PL_mainstack));
 
-    message = S_vdie_croak_common(aTHX_ pat, args, &msglen, &utf8);
+    message = vdie_croak_common(pat, args, &msglen, &utf8);
 
     PL_restartop = die_where(message, msglen);
     SvFLAGS(ERRSV) |= utf8;
@@ -1528,7 +1528,7 @@ Perl_my_setenv(pTHX_ const char *nam, const char *val)
        val = "";
     }
     vlen = strlen(val);
-    New(904, envstr, nlen+vlen+2, char);
+    Newx(envstr, nlen+vlen+2, char);
     my_setenv_format(envstr, nam, nlen, val, vlen);
     (void)PerlEnv_putenv(envstr);
     Safefree(envstr);
@@ -3265,23 +3265,19 @@ Perl_my_fflush_all(pTHX)
 void
 Perl_report_evil_fh(pTHX_ const GV *gv, const IO *io, I32 op)
 {
-    const char *func =
+    const char * const func =
        op == OP_READLINE   ? "readline"  :     /* "<HANDLE>" not nice */
        op == OP_LEAVEWRITE ? "write" :         /* "write exit" not nice */
        PL_op_desc[op];
-    const char *pars = OP_IS_FILETEST(op) ? "" : "()";
-    const char *type = OP_IS_SOCKET(op)
+    const char * const pars = OP_IS_FILETEST(op) ? "" : "()";
+    const char * const type = OP_IS_SOCKET(op)
            || (gv && io && IoTYPE(io) == IoTYPE_SOCKET)
                ?  "socket" : "filehandle";
-    const char *name = NULL;
-
-    if (gv && isGV(gv)) {
-       name = GvENAME(gv);
-    }
+    const char * const name = gv && isGV(gv) ? GvENAME(gv) : NULL;
 
     if (op == OP_phoney_OUTPUT_ONLY || op == OP_phoney_INPUT_ONLY) {
        if (ckWARN(WARN_IO)) {
-           const char *direction = (op == OP_phoney_INPUT_ONLY) ? "in" : "out";
+           const char * const direction = (op == OP_phoney_INPUT_ONLY) ? "in" : "out";
            if (name && *name)
                Perl_warner(aTHX_ packWARN(WARN_IO),
                            "Filehandle %s opened only for %sput",
@@ -3638,7 +3634,7 @@ Perl_my_strftime(pTHX_ const char *fmt, int sec, int min, int hour, int mday, in
   } STMT_END;
 #endif
   buflen = 64;
-  New(0, buf, buflen, char);
+  Newx(buf, buflen, char);
   len = strftime(buf, buflen, fmt, &mytm);
   /*
   ** The following is needed to handle to the situation where
@@ -3661,7 +3657,7 @@ Perl_my_strftime(pTHX_ const char *fmt, int sec, int min, int hour, int mday, in
     const int fmtlen = strlen(fmt);
     const int bufsize = fmtlen + buflen;
 
-    New(0, buf, bufsize, char);
+    Newx(buf, bufsize, char);
     while (buf) {
       buflen = strftime(buf, bufsize, fmt, &mytm);
       if (buflen > 0 && buflen < bufsize)
@@ -4962,6 +4958,53 @@ Perl_free_global_struct(pTHX_ struct perl_vars *plvarsp)
 
 #endif /* PERL_GLOBAL_STRUCT */
 
+#ifdef PERL_MEM_LOG
+
+Malloc_t
+Perl_mem_log_alloc(const UV n, const UV typesize, const char *typename, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname)
+{
+#ifdef PERL_MEM_LOG_STDERR
+    /* We can't use PerlIO_printf() for obvious reasons. */
+    char buf[1024];
+    sprintf(buf,
+           "alloc: %s:%d:%s: %"IVdf" %"UVuf" %s = %"IVdf": %"UVxf"\n",
+           filename, linenumber, funcname,
+           n, typesize, typename, n * typesize, PTR2UV(newalloc));
+    write(2, buf, strlen(buf));
+#endif
+    return newalloc;
+}
+
+Malloc_t
+Perl_mem_log_realloc(const UV n, const UV typesize, const char *typename, Malloc_t oldalloc, Malloc_t newalloc, const char *filename, const int linenumber, const char *funcname)
+{
+#ifdef PERL_MEM_LOG_STDERR
+    /* We can't use PerlIO_printf() for obvious reasons. */
+    char buf[1024];
+    sprintf(buf,
+           "realloc: %s:%d:%s: %"IVdf" %"UVuf" %s = %"IVdf": %"UVxf" -> %"UVxf"\n",
+           filename, linenumber, funcname,
+           n, typesize, typename, n * typesize, PTR2UV(oldalloc), PTR2UV(newalloc));
+    write(2, buf, strlen(buf));
+#endif
+    return newalloc;
+}
+
+Malloc_t
+Perl_mem_log_free(Malloc_t oldalloc, const char *filename, const int linenumber, const char *funcname)
+{
+#ifdef PERL_MEM_LOG_STDERR
+    /* We can't use PerlIO_printf() for obvious reasons. */
+    char buf[1024];
+    sprintf(buf, "free: %s:%d:%s: %"UVxf"\n",
+           filename, linenumber, funcname, PTR2UV(oldalloc));
+    write(2, buf, strlen(buf));
+#endif
+    return oldalloc;
+}
+
+#endif /* PERL_MEM_LOG */
+
 /*
  * Local variables:
  * c-indentation-style: bsd