From 6f332c18d91531fbdc283eceacfc20ab414b77a9 Mon Sep 17 00:00:00 2001
From: danielk1977 <danielk1977@noemail.net>
Date: Fri, 21 Mar 2008 14:22:44 +0000
Subject: [PATCH] Add some more logging to the malloc system used when
 SQLITE_MEMDEBUG is defined. (CVS 4901)

FossilOrigin-Name: 79738f582fbac87f2d335e0c6b7f53e3054b41ba
---
 manifest          |  18 +++----
 manifest.uuid     |   2 +-
 src/mem2.c        |  10 +++-
 src/test_malloc.c | 127 +++++++++++++++++++++++++++++++++++++++++++++-
 test/tester.tcl   |  85 ++++++++++++++++++++++++++++++-
 5 files changed, 229 insertions(+), 13 deletions(-)

diff --git a/manifest b/manifest
index a48d5812b2..acd7e9960d 100644
--- a/manifest
+++ b/manifest
@@ -1,5 +1,5 @@
-C In\sthe\ssqlite3_limit()\sinterface,\stake\sout\sthe\sfeature\swhere\szero\smeans\nuse\sthe\shard\supper\sbound.\s\sIf\san\sapplication\swants\sthe\shard\supper\sbound,\nit\scan\sset\sthe\slimit\sto\s0x7fffffff\sand\sthe\sbound\swill\sbe\sautomatically\ntruncated.\s(CVS\s4900)
-D 2008-03-20T18:00:49
+C Add\ssome\smore\slogging\sto\sthe\smalloc\ssystem\sused\swhen\sSQLITE_MEMDEBUG\sis\sdefined.\s(CVS\s4901)
+D 2008-03-21T14:22:44
 F Makefile.arm-wince-mingw32ce-gcc ac5f7b2cef0cd850d6f755ba6ee4ab961b1fadf7
 F Makefile.in cf434ce8ca902e69126ae0f94fc9f7dc7428a5fa
 F Makefile.linux-gcc d53183f4aa6a9192d249731c90dbdffbd2c68654
@@ -108,7 +108,7 @@ F src/main.c f9c9a666f0cc5f5a4b768e48d12c1d1e65bf9b36
 F src/malloc.c 60e392a4c12c839517f9b0db7b995f825444fb35
 F src/md5.c c5fdfa5c2593eaee2e32a5ce6c6927c986eaf217
 F src/mem1.c fc716ff521b6dd3e43eaa211967383308800e70a
-F src/mem2.c a17fd71f39e593f46445282c36077231e70a31eb
+F src/mem2.c a4694eff7397de20a7e4b3d70c3faeaf63bf4647
 F src/mem3.c 52547678a2ae50c203d54be1a5bf51eb02438a3f
 F src/mem4.c 45c328ec6dcb7e8d319cb383615b5fe547ca5409
 F src/mem5.c 11d98b76f77873aab86b543cbd1a8ddc4e680d58
@@ -161,7 +161,7 @@ F src/test_devsym.c cee1aecaa90c895030399ca4ae38f84a08038f8a
 F src/test_func.c 9e9b33ff083b65da91c389cece903bc32de06f01
 F src/test_hexio.c 1a1cd8324d57585ea86b922f609fa1fbaaf9662d
 F src/test_loadext.c 22065d601a18878e5542191001f0eaa5d77c0ed8
-F src/test_malloc.c bba50714c0aa75552bc535473afb8213f18c2fe6
+F src/test_malloc.c 52d8d7003c0b2183fd67de45c8b64ee7eb2656ea
 F src/test_md5.c bca40b727c57462ddb415e57c5323445a1bb1a40
 F src/test_onefile.c 2fea6d22f13f5f286356c80c77ffd41f995f2b7a
 F src/test_schema.c 12c9de7661d6294eec2d57afbb52e2af1128084f
@@ -459,7 +459,7 @@ F test/table.test 13b1c2e2fb4727b35ee1fb7641fc469214fd2455
 F test/tableapi.test 791f7e3891d9b70bdb43b311694bf5e9befcbc34
 F test/tclsqlite.test 3fac87cb1059c46b8fa8a60b553f4f1adb0fb6d9
 F test/temptable.test 19b851b9e3e64d91e9867619b2a3f5fffee6e125
