[Openmcl-devel] FUNCALL-IN-THREAD how to call a function in a different thread
David L. Rager
ragerdl at cs.utexas.edu
Tue Jul 12 08:37:01 PDT 2011
Hi Alex,
I didn't read all of the code, so I'll abstain from making a detailed
analysis. But, I did read your high level description, so, here are
two ideas that I've found useful in my own work. The second idea
might be original, although it's hard to imagine that I'm really the
first one to think of it.
(1) Limit the number of active threads to a factor of the number of
CPU cores in your system. E.g., iIf you have 8 hyper-threaded CPU
cores, try 16 active threads. I define an active thread to be one not
blocked on a semaphore -- that's actually executing the funcall. I
don't know what a thread blocking on a spin-lock would be considered.
(2) Instead of performing a lock every time you need to enqueue a
funcall, have an array, let the enqueue'ing thread
atomically-increment an index (just a global variable), and then let
the enqueue'ing thread save the funcall to that index. Limit the size
of the array to something reasonable (maybe 100,000 - 1,000,000
slots), and clear out the used slot after the associated funcall is
finished. Also use another global variable to represent the index for
dequeue'ing. So, each consumer thread will atomically decrement the
second index to get its funcall from the array. When the array
overflows, don't reset the index. Instead, perform some modulo
arithmetic. I forget why resetting doesn't work. As an example
implementation of this idea, see *last-slot-saved* and
*last-slot-taken* in
http://www.cs.utexas.edu/users/moore/acl2/v4-3/distrib/acl2-sources/futures-raw.lisp
David
On Tue, Jul 12, 2011 at 10:14 AM, Alexander Repenning
<ralex at cs.colorado.edu> wrote:
> Does somebody have some good code to funcall a function in a different
> thread? Here is an attempt that kind of works using a semaphore and a queue.
> That other tread should get started if it does not exist but it should not
> burn any cpu after the function is called. Especially when piping high
> frequency gui events (e.g., mouse moved) through this it is simple to
> overrun the buffer which can be really bad (e.g., missing a mouse up of a
> drag and drop).
>
>
> (in-package :xlui)
>
> (defclass THREAD-INTERFACE ()
> ((function-queue :accessor function-queue :initform (make-instance 'queue
> :size 100))
> (semaphore :accessor semaphore :initform (ccl::make-semaphore))
> (process :accessor process :initform nil :initarg :process)))
>
> (defvar *Thread-Interfaces* (make-hash-table :test 'equal))
>
> (defun FUNCALL-IN-THREAD (Thread-Name Function)
> (let ((Interface (or (gethash Thread-Name *Thread-Interfaces*)
> (setf (gethash Thread-Name *Thread-Interfaces*)
> (make-instance 'thread-interface)))))
> ;; start process if needed
> (unless (process Interface)
> (setf (process Interface)
> (ccl::process-run-function
> Thread-Name
> #'(lambda ()
> (loop
> (ccl::wait-on-semaphore (semaphore Interface))
> (let ((User-Action (dequeue (function-queue Interface))))
> (when User-Action
> (funcall User-Action))))))))
> ;; push function into queue and wake up thread
> (enqueue (function-queue Interface) Function)
> (ccl::signal-semaphore (semaphore Interface))))
>
>
> #| Examples:
>
> (funcall-in-thread "User Action" #'(lambda () (print
> ccl::*current-process*)))
> (funcall-in-thread "Service 2" #'(lambda () (print ccl::*current-process*)))
>
> |#
>
> ;;;; ========== in case you want to run this, here is the queue.lisp file
> ======
>
> ;;-*- Mode: Lisp; Package: xlui -*-
> ;*********************************************************************
> ;* *
> ;* Q U E U E *
> ;* *
> ;*********************************************************************
> ;* Author : Alexander Repenning (alexander at agentsheets.com) *
> ;* http://www.agentsheets.com *
> ;* Copyright : (c) 1996-2011, AgentSheets Inc. *
> ;* Filename : queue.lisp *
> ;* Updated : 02/16/06 *
> ;* Version : *
> ;* 1.0 : 02/16/06 *
> ;* HW/SW : G4, OS X 10.4.4, MCL 5 *
> ;* Abstract : A generic, static (no GC) queue *
> ;* Portable : white: plain Common Lisp *
> ;* *
> ;******************************************************************
> (in-package :xlui)
>
> (defclass QUEUE ()
> ((items :accessor items :initform nil :documentation "array of item")
> (size :accessor size :initform 50 :initarg :size :documentation "static
> allocation size for no GC queue")
> (thread-safe-p :accessor thread-safe-p :initform nil :initarg
> :thread-safe-p :documentation "If true uses a lock to make the queue thread
> safe")
> (queue-lock :accessor queue-lock :initform nil)
> (in :accessor in :initform 0)
> (out :accessor out :initform 0))
> (:documentation "static queue with no GC: good for things such as event
> queues"))
>
> (defclass NAMED-QUEUE-ITEM ()
> ((name :accessor name :initarg :name :type symbol :documentation "unique
> name of queue item")
> (value :accessor value :initarg :value :documentation "the actual item"))
> (:documentation "queue item with a name"))
> ;_____________________________________
> ; Specification |
> ;_____________________________________
>
> (defgeneric ENQUEUE (Queue Item &key Unique-Name)
> (:documentation "Put <Item> into <Queue>.
> Items with a <Unique-Name> will overwrite previous items in queue with same
> name."))
>
> (defgeneric DEQUEUE (Queue)
> (:documentation "Get <Item> from <Queue>"))
>
> (defgeneric IS-EMPTY (Queue)
> (:documentation "true if there are no items left in queue"))
>
> (defgeneric QUEUE-IS-FULL-HANDLER (Queue)
> (:documentation "called when queue got filled up. Default action is to do
> nothing"))
> ;_____________________________________
> ; Implementation |
> ;_____________________________________
>
> (defmethod INITIALIZE-INSTANCE :after ((Self queue) &rest Initargs)
> (declare (ignore Initargs))
> (incf (size Self)) ;; need one more space to be able to differntiate
> between full and empty
> (setf (items Self) (make-array (size Self)))
> ;; dead with thread safety
> (when (thread-safe-p Self)
> (setf (queue-lock Self) (ccl::make-lock "Queue Lock"))))
>
> (defmethod GRAB-LOCK-IF-NECESSARY ((Self queue))
> (when (queue-lock Self) (ccl::grab-lock (queue-lock Self))))
>
> (defmethod RELEASE-LOCK-IF-NECESSARY ((Self queue))
> (when (queue-lock Self) (ccl::release-lock (queue-lock Self))))
>
> (defmethod IS-EMPTY ((Self queue))
> (grab-lock-if-necessary Self)
> (unwind-protect
> (= (in Self) (out Self))
> (release-lock-if-necessary Self)))
>
> (defmethod UNPROTECTED-ENQUEUE ((Self queue) Item)
> (cond
> ((= (out Self) (mod (1+ (in Self)) (size Self)))
> (queue-is-full-handler Self))
> (t
> (setf (aref (items Self) (in Self)) Item)
> (setf (in Self) (mod (1+ (in Self)) (size Self))))))
>
> (defmethod ENQUEUE ((Self queue) Item &key Unique-Name)
> (grab-lock-if-necessary Self)
> (unwind-protect
> (cond
> (Unique-Name
> (let ((Existing-Item (find Unique-Name (items Self) :key #'(lambda
> (x) (typecase x (named-queue-item (name x)) (t nil))))))
> (if Existing-Item
> (setf (value Existing-Item) Item)
> (unprotected-enqueue Self (make-instance 'named-queue-item :name
> Unique-Name :value Item)))))
> (t
> (unprotected-enqueue Self Item)))
> (release-lock-if-necessary Self)))
>
> (defmethod DEQUEUE ((Self queue))
> (grab-lock-if-necessary Self)
> (unwind-protect
> (unless (is-empty Self)
> (prog1
> (let ((Item (aref (Items Self) (out Self))))
> (typecase Item
> (named-queue-item
> (setf (aref (Items Self) (out Self)) nil) ;; need to get
> rid of the named items, otherwise enque will find it
> (value Item))
> (t Item)))
> (setf (out Self) (mod (1+ (out Self)) (size Self)))))
> (release-lock-if-necessary Self)))
>
> (defmethod QUEUE-IS-FULL-HANDLER ((Self queue))
> (warn "queue is full"))
>
>
> #| Examples:
>
> (defparameter *Queue* (make-instance 'queue :size 4))
> (enqueue *Queue* (random 100))
> (dequeue *Queue*)
> (is-empty *Queue*)
>
> (defparameter *Queue* (make-instance 'queue :size 4 :thread-safe-p t))
> (defparameter *Queue* (make-instance 'queue :size 10))
> (enqueue *Queue* (print (random 100)) :unique-name :secret-code)
> (dequeue *Queue*)
>
>
>
>
>
> |#
>
> Prof. Alexander Repenning
>
> University of Colorado
>
> Computer Science Department
>
> Boulder, CO 80309-430
>
> vCard: http://www.cs.colorado.edu/~ralex/AlexanderRepenning.vcf
>
>
> _______________________________________________
> Openmcl-devel mailing list
> Openmcl-devel at clozure.com
> http://clozure.com/mailman/listinfo/openmcl-devel
>
>
More information about the Openmcl-devel
mailing list