Path: utzoo!attcan!uunet!lll-winken!lll-tis!ames!mailrus!tut.cis.ohio-state.edu!bloom-beacon!sparky.UUCP!jdi
From: jdi@sparky.UUCP (John Irwin)
Newsgroups: comp.windows.x
Subject: Re: CLX under Franz Allegro CommonLisp 3.0
Message-ID: <8808292223.AA01138@sparky>
Date: 29 Aug 88 22:23:09 GMT
References: <1102@titan.SW.MCC.COM>
Sender: daemon@bloom-beacon.MIT.EDU
Organization: The Internet
Lines: 109


> Does anyone have a version of CLX that will work with Franz Allegro CL 3.0?
> The version on the R2 tape only has "exclfasl" for 2.2, and the version
> distributed with Allegro 3.0 seems to have an error in the multi-process
> code.  I'd like to put together a binary that I have the source for so that
> I can track down the error.  Thanks for any help.

> Bill

The X11.R2 version of CLX does work under Allegro 3.0.1.  You don't need any of
the .fasl files that were included in the R2 release; those .fasl files patched
bugs that are not present in 3.0.1.  So just commenting out the line:

(require :clxexcldep "excldep")

should allow CLX to build correctly under 3.0.1.  As Bob Schleiffler mentioned
the CLX that comes out with X11.R3 should work correctly under all supported
versions of Allegro CL (>= 2.0).

Now, regarding the problem you found.  A short explanation of process wait
functions is in order.  When a process calls mp:process-wait, if the wait
function does not immediately return true, the wait function is subsequently
run on the scheduler's stack group at regular intervals or whenever another
process gives up control.  Now, since the wait function is run "inside"
the scheduler, it is not allowed to block, thus it is not allowed to seize
a lock.  In this case you *should* get a nice error message like:

Error: Process wait functions can not call mp:process-lock.

or some such.  Unfortunately you get a cryptic error message instead -- this
will be fixed in our next release.

In CLX there is an input lock associated with each connection to the server --
before a process can read from the server stream it must obtain the lock.
Obviously this won't work if we're inside event-listen in a process wait
function.  But wait -- there is a solution.  Below I've included new
holding-lock and event-listen functions to solve your problem.  (RWS -- can
you integrate these into your sources?)

What now happens is the following.  If we are executing a wait-for-event
inside the scheduler (which only happens inside process wait functions) and
the input lock is *not* held by another process, don't bother to lock the
input lock when reading from the server stream.  This is safe since no other
process can run until the wait function terminates.  However, if the input
lock *is* held by another process (like in your example where the:

(xlib:font-ascent Font)

is holding the lock) then we throw out of the wait-for-event without reading
from the socket.  Thus event-listen returns nil.  Note that this means
that the process-wait function will never return if the other process never
gives up the input lock.  

Please let us know if you have any problems with this code or further
difficulties with our Lisp.  Also, you will need to recompile most of the CLX
source files since holding-lock is a macro.

	-- John Irwin, Franz Inc.
	   jdi%franz.UUCP@ucbarpa.Berkeley.EDU


---------- Cut here ----------

#+excl
;;
;; Note that there is a special hack here.  If the current process is nil it
;; means we're running in the scheduler stack group, which means in turn that
;; we're running a process wait function.  This wait functions should *always*
;; be: (event-listen display 0).  So if we are running in the scheduler and the
;; lock isn't already being held just run the body without trying to grab the
;; lock.  If the lock *is* already being held we have to throw out of the
;; event-listen.
;;
(defmacro holding-lock ((locator &optional whostate) &body body)
  ;; This macro is for use in a multi-process environment.
  (let ((lock (gensym)) (curproc (gensym)) (locker (gensym)))
    `(let* ((,lock ,locator)
	    (,curproc mp:*current-process*) ; nil if in scheduler (wait fun)
	    (,locker (mp:process-lock-locker ,lock)))
       
       (unwind-protect
	    (progn 
	      (if (and (null ,curproc) ,locker)
		  (if (member 'event-listen (excl::all-catch-tags) :test #'eq)
		      (throw 'event-listen :would-block)
		    (error "The only CLX function call allowed from a process wait function is \
       event-listen with timeout 0.")))
	      (unless (eql ,locker ,curproc)
		(mp:process-lock ,lock ,curproc
				 ,@(when whostate `(,whostate))))
	      ,@body)
	 (if (and ,curproc (eql (mp:process-lock-locker ,lock) ,curproc))
	     (mp:process-unlock ,lock ,curproc))))))

#+excl
(defun event-listen (display &optional (timeout 0))
  (declare (type display display)
	   (type (or null number) timeout))
  ;; Returns the number of events queued locally, if any, else nil.  Hangs
  ;; waiting for events, forever if timeout is nil, else for the specified
  ;; number of seconds.  However, if we are running a process wait function
  ;; (in the scheduler stack group) and the input lock is held by another
  ;; process, return nil.
  (let ((queue (or *recursive-event-queue*
		   (display-event-queue display))))
    (if (cdr queue)
	(length (cdr queue))
      (unless (eq :would-block
		  (catch 'event-listen (wait-for-event display timeout nil)))
	(and (cdr queue) (length (cdr queue)))))))