how to find memory leak in Tcl/Tk?

0
votes

a Tcl/Tk (8.6.11) program of mine crashes with the following error:

max size for a Tcl value (2147483647 bytes) exceeded

the tcl/tk program does about the following:

  1. open a TCP/IP socket

    proc ::application::create_socket {} {
 variable my_socket
 if {[catch {set my_socket [socket -server ::application::configure_socket -myaddr localhost 0]}]} {
     puts stderr "ERROR: failed to allocate port, exiting!"
     exit 3
 }
 return [lindex [fconfigure $sock -sockname] 2]
}
proc ::application::configure_socket {sock client_addr client_port} {
 fconfigure $sock -blocking 0 -buffering none -encoding utf-8;
 fileevent $sock readable {::application::readsocket}
}

  2. read the strings received via the socket

  3. evaluate the string as a Tcl/Tk command:

    proc ::application::readsocket {} {
  variable my_socket
  variable rcvd_cmds
  if {[eof $my_socket]} {
      close $my_socket
      exit
  } 
  append rcvd_cmds [read $my_socket]
  if {[string index $rcvd_cmds end] ne "\n" || \
          ![info complete $rcvd_cmds]} {
      # the block is incomplete, wait for the next block of data
      return
  } else {
      set docmds $rcvd_cmds
      set rcvd_cmds ""
      if {![catch {uplevel #0 $docmds} errorname]} {
      } else {
          # oops, error, alert the user:
          global errorInfo
          ::application::fatal "oops: $errInfo\n"
      }
  }
}

  4. the string that is received is something like (with \n being replaced by proper newlines)

    ::application::post {====================: 34124 hello world\n}\n

    and the ::application::post procedure is empty:

    proc ::application::post {message} {}

  5. if i send a few commands (like ::application::post {====================: %d\n}\n) from my control application, everything works as expected.

  6. however, if i send a very large number of commands in a short time (e.g. driving the above command from an "infinite counter") Tcl/Tk application will eventually crash.

running the tcl/tk script through gdb, i get a backtrace that doesn't tell me anything:

(gdb) run
Starting program: /usr/bin/wish8.6 application.tcl
[Thread debugging using libthread_db enabled]
Using host libthread_db library "/lib/x86_64-linux-gnu/libthread_db.so.1".
[New Thread 0x7ffff67e9700 (LWP 1445236)]
[Detaching after fork from child process 1445237]
input channels = 0, output channels = 0
app output pipe: Connection reset by peer
max size for a Tcl value (2147483647 bytes) exceeded

Thread 1 "wish8.6" received signal SIGABRT, Aborted.
__GI_raise (sig=sig@entry=6) at ../sysdeps/unix/sysv/linux/raise.c:50
50  ../sysdeps/unix/sysv/linux/raise.c: No such file or directory.
(gdb) bt
#0  __GI_raise (sig=sig@entry=6) at ../sysdeps/unix/sysv/linux/raise.c:50
#1  0x00007ffff7aaf537 in __GI_abort () at abort.c:79
#2  0x00007ffff7d60690 in Tcl_PanicVA (format=<optimized out>, argList=argList@entry=0x7fffffffd700) at ./generic/tclPanic.c:123
#3  0x00007ffff7d60759 in Tcl_Panic (format=format@entry=0x7ffff7dbec30 "max size for a Tcl value (%d bytes) exceeded") at ./generic/tclPanic.c:160
#4  0x00007ffff7d77c41 in AppendUtfToUtfRep (objPtr=objPtr@entry=0x555555cacaf0, 
    bytes=0x7ffef58ca020 "::application::post {1.04045e+07}\n::application::post { }\n::application::post {hello}\n::application::post { }\n::application::post {world}\n::application::post {\n}\n::application::post {", '=' <repeats 20 times>, ": }\n::pdwindow::po"..., numBytes=2147450230) at ./generic/tclStringObj.c:1727
#5  0x00007ffff7d74d2b in AppendUtfToUtfRep (numBytes=<optimized out>, bytes=<optimized out>, objPtr=0x555555cacaf0) at ./generic/tclStringObj.c:1394
#6  Tcl_AppendObjToObj (objPtr=0x555555cacaf0, appendObjPtr=appendObjPtr@entry=0x555555cacdf0) at ./generic/tclStringObj.c:1509
#7  0x00007ffff7d8beab in TclPtrSetVarIdx (interp=interp@entry=0x555555574990, varPtr=0x55555564d3e0, arrayPtr=0x0, part1Ptr=part1Ptr@entry=0x0, part2Ptr=<optimized out>, 
    newValuePtr=0x555555cacdf0, flags=516, index=1) at ./generic/tclVar.c:1976
