trap to debugger when compiling from multiple threads

Eric Marsden <[email protected]> Fri, 01 Aug 2003 13:17:49 +0200
Newsgroups gmane.lisp.openmcl.bugs
Organization LAAS-CNRS http://www.laas.fr/
Message-ID <[email protected]>
Hi,

Loading the following code into OpenMCL causes it to break into the
debugger. I see the same behaviour on Darwin and LinuxPPC, with recent
CVS builds. 

,----
| % $HOME/bin/Darwin/openmcl --batch --load thread-stress.lisp
| Unhandled exception 11 at 0x0100470c, context->regs at #xf01356d8
| Continue/Debugger/eXit <enter>?
| X
| Killed
`----



;;; stress the threading in OpenMCL 0.14

(in-package :cl-user)

#+openmcl-native-threads
(defvar *thread-pool-lock*
  (ccl:make-lock "cl-bench thread pool lock"))

#+openmcl-native-threads
(defvar *thread-pool-semaphore* (ccl:make-semaphore))

#+openmcl-native-threads
(defvar *thread-pool* (list))

#+openmcl-native-threads
(ccl:with-lock-grabbed (*thread-pool-lock*)
  (dotimes (i 5)
    (push (ccl:make-process "cl-bench") *thread-pool*)
    (ccl:signal-semaphore *thread-pool-semaphore*)))

;; run BODY inside a new thread
#+openmcl-native-threads
(defmacro with-spawned-thread (&body body)
  `(let ((thread nil))
     (ccl:wait-on-semaphore *thread-pool-semaphore*)
     (ccl:with-lock-grabbed (*thread-pool-lock*)
        (setq thread (pop *thread-pool*)))
     (format *debug-io* "Acquired process ~A~%" thread)
     (assert (ccl::processp thread))
     (ccl:process-preset thread
       (lambda ()
         ,@body
         (ccl:process-reset ccl:*current-process*)
         (ccl:with-lock-grabbed (*thread-pool-lock*)
            (push ccl:*current-process* *thread-pool*)
            (ccl:signal-semaphore *thread-pool-semaphore*))))
    (ccl:process-enable thread)))



(defun run-1 ()
  (with-spawned-thread (compile nil (lambda (x) (* x 45))))
  (with-spawned-thread (compile nil (lambda (x) (* x 45)))))


(defun run-2 ()
  (dotimes (i 5)
    (with-spawned-thread
        (compile-file "thread-stress" :print t :verbose t
                      :output-file (format nil "/tmp/foo~d" i)))))

(defun run-3 ()
  (with-spawned-thread (compile-file "inexist"))
  (with-spawned-thread (compile-file "inexist-2")))


(run-1)
(run-2)

;; EOF

-- 
Eric Marsden                          <URL:http://www.laas.fr/~emarsden/>