Initial import.

vy · Apr 30, 2009 · 6f662d3 · 6f662d3
commit 6f662d3
Show file tree

Hide file tree

Showing 14 changed files with 1,432 additions and 0 deletions.
diff --git a/LICENSE b/LICENSE
@@ -0,0 +1,23 @@
+Copyright (c) 2009, Volkan YAZICI <volkan.yazici@gmail.com>
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without modification,
+are permitted provided that the following conditions are met:
+
+- Redistributions of  source code must  retain the above copyright  notice, this
+  list of conditions and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright notice, this
+  list of  conditions and the  following disclaimer in the  documentation and/or
+  other materials provided with the distribution.
+
+THIS SOFTWARE IS PROVIDED BY THE  COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
+ANY EXPRESS  OR IMPLIED WARRANTIES, INCLUDING,  BUT NOT LIMITED  TO, THE IMPLIED
+WARRANTIES  OF  MERCHANTABILITY  AND   FITNESS  FOR  A  PARTICULAR  PURPOSE  ARE
+DISCLAIMED. IN NO EVENT SHALL THE  COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT,  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,  OR CONSEQUENTIAL DAMAGES
+(INCLUDING, BUT  NOT LIMITED  TO, PROCUREMENT OF  SUBSTITUTE GOODS  OR SERVICES;
+LOSS OF USE,  DATA, OR PROFITS; OR BUSINESS INTERRUPTION)  HOWEVER CAUSED AND ON
+ANY  THEORY  OF  LIABILITY,  WHETHER  IN CONTRACT,  STRICT  LIABILITY,  OR  TORT
+(INCLUDING NEGLIGENCE  OR OTHERWISE) ARISING IN ANY  WAY OUT OF THE  USE OF THIS
+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/README b/README
@@ -0,0 +1,191 @@
+
+                     ____   ____ ______ ____   ___  ____
+              !!  ! |    \ /    |      T    \ /   \|    \  !!!!
+              !!!   |  o  Y  o  |      |  D  Y     Y  _  l  ! !!!
+              !!!!  |   _/|     l_   __j     |  O  |  |  |   !!!!
+              !!:   |  |  |  _  | |  | |    \|     |  |  |  !: :!
+              :!:   |  |  |  |  | |  | |  .  l     !  |  |   : ::
+               ::   l__j  l__j__j l__j l__j\_j\___/l__j__j   :  :
+
+
+--- '( A B S T R A C T ) -------------------------------------------------------
+
+Patron  is a  multi-consumer/multi-producer  thread pooling  library written  in
+Common  Lisp with  flexibility  and performance  in  mind. You  simply create  a
+`PATRON' with  a job  queue of fixed  size, specify  a fixed number  of `WORKER'
+threads and start submitting your `JOB's into the work queue.
+
+While  Patron is  written  in portable  Common  Lisp in  mind,  because of  some
+platform specific  features[1] used,  it currently works  on SBCL[2]  and CCL[3]
+platforms.  As a  side  note, Patron  currently  depends on  bordeaux-threads[4]
+library for common threading functionalities.
+
+
+[1] Semaphores, missing threading features (`THREAD-JOIN', `WITHOUT-INTERRUPTS',
+    etc.) in bordeaux-threads, `WITH-TIMEOUT' macro.
+
+[2] Steel Bank Common Lisp (http://www.sbcl.org/)
+
+[3] Clozure Common Lisp (http://openmcl.clozure.com/)
+
+[4] http://common-lisp.net/project/bordeaux-threads/
+
+
+--- '( E X A M P L E ) ---------------------------------------------------------
+
+Below  basic example should  get you  to a  point where  you can  start creating
+threading pools in minutes.
+
+(defvar *stream* *standard-output*)
+
+(defvar *stream-lock* (bt:make-lock))
+
+(defun safe-format (fmt &rest args)
+  (bt:with-lock-held (*stream-lock*)
+    (apply #'format *stream* fmt args)))
+
+(defun thread-stats (patron)
+  (safe-format
+   "Keepers: ~{~A~^ ~}~%Workers: ~{~A~^ ~}~%"
+   (map 'list #'patron::thread-alive-p (patron::keepers-of patron))
+   (map 'list #'patron::thread-alive-p (patron::workers-of patron))))
+
+(defun job ()
+  (let ((duration (random 5)))
+    (safe-format "  ~S => Sleeping... [~A]~%" (bt:current-thread) duration)
+    (sleep duration)
+    (safe-format "  ~S => Done!~%" (bt:current-thread))))
+
+(defun report-result (job)
+  (safe-format "RESULT: JOB: ~S~%" job))
+
+(defun patron-test ()
+  (let* ((patron
+          (make-instance
+           'patron:patron
+           :worker-capacity 3
+           :job-capacity 32
+           :worker-timeout-duration 3)))
+    (safe-format "Starting...~%")
+    (patron:start-patron patron)
+    (sleep 1.0)
+    (thread-stats patron)
+    (safe-format "Submitting jobs...~%")
+    (loop repeat 5
+          do (patron:submit-job
+              patron
+              (make-instance
+                   'patron:job
+                   :function #'job
+                   :result-report-function #'report-result)))
+    (safe-format "Submitted.~%")
+    (safe-format "Stopping...~%")
+    (patron:stop-patron patron :wait t)
+    (safe-format "Stopped.~%")
+    (thread-stats patron)))
+; Starting...
+; Keepers: T T
+; Workers: T T T
+; Submitting jobs...
+; Submitted.
+; Stopping...
+;   #<SB-THREAD:THREAD "Anonymous" RUNNING {1003A009A1}> => Sleeping... [1]
+;   #<SB-THREAD:THREAD "Anonymous" RUNNING {1003A00BF1}> => Sleeping... [2]
+;   #<SB-THREAD:THREAD "Anonymous" RUNNING {1003A00E41}> => Sleeping... [0]
+;   #<SB-THREAD:THREAD "Anonymous" RUNNING {1003A00E41}> => Done!
+; RESULT: JOB: #<PATRON:JOB :FUNCTION #<FUNCTION TEST::JOB> :START-TIME "2009-04-30 09:07:34" :FINISH-TIME "2009-04-30 09:07:34" {1003E0F2B1}>
+;   #<SB-THREAD:THREAD "Anonymous" RUNNING {1003A00E41}> => Sleeping... [2]
+;   #<SB-THREAD:THREAD "Anonymous" RUNNING {1003A009A1}> => Done!
+; RESULT: JOB: #<PATRON:JOB :FUNCTION #<FUNCTION TEST::JOB> :START-TIME "2009-04-30 09:07:34" :FINISH-TIME "2009-04-30 09:07:35" {1003E0D3C1}>
+;   #<SB-THREAD:THREAD "Anonymous" RUNNING {1003A009A1}> => Sleeping... [2]
+;   #<SB-THREAD:THREAD "Anonymous" RUNNING {1003A00BF1}> => Done!
+; RESULT: JOB: #<PATRON:JOB :FUNCTION #<FUNCTION TEST::JOB> :START-TIME "2009-04-30 09:07:34" :FINISH-TIME "2009-04-30 09:07:36" {1003E0EF71}>
+;   #<SB-THREAD:THREAD "Anonymous" RUNNING {1003A00E41}> => Done!
+; RESULT: JOB: #<PATRON:JOB :FUNCTION #<FUNCTION TEST::JOB> :START-TIME "2009-04-30 09:07:34" :FINISH-TIME "2009-04-30 09:07:36" {1003E0F5E1}>
+;   #<SB-THREAD:THREAD "Anonymous" RUNNING {1003A009A1}> => Done!
+; RESULT: JOB: #<PATRON:JOB :FUNCTION #<FUNCTION TEST::JOB> :START-TIME "2009-04-30 09:07:35" :FINISH-TIME "2009-04-30 09:07:37" {1003E0F911}>
+; Stopped.
+; Keepers: NIL NIL
+; Workers: NIL NIL NIL
+
+
+--- '( D O C U M E N T A T I O N ) ---------------------------------------------
+
+Before going  into the syntatical  details, here is  a general figure  about the
+inner workings of Patron.
+
+- Queue operations take action in a blocking manner and are wrapped by
+  `WITH-TIMEOUT' statements.
+
+- There are no busy waits, synchronized access is supplied using semaphores.
+
+- Using a two-lock concurrent queue algorithm, consumer and producer lockings
+  are separated from each other for performance purposes .
+
+- There are two keeper threads where each keeper is ensuring its partners
+  existence and first (master) keeper ensuring the existence of specified number
+  of worker threads.
+
+While  Patron   source  code  is   fully  documented,  below  you'll   find  the
+documentation excerpts from the source code for exported symbols.
+
+
+[Condition] timeout-condition (error-condition)
+
+  [Slot] time - Time condition instance is created.
+  [Slot] duration - Elapsed duration before condition is raised.
+
+  Condition  thrown  when  the  duration  specified  in  the  `WITH-TIMEOUT'  is
+  exceeded. (`TIME' slot is inherited from `ERROR-CONDITION'.)
+
+
+[Function] default-error-report (condition)
+
+  Default function for reporting errors.
+
+
+[Class] job ()
+
+  [Slot] function - Function will be called to start the execution.
+  [Slot] result-report-function - Function will be called to report the result.
+  [Slot] error-report-function - Function will be called to report an error.
+  [Slot] submit-time - Job queue entrance time.
+  [Slot] start-time - Job execution start time.
+  [Slot] finish-time - Job execution finish time.
+  [Slot] condition - Signaled condition in case of a failure.
+  [Slot] result - Job result in case of no failure.
+
+
+[Class] patron ()
+
+  [Slot] error-report-function - Will get called for management related
+         errors -- e.g when found a dead worker, keeper, etc.
+  [Slot] job-capacity - Upper limit on the job queue size.
+  [Slot] worker-capacity - Number of serving `WORKER's.
+  [Slot] worker-timeout-duration - Time limit on the work processing duration.
+  [Slot] keeper-timeout-duration - Wait period for keepers.
+
+
+[Function] submit-job (patron job)
+
+  Submit given `JOB' into the job queue of `PATRON'. Function works in a
+  blocking manner and returns inserted `JOB', or throws a `TIMEOUT-CONDITION'.
+
+
+[Function] worker-stats (patron)
+
+  Returns a property list of minimum, maximum, and average statistics of
+  `N-FAILURES', `FAIL-DURATION', `BUSY-DURATION', and `IDLE-DURATION' slots
+  among workers. Function blocks job queue while gathering statistics.
+
+
+[Function] start-patron (patron)
+  After switching `STATE' to `:ACTIVE', starts `WORKERS's and `KEEPER's in
+  order.
+
+
+[Function] stop-patron (patron &key wait kill)
+
+  After switching `STATE' to `:INACTIVE', stops `KEEPER's and `WORKER's in
+  order. For related effects of keyword arguments see documentation of
+  `STOP-KEEPERS' and `STOP-WORKERS' functions.
diff --git a/patron.asd b/patron.asd
@@ -0,0 +1,56 @@
+;;; Copyright (c) 2009, Volkan YAZICI <volkan.yazici@gmail.com>
+;;; All rights reserved.
+
+;;; Redistribution  and  use  in  source  and  binary  forms,  with  or  without
+;;; modification, are permitted provided that the following conditions are met:
+
+;;; - Redistributions  of source code  must retain  the above  copyright notice,
+;;;   this list of conditions and the following disclaimer.
+
+;;; - Redistributions in binary form  must reproduce the above copyright notice,
+;;;   this list of conditions and  the following disclaimer in the documentation
+;;;   and/or other materials provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY  THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+;;; AND ANY  EXPRESS OR IMPLIED WARRANTIES,  INCLUDING, BUT NOT  LIMITED TO, THE
+;;; IMPLIED WARRANTIES  OF MERCHANTABILITY AND FITNESS FOR  A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO  EVENT SHALL THE  COPYRIGHT OWNER OR  CONTRIBUTORS BE
+;;; LIABLE  FOR  ANY  DIRECT,   INDIRECT,  INCIDENTAL,  SPECIAL,  EXEMPLARY,  OR
+;;; CONSEQUENTIAL  DAMAGES  (INCLUDING,  BUT  NOT  LIMITED  TO,  PROCUREMENT  OF
+;;; SUBSTITUTE GOODS  OR SERVICES;  LOSS OF USE,  DATA, OR PROFITS;  OR BUSINESS
+;;; INTERRUPTION)  HOWEVER CAUSED  AND ON  ANY THEORY  OF LIABILITY,  WHETHER IN
+;;; CONTRACT,  STRICT LIABILITY,  OR  TORT (INCLUDING  NEGLIGENCE OR  OTHERWISE)
+;;; ARISING IN ANY WAY  OUT OF THE USE OF THIS SOFTWARE,  EVEN IF ADVISED OF THE
+;;; POSSIBILITY OF SUCH DAMAGE.
+
+
+(in-package :cl-user)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Patron System Definitions
+;;;
+
+(defpackage :patron-system (:use :cl :asdf))
+
+(in-package :patron-system)
+
+(defsystem :patron
+  :author "Volkan YAZICI <volkan.yazici@gmail.com>"
+  :licence "BSD"
+  :description "A compact thread pool implementation."
+  :depends-on (:bordeaux-threads)
+  :components ((:module "src"
+                :serial t
+                :components ((:file "packages")
+                             (:file "specials")
+                             (:file "utils")
+                             (:file "semaphore")
+                             (:file "thread")
+                             (:file "queue")
+                             (:file "timeout")
+                             (:file "job")
+                             (:file "worker")
+                             (:file "keeper")
+                             (:file "patron")))))
diff --git a/src/job.lisp b/src/job.lisp
@@ -0,0 +1,40 @@
+;;; Copyright (c) 2009, Volkan YAZICI <volkan.yazici@gmail.com>
+;;; All rights reserved.
+
+;;; Redistribution  and  use  in  source  and  binary  forms,  with  or  without
+;;; modification, are permitted provided that the following conditions are met:
+
+;;; - Redistributions  of source code  must retain  the above  copyright notice,
+;;;   this list of conditions and the following disclaimer.
+
+;;; - Redistributions in binary form  must reproduce the above copyright notice,
+;;;   this list of conditions and  the following disclaimer in the documentation
+;;;   and/or other materials provided with the distribution.
+
+;;; THIS SOFTWARE IS PROVIDED BY  THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
+;;; AND ANY  EXPRESS OR IMPLIED WARRANTIES,  INCLUDING, BUT NOT  LIMITED TO, THE
+;;; IMPLIED WARRANTIES  OF MERCHANTABILITY AND FITNESS FOR  A PARTICULAR PURPOSE
+;;; ARE DISCLAIMED.  IN NO  EVENT SHALL THE  COPYRIGHT OWNER OR  CONTRIBUTORS BE
+;;; LIABLE  FOR  ANY  DIRECT,   INDIRECT,  INCIDENTAL,  SPECIAL,  EXEMPLARY,  OR
+;;; CONSEQUENTIAL  DAMAGES  (INCLUDING,  BUT  NOT  LIMITED  TO,  PROCUREMENT  OF
+;;; SUBSTITUTE GOODS  OR SERVICES;  LOSS OF USE,  DATA, OR PROFITS;  OR BUSINESS
+;;; INTERRUPTION)  HOWEVER CAUSED  AND ON  ANY THEORY  OF LIABILITY,  WHETHER IN
+;;; CONTRACT,  STRICT LIABILITY,  OR  TORT (INCLUDING  NEGLIGENCE OR  OTHERWISE)
+;;; ARISING IN ANY WAY  OUT OF THE USE OF THIS SOFTWARE,  EVEN IF ADVISED OF THE
+;;; POSSIBILITY OF SUCH DAMAGE.
+
+
+(in-package :patron)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Job Submission Routines
+;;;
+
+(defun submit-job (patron job)
+  "Submit given `JOB' into the job queue of `PATRON'. Function works in a
+blocking manner and returns inserted `JOB', or throws a `TIMEOUT-CONDITION'."
+  (setf (submit-time-of job) (get-universal-time))
+  (or (queue-timed-push (jobs-of patron) job (worker-timeout-duration-of patron))
+      (error 'timeout-condition :duration (worker-timeout-duration-of patron))))