-F test/tester.tcl c32f6dfadf9148482d533236c4efee972791d424
+F test/tester.tcl 482f1b003f937249d3b3d6cc9aacd540c9b50635
 F test/thread001.test 8fbd9559da0bbdc273e00318c7fd66c162020af7
 F test/thread002.test 2c4ad2c386f60f6fe268cd91c769ee35b3c1fd0b
 F test/thread1.test 776c9e459b75ba905193b351926ac4019b049f35
@@ -624,7 +624,7 @@ F www/tclsqlite.tcl 8be95ee6dba05eabcd27a9d91331c803f2ce2130
 F www/vdbe.tcl 87a31ace769f20d3627a64fa1fade7fed47b90d0
 F www/version3.tcl 890248cf7b70e60c383b0e84d77d5132b3ead42b
 F www/whentouse.tcl fc46eae081251c3c181bd79c5faef8195d7991a5
-P 4c4be4c3c8aae97f1d85442b25afba9f0b02c8b3
-R 10f06e62355868edd7f0d48570d09623
-U drh
-Z 5ee7e525e24d3023d636da94fdb9521e
+P d6be1f495ec57158f7bcca3e32145a9a8fde723a
+R 28cbaee3047482f301b44be906e76f05
+U danielk1977
+Z a16e4b15bf7acabffb6c1a202fc0f688
diff --git a/manifest.uuid b/manifest.uuid
index 04165108c0..ff6b6c4035 100644
--- a/manifest.uuid
+++ b/manifest.uuid
@@ -1 +1 @@
-d6be1f495ec57158f7bcca3e32145a9a8fde723a
\ No newline at end of file
+79738f582fbac87f2d335e0c6b7f53e3054b41ba
\ No newline at end of file
diff --git a/src/mem2.c b/src/mem2.c
index 41d9720fd9..56da914626 100644
--- a/src/mem2.c
+++ b/src/mem2.c
@@ -12,7 +12,7 @@
 ** This file contains the C functions that implement a memory
 ** allocation subsystem for use by SQLite.  
 **
-** $Id: mem2.c,v 1.22 2008/02/19 15:15:16 drh Exp $
+** $Id: mem2.c,v 1.23 2008/03/21 14:22:44 danielk1977 Exp $
 */
 #include "sqliteInt.h"
 
