[comp.windows.x] CLX under Franz Allegro CommonLisp 3.0

janssen@titan.SW.MCC.COM (Bill Janssen) (08/29/88)

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
--
 Bill Janssen, MCC Software Technology Program
 3500 W. Balcones Drive, Austin, TX, 78759     (512) 338-3682
 ARPA:  janssen@MCC.COM
 UUCP:  {seismo,harvard,gatech,pyramid}!ut-sally!im4u!milano!janssen

~~~~~~~~~~~~~~~~~~~~~~~~~~~

For those who are interested, here's the code and the error trace:

==============================================================================

(eval-when (LOAD EVAL)
  (require 'process)
  (require 'clx)
  )

(defvar *queue* nil "Queue of X11 events")

(defun event-handler (&rest args)
  (push args *queue*)
  t)
  
(defun show-bug (&optional (HOST "localhost") (DISPLAY-NUM 0))
  (let* ((Display (xlib:open-display HOST :display DISPLAY-NUM))
	 (Listener-Process
	  (mp:process-run-function
	   '(:name "X Listener Process" :priority 9)
	   #'(lambda (DISPLAY)
	       (loop 
		 (mp:process-wait "Waiting for X Event"
				  #'xlib:event-listen DISPLAY 0)
		 (do ((ctr 0 (1+ ctr)))
		     ((not (xlib:event-listen DISPLAY 0)))
		   (if (< ctr 10)
		       (xlib:process-event DISPLAY
					   :handler #'event-handler))
		   ;; have processed enough events - give someone else
		   ;; a chance to run for a while
		   (progn
		     (mp:process-allow-schedule)
		     (setq ctr 0)
		     (xlib:process-event DISPLAY
					 :handler #'event-handler))
		   )
		 ))
	   Display
	   ))
	 (Font (xlib:open-font Display "6x10"))
	 )
    (format t "Opened display ~S~%" Display)
    (format t "Started process ~S~%" Listener-Process)
    (format t "Opened font ~S~%" Font)
    (format t "Sleeping for 10 seconds...~%")
    (sleep 10)
    (format t "About to trap to the scheduler...~%")
    (xlib:font-ascent Font)
    ))

==============================================================================

~ 4 % cl -qq
Allegro CL 3.0 [sun3] (6/15/88 19:23)
Copyright (C) 1985-1988, Franz Inc., Berkeley, CA, USA
<cl> (load "clx-bug.lisp")
; Loading clx-bug.lisp.
; Fast loading /usr/local/lib/cl/3.0/code/process.fasl.
; Fast loading /usr/local/lib/cl/3.0/code/clx.fasl.
; Fast loading /usr/local/lib/cl/3.0/code/foreign.fasl.
; Fast loading /usr/local/lib/cl/3.0/code/mdproc.fasl.
; Fast loading /usr/local/lib/cl/3.0/code/defsys.fasl.
; Foreign loading /usr/local/lib/cl/3.0/code/socket.o.
; Foreign loading /usr/local/lib/cl/3.0/code/excldep.o.

T 
<cl> (show-bug)
Opened display #<DISPLAY localhost 0>
Started process #<process X Listener Process @ #x561b09>
Opened font #s(XLIB:FONT :ID-INTERNAL 8388609 :DISPLAY #<DISPLAY localhost 0> :REFERENCE-COUNT 1 :NAME "6x10" :FONT-INFO-INTERNAL NIL :CHAR-INFOS-INTERNAL NIL :LOCAL-ONLY-P T :PLIST NIL)
Sleeping for 10 seconds...
About to trap to the scheduler...
Error: Illegal vector object passed to svref NIL
[1] <scheduler> :proc
"X Listener Process" is Waiting for X Event.
"Initial Lisp Listener" is blocked on read from X server.
[1] <scheduler> :zoom :verbose t
Evaluation stack:

 ->call to ERROR
REQUIRED arg: EXCL::DATUM = "Illegal vector object passed to svref ~s"
&rest EXCL::ARGUMENTS = (NIL)

   call to SVREF
REQUIRED arg: EXCL::VEC = NIL
REQUIRED arg: EXCL::INDEX = 13

   call to XLIB::WAIT-FOR-EVENT
REQUIRED arg: XLIB:DISPLAY = #<DISPLAY localhost 0>
REQUIRED arg: XLIB::TIMEOUT = 0
REQUIRED arg: XLIB::FORCE-OUTPUT-P = NIL

   call to XLIB:EVENT-LISTEN
REQUIRED arg: XLIB:DISPLAY = #<DISPLAY localhost 0>
OPTIONAL arg: XLIB::TIMEOUT = 0

[1] <scheduler> 

RWS@ZERMATT.LCS.MIT.EDU (Robert Scheifler) (08/29/88)

I have received new CLX bits from Franz, and I'm in
the process of integrating and testing them.  They
will be in R3.

jdi@sparky.UUCP (John Irwin) (08/30/88)

> 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)))))))

