From: o (Stephan Oepen)

Subject: multiprocessing hangs in 5.0 on Solaris

Date: 1999-1-10 23:18

dear friends,

my application talks to an external process (wish(1) spawned by
run-shell-command()) over a bidirectional stream that is connected to
wish(1) standard in and out.  after creating the external process and
the stream, the application creates an additional Lisp process (by
means of process-run-function()) that read()s and writes (format()) to
the stream.  typically, the Lisp process will block in read() and wake
up when a form becomes available as input on the stream.

now, when inter-process communication is heavy (several interactions
per second, say) over that stream, it can happen that the Lisp process
does not wake up when input becomes available.  if left to its own in
this state, the emacs(1) mode line shows `Idle' for seconds and minutes
at a time, even though there is a form to be processed in the stream.

only when i hit return in the Lisp listener buffer (that is the process
that was used to create both the external wish(1) and the Lisp process
that should read() from the stream), Lisp will wake up and immediately
process the pending input.  apparently, the Lisp-internal scheduler at
times fails to detect the status change on the stream connected to the
wish(1) process and consequently will not run the associated process.

the described problem occurs with Allegro CL Enterprise Edition 5.0
[SPARC] on various machines running either Solaris 2.5.1 or 2.6.

though i have no direct procedure to reproduce the problem, it happens
reliably in regular intervals to several users at various sites.  any
help will be greatly appreciated.

the set-up should be sort of common.  did somebody by chance experience
a similar problem already?  is there anything i could do to the stream
to prevent the process hangs?

                                                   many thanks  -  oe

nb: attached below is an excerpt from the code; you will be unable to
run it because of missing functions, but it should nevertheless clarify
the methods used.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Stephan Oepen --- Kronenstr.2 --- 66111 Saarbruecken --- (+681) - 376 105
;;;    - <coli.uni-sb.de at oe> --- <csli.stanford.edu at oe> (8-jan -- 20-mar-99) -
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


#+:allegro
(eval-when (:load-toplevel :compile-toplevel :execute)
  (require :process))

(defun init-podium ()
  (let (foo)
    (multiple-value-setq (*tsdb-wish-stream* foo *tsdb-wish-pid*)
      (run-process *tsdb-wish-application*
                   :wait nil
                   :output :stream :input :stream :error-output nil))
    (format *tsdb-wish-stream* "source \"~a\"~%" *tsdb-podium*)
    (force-output *tsdb-wish-stream*))
  (setf *tsdb-wish-process*
    (mp:process-run-function (list :name "tsdb(1) podium")
                             #'podium-loop)))

(defun podium-loop ()
  (let ((*package* (find-package "TSDB")))
    (loop
        while (streamp *tsdb-wish-stream*)
        do (process-pending-events)
           (let ((*package* (find-package "TSDB"))
                 (form (read *tsdb-wish-stream* nil nil)))
             (if form
               (evaluate-remote-command form)
               (shutdown-podium))))))

(defun send-to-podium (string &key (wait nil) (quiet nil) recursive)
  (unless recursive
    (when (and *tsdb-wish-process*
               (not (eq mp:*current-process* *tsdb-wish-process*)))
      (mp:process-add-arrest-reason *tsdb-wish-process* :send))
    (format *tsdb-wish-stream* "evaluate {~a} ~d;~%" string (if quiet 1 0))
    (force-output *tsdb-wish-stream*))
  (unwind-protect 
      (when (or wait recursive)
        (let ((*package* (find-package "TSDB"))
              (form (when (streamp *tsdb-wish-stream*)
                      (read *tsdb-wish-stream* nil nil))))
          (cond
           ((eq (first form) :event)
            (snoc form %tsdb-podium-pending-events%)
            (send-to-podium nil :recursive t))
           (t
            form))))
    (when (and *tsdb-wish-process*
               (not (eq mp:*current-process* *tsdb-wish-process*)))
      (mp:process-revoke-arrest-reason *tsdb-wish-process* :send))))