@@ -107,6 +107,7 @@ static struct {
   ** The number of levels of backtrace to save in new allocations.
   */
   int nBacktrace;
+  void (*xBacktrace)(int, int, void **);
 
   /*
   ** Title text to insert in front of each block
@@ -286,6 +287,9 @@ void *sqlite3_malloc(int nByte){
         void *aAddr[40];
         pHdr->nBacktrace = backtrace(aAddr, mem.nBacktrace+1)-1;
         memcpy(pBt, &aAddr[1], pHdr->nBacktrace*sizeof(void*));
+	if( mem.xBacktrace ){
+          mem.xBacktrace(nByte, pHdr->nBacktrace-1, &aAddr[1]);
+	}
       }else{
         pHdr->nBacktrace = 0;
       }
@@ -389,6 +393,10 @@ void sqlite3MemdebugBacktrace(int depth){
   mem.nBacktrace = depth;
 }
 
+void sqlite3MemdebugBacktraceCallback(void (*xBacktrace)(int, int, void **)){
+  mem.xBacktrace = xBacktrace;
+}
+
 /*
 ** Set the title string for subsequent allocations.
 */
diff --git a/src/test_malloc.c b/src/test_malloc.c
index c0daf46908..ce2f718be0 100644
--- a/src/test_malloc.c
+++ b/src/test_malloc.c
@@ -13,7 +13,7 @@
 ** This file contains code used to implement test interfaces to the
 ** memory allocation subsystem.
 **
-** $Id: test_malloc.c,v 1.17 2008/03/18 13:01:38 drh Exp $
+** $Id: test_malloc.c,v 1.18 2008/03/21 14:22:44 danielk1977 Exp $
 */
 #include "sqliteInt.h"
 #include "tcl.h"
@@ -507,6 +507,130 @@ static int test_memdebug_settitle(
   return TCL_OK;
 }
 
+#define MALLOC_LOG_FRAMES 5
+static Tcl_HashTable aMallocLog;
+static int mallocLogEnabled = 0;
+
+typedef struct MallocLog MallocLog;
+struct MallocLog {
+  int nCall;
+  int nByte;
+};
+
+static void test_memdebug_callback(int nByte, int nFrame, void **aFrame){
+  if( mallocLogEnabled ){
+    MallocLog *pLog;
+    Tcl_HashEntry *pEntry;
+    int isNew;
+
+    int aKey[MALLOC_LOG_FRAMES];
+    int nKey = sizeof(int)*MALLOC_LOG_FRAMES;
+
+    memset(aKey, 0, nKey);
+    if( (sizeof(void*)*nFrame)<nKey ){
+      nKey = nFrame*sizeof(void*);
+    }
+    memcpy(aKey, aFrame, nKey);
+
+    pEntry = Tcl_CreateHashEntry(&aMallocLog, (const char *)aKey, &isNew);
+    if( isNew ){
+      pLog = (MallocLog *)Tcl_Alloc(sizeof(MallocLog));
+      memset(pLog, 0, sizeof(MallocLog));
+      Tcl_SetHashValue(pEntry, (ClientData)pLog);
+    }else{
+      pLog = (MallocLog *)Tcl_GetHashValue(pEntry);
+    }
+
+    pLog->nCall++;
+    pLog->nByte += nByte;
+  }
+}
+
+static int test_memdebug_log(
+  void * clientData,
+  Tcl_Interp *interp,
+  int objc,
+  Tcl_Obj *CONST objv[]
+){
+  static int isInit = 0;
+  int iSub;
+
+  enum MB_enum { MB_LOG_START, MB_LOG_STOP, MB_LOG_DUMP, MB_LOG_CLEAR };
+  static const char *MB_strs[] = { "start", "stop", "dump", "clear" };
+
+  if( !isInit ){
+#ifdef SQLITE_MEMDEBUG
+    extern void sqlite3MemdebugBacktraceCallback(
+        void (*xBacktrace)(int, int, void **));
+    sqlite3MemdebugBacktraceCallback(test_memdebug_callback);
+#endif
+    Tcl_InitHashTable(&aMallocLog, MALLOC_LOG_FRAMES);
+    isInit = 1;
+  }
+
+  if( objc<2 ){
+    Tcl_WrongNumArgs(interp, 1, objv, "SUB-COMMAND ...");
+  }
+  if( Tcl_GetIndexFromObj(interp, objv[1], MB_strs, "sub-command", 0, &iSub) ){
+    return TCL_ERROR;
+  }
+
+  switch( (enum MB_enum)iSub ){
+    case MB_LOG_START:
+      mallocLogEnabled = 1;
+      break;
+    case MB_LOG_STOP:
+      mallocLogEnabled = 0;
+      break;
+    case MB_LOG_DUMP: {
+      Tcl_HashSearch search;
+      Tcl_HashEntry *pEntry;
+      Tcl_Obj *pRet = Tcl_NewObj();
+
+      assert(sizeof(int)==sizeof(void*));
+
+      for(
+        pEntry=Tcl_FirstHashEntry(&aMallocLog, &search);
+        pEntry;
+        pEntry=Tcl_NextHashEntry(&search)
+      ){
+        Tcl_Obj *apElem[MALLOC_LOG_FRAMES+2];
+        MallocLog *pLog = (MallocLog *)Tcl_GetHashValue(pEntry);
+        int *aKey = (int *)Tcl_GetHashKey(&aMallocLog, pEntry);
+        int ii;
+  
+        apElem[0] = Tcl_NewIntObj(pLog->nCall);
+        apElem[1] = Tcl_NewIntObj(pLog->nByte);
+        for(ii=0; ii<MALLOC_LOG_FRAMES; ii++){
+          apElem[ii+2] = Tcl_NewIntObj(aKey[ii]);
+        }
+
+        Tcl_ListObjAppendElement(interp, pRet,
+            Tcl_NewListObj(MALLOC_LOG_FRAMES+2, apElem)
+        );
+      }
+
+      Tcl_SetObjResult(interp, pRet);
+      break;
+    }
+    case MB_LOG_CLEAR: {
+      Tcl_HashSearch search;
+      Tcl_HashEntry *pEntry;
+      for(
+        pEntry=Tcl_FirstHashEntry(&aMallocLog, &search);
+        pEntry;
+        pEntry=Tcl_NextHashEntry(&search)
+      ){
+        MallocLog *pLog = (MallocLog *)Tcl_GetHashValue(pEntry);
+        Tcl_Free((char *)pLog);
+      }
+      Tcl_DeleteHashTable(&aMallocLog);
+      Tcl_InitHashTable(&aMallocLog, MALLOC_LOG_FRAMES);
+    }
+  }
+
+  return TCL_OK;
+}
 
 /*
 ** Register commands with the TCL interpreter.
@@ -529,6 +653,7 @@ int Sqlitetest_malloc_Init(Tcl_Interp *interp){
      { "sqlite3_memdebug_pending",   test_memdebug_pending         },
      { "sqlite3_memdebug_settitle",  test_memdebug_settitle        },
      { "sqlite3_memdebug_malloc_count", test_memdebug_malloc_count },
+     { "sqlite3_memdebug_log",       test_memdebug_log },
   };
   int i;
   for(i=0; i<sizeof(aObjCmd)/sizeof(aObjCmd[0]); i++){
diff --git a/test/tester.tcl b/test/tester.tcl
index af45741ec9..2110de0ce7 100644
--- a/test/tester.tcl
+++ b/test/tester.tcl
@@ -11,7 +11,7 @@
 # This file implements some common TCL routines used for regression
 # testing the SQLite library
 #
-# $Id: tester.tcl,v 1.107 2008/03/19 16:08:54 drh Exp $
+# $Id: tester.tcl,v 1.108 2008/03/21 14:22:44 danielk1977 Exp $
 
 
 set tcl_precision 15
@@ -646,7 +646,90 @@ proc allcksum {{db db}} {
   return [md5 $txt]
 }
 
+proc memdebug_log_sql {database} {
+  set data [sqlite3_memdebug_log dump]
+  set nFrame [expr [llength [lindex $data 0]]-2]
 
+  if {$nFrame < 0} { return "" }
+
+  set tbl "CREATE TABLE ${database}.malloc(nCall, nByte"
+  for {set ii 1} {$ii <= $nFrame} {incr ii} {
+    append tbl ", f${ii}"
+  }
+  append tbl ");\n"
+
+  set sql ""
+  foreach e $data {
+    append sql "INSERT INTO ${database}.malloc VALUES([join $e ,]);\n"
+    foreach f [lrange $e 2 end] {
+      set frames($f) 1
+    }
+  }
+
+  set tbl2 "CREATE TABLE ${database}.frame(frame INTEGER PRIMARY KEY, line);\n"
+
+  foreach f [array names frames] {
+    set addr [format %x $f]
+    set cmd "addr2line -e [info nameofexec] $addr"
+    set line [eval exec $cmd]
+    append sql "INSERT INTO ${database}.frame VALUES($f, '$line');\n"
+  }
+
+  return "BEGIN; ${tbl}${tbl2}${sql} ; COMMIT;"
+}
+proc memdebug_log_pp2 {db iLevel iParentFrame iDepth} {
+  set extra 1
+  if {$iParentFrame != 0} {
+    set extra "f[expr $iLevel-1] = $iParentFrame"
+  }
+  set leader [string repeat "         " [expr $iLevel -1]]
+  $db eval "
+    select 
+      sum(ncall) calls, 
+      sum(nbyte) as bytes, 
+      frame,
+      line FROM malloc, 
+      frame WHERE f${iLevel}=frame AND $extra
+      GROUP BY f${iLevel} ORDER BY calls DESC
+  " {
+    puts [format "%s%-10s %10s %s" $leader $calls $bytes $line]
+    if {$iLevel < $iDepth} {
+      memdebug_log_pp2 $db [expr $iLevel + 1] $frame $iDepth
+    }
+  }
+}
+proc memdebug_log_strip {db} {
+  set nFrame [expr [llength [$db eval "SELECT * FROM malloc LIMIT 1"]] - 2]
+
+  set update "UPDATE malloc SET "
+  for {set ii 1} {$ii <= $nFrame} {incr ii} {
+    if {$ii == $nFrame} {
+      append update "f${ii} = 0"
+    } else {
+      append update "f${ii} = f[expr $ii+1], "
+    }
+  }
+  append update "
+    WHERE 
+      (SELECT line FROM frame WHERE frame = f1) LIKE '%malloc.c:%' OR
+      (SELECT line FROM frame WHERE frame = f1) LIKE '%mem2.c:%'
+  "
+
+  $db eval $update
+  $db eval $update
+  $db eval $update
+}
+proc memdebug_log_pp {{iDepth 1}} {
+  set sql [memdebug_log_sql main]
+  if {$sql eq ""} return
+
+  sqlite3 mddb :memory:
+  mddb eval $sql
+  memdebug_log_strip mddb
+
+  memdebug_log_pp2 mddb 1 0 $iDepth
+  mddb close
+}
 
 # Copy file $from into $to. This is used because some versions of
 # TCL for windows (notably the 8.4.1 binary package shipped with the