#8  0x00007ffff7d1e196 in TEBCresume (data=0x555555cad008, interp=<optimized out>, result=0) at ./generic/tclExecute.c:3629
#9  0x00007ffff7c914a2 in TclNRRunCallbacks (interp=interp@entry=0x555555574990, result=0, rootPtr=0x0) at ./generic/tclBasic.c:4493
#10 0x00007ffff7c933de in TclEvalObjEx (interp=interp@entry=0x555555574990, objPtr=<optimized out>, flags=flags@entry=131072, invoker=invoker@entry=0x0, word=word@entry=0)
    at ./generic/tclBasic.c:6059
#11 0x00007ffff7c933aa in Tcl_EvalObjEx (interp=interp@entry=0x555555574990, objPtr=<optimized out>, flags=flags@entry=131072) at ./generic/tclBasic.c:6040
#12 0x00007ffff7d40203 in TclChannelEventScriptInvoker (clientData=0x5555558a8740, mask=2) at ./generic/tclIO.c:8945
#13 0x00007ffff7d3fc3b in Tcl_NotifyChannel (channel=0x555555949770, mask=2) at ./generic/tclIO.c:8426
#14 0x00007ffff7da1d0e in FileHandlerEventProc (flags=-3, evPtr=0x555555d21e80) at ./unix/tclUnixNotfy.c:808
#15 FileHandlerEventProc (evPtr=evPtr@entry=0x555555d21e80, flags=flags@entry=-3) at ./unix/tclUnixNotfy.c:764
#16 0x00007ffff7d5c8f9 in Tcl_ServiceEvent (flags=flags@entry=-3) at ./generic/tclNotify.c:670
#17 0x00007ffff7d5cc09 in Tcl_DoOneEvent (flags=-3) at ./generic/tclNotify.c:967
#18 0x00007ffff7e608b2 in Tk_MainLoop () at ./unix/../generic/tkEvent.c:2109
#19 0x00007ffff7e6f8d0 in Tk_MainEx (argc=<optimized out>, argv=0x7fffffffe008, appInitProc=0x5555555551e0, interp=0x555555574990) at ./unix/../generic/tkMain.c:377
#20 0x00005555555550df in ?? ()
#21 0x00007ffff7ab0d0a in __libc_start_main (main=0x5555555550b0, argc=2, argv=0x7fffffffdff8, init=<optimized out>, fini=<optimized out>, rtld_fini=<optimized out>, 
    stack_end=0x7fffffffdfe8) at ../csu/libc-start.c:308
#22 0x000055555555511a in _start ()

now i have a suspicion that something goes wrong in append rcvd_cmds [read $my_socket] of the ::application::readsocket proc.

is there a way to introspect a given variable in Tcl/Tk to see how much memory it is consuming?

apart from that: are there any obvious memleaks in the Tcl/Tk code?

1
debuggingmemory-leakstcl
It's probably the rcvd_cmds variable; that's the only place you're accumulating in the code you've showed. - Donal Fellows
yes, i tend to agree. after writing the Q and going to sleep, i realized that when doing the loop in tcl, it is much slower than when doing it from my external C-program (which generates the tcl-commands and send them via TCP/IP). so most likely the Tcl/Tk program just cannot keep up with evaluating the code received, and thus the rcvd_commands variable just doesn't get emptied in time. - umläute

1 Answers

0
votes

You can see from the stack trace that it is doing an append (AppendUtfToUtfRep fails; the name is suggestive) and you only have one place where you're doing that. The immediate problem is that you're accumulating too much in that one variable. But why? Fortunately in this case we can take a good guess why.

You appear to be not detecting the end of each command and are consequently never sending them into the evaluation path and clearing down the accumulation variable. Because your blocks are basically line-oriented, you should use gets instead of read. You should also do little things like tracking how much data you have accumulated to ensure that you don't build up too much in one go. The chan pending command helps a lot with this.

proc ::application::readsocket {} {
    variable my_socket
    variable rcvd_cmds
    set MAX_LENGTH 1000000

    # Consume whole lines out of the received message
    while {[gets $my_socket line] >= 0} {
        append rcvd_cmds $line "\n"
        if {[info complete $rcvd_cmds]} {
            try {
                uplevel #0 $rcvd_cmds
            } on error {} {
                # oops, error, alert the user:
                ::application::fatal "oops: $::errorInfo\n"
            } finally {
                set rcvd_cmds ""
            }
        } elseif {[string length $rcvd_cmds] > $MAX_LENGTH} {
            # Too much in one command!
            close $my_socket
            exit
        }
    }

    # No whole lines remain; can be for several reasons:
    #   * Simple end of message (normal case!)
    #   * Socket closed
    #   * Data there not finished by newline; check for over-length in this case
    if {[chan eof $my_socket]} {
        close $my_socket
        exit
    } elseif {[chan blocked $my_socket]} {
        if {[chan pending input $my_socket] > $MAX_LENGTH} {
            # Too much in one line!
            close $my_socket
            exit
        }
    }
}

You probably want to consider running those commands in a child interpreter where you have removed the update and vwait commands.