[Bese-devel] UCW in ACL

[Henrik Hjelte]

On Tue, 2006-12-05 at 09:13 -0500, lists at infoway.net wrote:
> Ok. I just downloaded a fresh ucw-boxset and everything seems to compile
> just fine:

> And this on SLIME:
> 
> Non-structure argument (NIL) passed to ref of structure slot 1
>    [Condition of type SIMPLE-ERROR]

Here we go again, it's an incomplete allegro implementation in bourdeaux
threads which I posted a patch to fix in late september, but I guess it
hasn't been applied yet.

I have attached the darcs patch, or you can replace the allegro.lisp
file in bourdeaux-threads with the one attached here.

Also, I had some problem with admin.lisp in the boxset, I needed to
change swank:create-swank-server to swank:create-server. I will add this
fix to ucw_dev and ucw_ajax so the problem will disappear tomorrow.

Good luck, don't give up...
/Henrik Hjelte

-------------- next part --------------
A non-text attachment was scrubbed...
Name: allegro.patch
Type: text/x-patch
Size: 2611 bytes
Desc: not available
URL: <https://mailman.common-lisp.net/pipermail/bese-devel/attachments/20061206/83b9906c/attachment.bin>
-------------- next part --------------
(in-package #:bordeaux-threads)

;;; documentation on the Allegro Multiprocessing interface can be found at
;;; http://www.franz.com/support/documentation/6.2/doc/multiprocessing.htm

(eval-when (:compile-top-level :load-top-level :execute)
  (require :process))

#+multiprocessing (progn

;;; Thread Creation

(defmethod make-thread (function &key name)
  (mp:process-run-function name function))

(defmethod current-thread ()
  mp:*current-process*)

(defmethod threadp ((object mp:process))
  t)

(defmethod thread-name ((thread mp:process))
  (mp:process-name thread))

;;; Resource contention: locks and recursive locks

(defmethod make-lock (&optional name)
  (mp:make-process-lock :name name))

(defmethod acquire-lock ((lock mp:process-lock) &optional (wait-p t))
  (mp:process-lock lock mp:*current-process* "Lock" (if wait-p nil 0)))

(defmethod release-lock ((lock mp:process-lock))
  (mp:process-unlock lock))

(defmacro with-lock-held ((place) &body body)
  `(mp:with-process-lock (,place :norecursive t)
     , at body))

(defmethod make-recursive-lock (&optional name)
  (mp:make-process-lock :name name))

(defmacro with-recursive-lock-held ((place &key timeout) &body body)
  (if timeout
      `(mp:with-process-lock (,place :timeout ,timeout)
        , at body)
      `(mp:with-process-lock (,place)
        , at body)))

;;; XXX acquire-recursive-lock and release-recursive-lock are actually
;;; complicated because we can't use control stack tricks.  We need to
;;; actually count something to check that the acquire/releases are
;;; balanced

;;; Resource contention: condition variables

(defmethod make-condition-variable ()
  (mp:make-gate nil))

(defmethod condition-wait ((condition-variable vector)
                           (lock mp:process-lock))
  (release-lock lock)
  (mp:process-wait "wait for message"
                   #'mp:gate-open-p
                   condition-variable)
  (acquire-lock lock)
  (mp:close-gate condition-variable))

(defmethod condition-notify ((condition-variable vector))
  (mp:open-gate condition-variable))

(defmethod thread-yield ()
  (mp:process-allow-schedule))

;;; Introspection/debugging

(defmethod all-threads ()
  mp:*all-processes*)

(defmethod interrupt-thread ((thread mp:process) function)
  (mp:process-interrupt thread function))

(defmethod destroy-thread ((thread mp:process))
  (mp:process-kill thread))

(mark-supported)
) ; end PROGN