Memory Tcl包装中的内存泄漏

我阅读了所有我能在Tcl API中找到的关于内存管理的内容，但到目前为止还不能解决我的问题。我编写了一个Tcl扩展来访问现有的应用程序。它可以工作，除了一个严重的问题：内存泄漏

我试图用最少的代码重现这个问题，你可以在文章的末尾找到。扩展在名称空间vtcl中定义了一个新命令recordings。recordings命令创建一个包含10000个元素的列表，每个元素都是一个新命令。每个命令都附加有数据，即记录的名称。每个命令的name子命令返回录制的名称

我使用tclsh运行以下Tcl代码来重现问题：

load libvtcl.so
for {set ii 0} {$ii < 1000} {incr ii} {
  set recs [vtcl::recordings]
  foreach r $recs {rename $r ""}
}

加载libvtcl.so
对于{set ii 0}{$ii<1000}{incr ii}{
设置录制[vtcl:：录制]
foreach r$recs{rename$r”“}
}

foreach r$recs{rename$r”“}行在每次迭代时删除所有命令，这释放了附加到每个命令的数据段的内存（我可以在gdb中看到）。我还可以在gdb中看到，变量rec的引用计数在每次迭代时变为0，这样列表的内容就被释放了。尽管如此，我看到运行tclsh的进程的内存在每次迭代中都会增加

我不知道我还能尝试什么。非常感谢您的帮助

#include <stdio.h>
#include <string.h>
#include <tcl.h>

static void DecrementRefCount(ClientData cd);
static int ListRecordingsCmd(ClientData cd, Tcl_Interp *interp, int objc,
                             Tcl_Obj *CONST objv[]);
static int RecordingCmd(ClientData cd, Tcl_Interp *interp, int objc,
                        Tcl_Obj *CONST objv[]);

static void
DecrementRefCount(ClientData cd)
{
  Tcl_Obj *obj = (Tcl_Obj *) cd;
  Tcl_DecrRefCount(obj);
  return;
}

static int
ListRecordingsCmd(ClientData cd, Tcl_Interp *interp, int objc,
                  Tcl_Obj *CONST objv[])
{
  char name_buf[20];
  Tcl_Obj *rec_list = Tcl_NewListObj(0, NULL);

  for (int ii = 0; ii < 10000; ii++)
    {
      static int obj_id = 0;
      Tcl_Obj *cmd;
      Tcl_Obj *rec_name;

      cmd = Tcl_NewStringObj ("rec", -1);
      Tcl_AppendObjToObj (cmd, Tcl_NewIntObj (obj_id++));

      rec_name = Tcl_NewStringObj ("DM", -1);
      snprintf(name_buf, sizeof(name_buf), "%04d", ii);
      Tcl_AppendStringsToObj(rec_name, name_buf, (char *) NULL);
      Tcl_IncrRefCount(rec_name);

      Tcl_CreateObjCommand (interp, Tcl_GetString (cmd), RecordingCmd,
                            (ClientData) rec_name, DecrementRefCount);
      Tcl_ListObjAppendElement (interp, rec_list, cmd);
    }

  Tcl_SetObjResult (interp, rec_list);

  return TCL_OK;
}

static int
RecordingCmd(ClientData cd, Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])
{
  Tcl_Obj *rec_name = (Tcl_Obj *)cd;
  char *subcmd;

  subcmd = Tcl_GetString (objv[1]);
  if (strcmp (subcmd, "name") == 0)
    {
      Tcl_SetObjResult (interp, rec_name);
    } 

  else
    {
      Tcl_Obj *result = Tcl_NewStringObj ("", 0);
      Tcl_AppendStringsToObj (result,
                              "bad command \"",
                              Tcl_GetString (objv[1]),
                              "\"",
                              (char *) NULL);
      Tcl_SetObjResult (interp, result);
      return TCL_ERROR;
    }

  return TCL_OK;
}

int
Vtcl_Init(Tcl_Interp *interp)
{
#ifdef USE_TCL_STUBS
  if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
    return TCL_ERROR;
  }
#endif

  if (Tcl_PkgProvide(interp, "vtcl", "0.0.1") != TCL_OK)
    return TCL_ERROR;

  Tcl_CreateNamespace(interp, "vtcl", (ClientData) NULL,
                          (Tcl_NamespaceDeleteProc *) NULL);

  Tcl_CreateObjCommand(interp, "::vtcl::recordings", ListRecordingsCmd,
                       (ClientData) NULL, (Tcl_CmdDeleteProc *) NULL);

  return TCL_OK;
}

