Problems with Select + threads + pipes

[Robert Marlow <bobstopper@australispro.com.au>]

[-- Attachment #1: Type: text/plain, Size: 784 bytes --]

Hi all

I'm really stuck on this problem. I have one thread which listens on a
network socket for content. It uses select so the accept bug doesn't
block all threads. I then have another thread which waits for a message
string and then spits it out to another program via a pipe. The
combination of threads + select + pipes seems to cause problems in my
program.

I can get rid of the problem if I lock the mutex while using the pipe,
however this defeats the purpose of using threads; I don't want the time
consuming piped process wasting time that could be used by other
threads.

I have attached two trimmed-down scripts as an example of my problem.
I'd really, really appreciate it if someone could shed some light on
what the problem is. Thanks.


-- 
Regards,

Robert Marlow




[-- Attachment #2: buggy.scm --]
[-- Type: text/x-scheme, Size: 1721 bytes --]

#!/usr/bin/guile \
-e main -s
!#

(use-modules (ice-9 threads)
	     (ice-9 popen))

(define mutex (make-mutex))
(define message-ready (make-condition-variable))

(define message "")

(define (main args)
  (begin-thread (piper))
  (let ((sock #f)
        (fileno #f))
    (lock-mutex mutex)
    (set! sock (socket AF_INET SOCK_STREAM 0))
    (unlock-mutex mutex)
    (bind sock AF_INET INADDR_ANY 6009)
    (listen sock 5)
    (while
     #t
     (let* ((client-connection (accept/no-block sock))
            (client-details (cdr client-connection))
            (client (car client-connection)))
       (lock-mutex mutex)
       (do ((line (read-line client) (read-line client)))
	   ((eof-object? line)
	    (shutdown client 2))
	 (set! message (string-append message line "\n")))
       (signal-condition-variable message-ready)
       (unlock-mutex mutex)))))


(define (piper)
  (while
   #t
   
   (lock-mutex mutex)
   (if (not (> (string-length message) 0))
       (wait-condition-variable message-ready mutex)
       (let ((outgoing message))
	 (set! message "")
	 (unlock-mutex mutex)  ; Comment this to stop select complaining
	 (let ((pipe (open-output-pipe "./buggy-companion.scm")))
	   (display "Print this\n" pipe)
	   (close-port pipe)))) ; Remove 3 brackets to stop select complaining
;	   (unlock-mutex mutex)))) ; Uncomment this to stop select complaining
   (unlock-mutex mutex)))


(define (accept/no-block s)
  (if (null? (car (select (vector s) '() '()))) ; This select complains
      (accept/no-block s)
      (let ((client #f))
        (lock-mutex mutex)
        (set! client (accept s))
        (unlock-mutex mutex)
        client)))

[-- Attachment #3: buggy-companion.scm --]
[-- Type: text/x-scheme, Size: 242 bytes --]

#!/usr/bin/guile \
-e main -s
!#

(define (main args)
  (let ((str ""))
    (do ((line (read-line) (read-line)))
	((eof-object? line))
      (set! str (string-append str line "\n")))
     (sleep 10)
     (display str)))
	    
    

[-- Attachment #4: Type: text/plain, Size: 139 bytes --]

_______________________________________________
Guile-user mailing list
Guile-user@gnu.org
http://mail.gnu.org/mailman/listinfo/guile-user