Memory leak with using signals

[Anand Mohanadoss]

Hi,

We are seeing memory leaks at times when we use signals along with memory allocation.  Appended is a sample program where we are creating random messages and it appears that if a signal is received at the 'appropriate' time, it starts off the memory for the process to start growing uncontrollably.  If we don't do any memory allocations, I am not able to reproduce the problem.  It appears as if sending the signal at the 'appropriate' time somehow stops GC from doing its work.

For the sample program below, I had to do the following a couple of times to cause the memory to grow.

$ for ((n=0;n<50;n++)) do kill -USR1 26824; sleep 1; done

We are using 2.0.11 guile built as a 32-bit application and running on Linux.

The problem doesn't appear to be with format in the signal handler as I can see the memory growth, even if I do a set! in the signal handler instead of using format.

Is this a bug in guile or should we be doing things differently?  If this is a know issue, is there a recommended work around? 

Is this somehow related to the issue with memory leak, I had posted earlier -

http://lists.gnu.org/archive/html/guile-user/2015-02/msg00024.html

Thanks,

Anand

(define (make-generator numSyms)
  (let* ((field_symbols  '()))

     (define (next-msg)
       (let ((msg-body          '())
             (msg-hdr          '())
             (rand-no            (random (1- numSyms)))
             (ret               #f))

        (set! msg-hdr (cons* `(num-fields . ,(1+ rand-no))))

        ;add rand-no + 1 (numSyms) fields to message
        (set! msg-body
          (let fldloop ((i 0))
            (if (> i rand-no)
              msg-body
              (cons `(,(list-ref field_symbols i) . ,(random 10.5)) (fldloop (1+ i)) ))))

        (print-msg `(,msg-hdr . ,msg-body))
        ;return (header body)
        `(,msg-hdr . ,msg-body)

       )
     )

  (set! field_symbols
    (let loop ((i 0))
     (if (>= i numSyms)
          '()
          ;else
          (cons (gensym "FLD") (loop (1+ i))))))

    (format #t "List of fields in messages: ~S\n" field_symbols)

    next-msg
  )
)

(define (print-msg hdr+msg)
 (let ((hdr (car hdr+msg))
       (msg (cdr hdr+msg)))
    (format #t "Header: ~A ; Message: ~A\n" hdr msg)
    msg
 )
)

;Create messages in a loop using generator like code and print/discard them
(define (main args)
    (let* ((generator  (make-generator 15))
          (hdr+msg (generator))
          (num-msgs 0))

          (while hdr+msg
             (print-msg hdr+msg)
             (set! hdr+msg (generator))
          )
    )
)

(define signal-str #f)
(define (usr1-intrpt-handler x)
  (format #t "***************Signal USR1 received\n")
)
(sigaction SIGUSR1 usr1-intrpt-handler)

(define (_main_)
  (let ((cmds   (command-line)))
     (if (member "--debug" cmds)
       (begin
           (use-modules (system repl error-handling))
           (call-with-error-handling
               (lambda()
                   (main (delete "--debug" cmds)))
               #:on-error 'debug)
       )
       ;else
       (main cmds))
  )
)
(_main_)