janssen@titan.sw.mcc.com (Bill Janssen) (08/31/88)

Thanks for the help.  But about not needing any exclfasl.3.0.uu files...
When I rebuild CLX from the X11R2 sources without "magic bits" I get
the following error, which is why I figured I needed a Franz fasl:

dribbling to file "/working/src/mit-clx/foo"
 
LISP-IMPLEMENTATION-TYPE: Allegro CL
LISP-IMPLEMENTATION-VERSION: 3.0.1 [sun3] (8/15/88 15:18)
MACHINE-TYPE: Sun Microsystems
MACHINE-VERSION: 
SOFTWARE-TYPE: SMI Unix
SOFTWARE-VERSION: 
SHORT-SITE-NAME: foo.sw.mcc.com
*features* is (:MULTIPROCESSING :DELI-SCT :DELI-SOURCE-CONTROL :UNIX :SUN3 :SUN :ALLEGRO :ALLEGRO-V3.0 :COMMON-LISP :EXCL :FRANZ-INC :GSGC)

NIL 
7 <cl> (setq display (xlib:open-display "foo" :display 0))
Error: attempt to call `EXCL::MAKE-BUFFERED-BYTE-STREAM' which is an undefined function.

Restart actions (select using :continue):
 0: prompt for a new function, instead of `EXCL::MAKE-BUFFERED-BYTE-STREAM'.
[1c] 8 <cl> :zoom
Evaluation stack:

 ->(CERROR "prompt for a new function, instead of `~s'." "attempt to call `~s' which is an undefined function." EXCL::MAKE-BUFFERED-BYTE-STREAM)
   (XLIB::OPEN-X-STREAM "foo" 0 NIL)
   (XLIB:OPEN-DISPLAY "foo" :DISPLAY 0)
   (SETQ DISPLAY (XLIB:OPEN-DISPLAY "foo" :DISPLAY 0))
   (EVAL (SETQ DISPLAY (XLIB:OPEN-DISPLAY "foo" :DISPLAY 0)))
   (EXCL::START-REBORN-LISP)
[1c] 9 <cl> (dribble)
-- 

jdi@sparky.UUCP (John Irwin) (09/02/88)

Your message:

    Thanks for the help.  But about not needing any exclfasl.3.0.uu files...
    When I rebuild CLX from the X11R2 sources without "magic bits" I get
    the following error, which is why I figured I needed a Franz fasl:
    ...
--------

Oh yes, there is that little matter. :-)

I had assumed you were using the CLX that was distributed with Allegro CL
3.0.1.  That version is newer than the one available in Release 2 from MIT,
and we recommend using it until Release 3 comes out.  Release 3 of CLX
(octoberish) will be fully up to date and will supersede all other versions.
(For a couple weeks anyway :-)

If you want to use the CLX from X.V11R2 I can send you a newer
version of dependent.cl that will solve your problem.

	-- John Irwin, Franz Inc.

janssen@titan.sw.mcc.com (Bill Janssen) (09/17/88)

Rebuilding from the CLX sources shipped with Allegro 3.0.1 almost works,
but there is still the problem that xlib::*recursive-event-queue* is not
required to be bound, in R2.  So input.l/event-listen should look like
this:

#+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 (and (boundp '*recursive-event-queue*)
		        (*recursive-event-queue*))
		   (display-event-queue display)))
	(*inside-event-listen-catch* t))
    (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)))))))

Then everything works.  I understand all of this is fixed in R3.

Bill

janssen@titan.sw.mcc.com (Bill Janssen) (09/20/88)

Sigh.  That's what I get from typing rather than including...

The parens around *recursive-event-queue* in the (and) should not be there.

Bill