#包括
#包括
#包括
静态无效递减计数（客户端数据cd）；
静态int-ListRecordingsCmd（ClientData cd、Tcl_Interp*Interp、int-objc、，
Tcl_Obj*CONST objv[]；
静态int-RecordingCmd（ClientData-cd、Tcl_-Interp*Interp、int-objc、，
Tcl_Obj*CONST objv[]；
静态空隙
递减计数（客户端数据cd）
{
Tcl_Obj*Obj=（Tcl_Obj*）cd；
Tcl_减量计数（obj）；
回来
}
静态整数
ListRecordingsCmd（客户端数据cd、Tcl_Interp*Interp、int objc、，
Tcl_Obj*CONST objv[]
{
字符名称_buf[20]；
Tcl_Obj*rec_list=Tcl_NewListObj（0，空）；
对于（int ii=0；ii<10000；ii++）
{
静态int obj_id=0；
Tcl_Obj*cmd；
Tcl_对象*记录名称；
cmd=Tcl_NewStringObj（“rec”，-1）；
Tcl_AppendObjToObj（cmd，Tcl_NewIntObj（obj_id++））；
rec_name=Tcl_NewStringObj（“DM”，-1）；
snprintf（name_buf，sizeof（name_buf），“%04d”，ii）；
Tcl_appendStringsTobj（记录名称，名称（char*）空）；
Tcl_IncrRefCount（记录名称）；
Tcl_CreateObjCommand（interp、Tcl_GetString（cmd）、RecordingCmd、，
（客户数据）记录名称、递减计数）；
Tcl_ListObjAppendElement（interp，rec_list，cmd）；
}
Tcl_SetObjResult（interp，rec_list）；
返回TCL_OK；
}
静态整数
RecordingCmd（客户端数据cd、Tcl_Interp*Interp、int objc、Tcl_Obj*CONST objv[]）
{
Tcl_Obj*rec_name=（Tcl_Obj*）cd；
char*subcmd；
subcmd=Tcl_GetString（objv[1]）；
如果（strcmp（subcmd，“name”）==0）
{
Tcl_SetObjResult（interp，rec_name）；
} 
其他的
{
Tcl_Obj*result=Tcl_NewStringObj（“，0）；
Tcl_附录StringsToobj（结果，
“命令错误\”“，
Tcl_GetString（objv[1]），
"\"",
（char*）空）；
Tcl_SetObjResult（interp，result）；
返回TCL_错误；
}
返回TCL_OK；
}
int
Vtcl_Init（Tcl_Interp*Interp）
{
#ifdef使用_TCL_存根
if（Tcl_InitStubs（interp，“8.5”，0）=NULL）{
返回TCL_错误；
}
#恩迪夫
如果（Tcl_PkgProvide（interp，“vtcl”，“0.0.1”）！=Tcl_OK）
返回TCL_错误；
Tcl_CreateNamespace（interp，“vtcl”，（ClientData）NULL，
（Tcl_namespacedeteproc*）NULL）；
Tcl_CreateObjCommand（interp，“：：vtcl:：recordings”，ListRecordingsCmd，
（ClientData）NULL，（Tcl_CmdDeleteProc*）NULL）；
返回TCL_OK；
}

Tcl\u Obj*引用计数的管理看起来绝对正确，但我确实想知道您是否正在释放实际代码中与特定实例相关的所有其他资源。它也可能是完全不同的东西；您的代码不是Tcl中唯一分配内存的东西！此外，Tcl中的默认内存分配器实际上并没有将内存返回到操作系统，而是一直保留到进程结束。弄清楚什么是错的可能很棘手

您可以尝试使用传递给

configure

的

--enable symbols=mem

构建Tcl。这使得Tcl内置了一个额外的命令，允许对内存管理行为进行更广泛的检查（它还做了一些事情，比如确保释放内存后不会写入内存）。默认情况下，它没有启用，因为它对性能有很大的影响，但它可以很好地帮助您跟踪正在发生的事情。（从

内存信息
子命令开始。）

您还可以尝试在构建时将
-DPURIFY
添加到CFLAGS；它完全禁用了Tcl内存分配器（因此，像-commercial-Purify和-OSS-Electric Fence这样的内存检查工具可以获得准确的信息，而不是被Tcl的高性能线程感知分配器弄糊涂）并且可以让您了解发生了什么。
对
Tcl\u Obj*
引用计数的管理看起来绝对正确，但我确实想知道您是否在真正的代码中释放了与特定实例相关的所有其他资源。它也可能是完全不同的东西；您的代码不是Tcl中唯一分配内存的东西！此外，Tcl中的默认内存分配器实际上并没有将内存返回到操作系统，而是一直保留到进程结束。弄清楚什么是错的可能很棘手

您可以尝试使用传递给
configure
的
--enable symbols=mem
构建Tcl。这使得Tcl内置了一个额外的命令，它允许对内存管理行为进行更广泛的检查（它还做了一些事情，比如确保内存是可用的）
Tcl_AppendObjToObj (cmd, Tcl_NewIntObj (obj_id++));

Tcl_Obj *obj = Tcl_NewIntObj (obj_id++);
Tcl_AppendObjToObj (cmd, obj);
Tcl_DecrRefCount(obj);