GopherProxy

	timpl-mcl.lisp - clic - Clic is an command line interactive client for gopher w…
	git clone git://bitreich.org/clic/ git://hg6vgqziawt5s4dj.onion/clic/
	Log
	Files
	Refs
	Tags
	LICENSE
	---
	timpl-mcl.lisp (1508B)
	---
	1 ;;;; -- indent-tabs-mode: nil --
	2
	3 #\|
	4 Copyright 2006, 2007 Greg Pfeil
	5
	6 Distributed under the MIT license (see LICENSE file)
	7 \|#
	8
	9 (in-package #:bordeaux-threads)
	10
	11 (deftype thread ()
	12 'ccl::process)
	13
	14 ;;; Thread Creation
	15
	16 (defun %make-thread (function name)
	17 (ccl:process-run-function name function))
	18
	19 (defun current-thread ()
	20 ccl:current-process)
	21
	22 (defun threadp (object)
	23 (ccl::processp object))
	24
	25 (defun thread-name (thread)
	26 (ccl:process-name thread))
	27
	28 ;;; Resource contention: locks and recursive locks
	29
	30 (deftype lock () 'ccl:lock)
	31
	32 (defun lock-p (object)
	33 (typep object 'ccl:lock))
	34
	35 (defun make-lock (&optional name)
	36 (ccl:make-lock (or name "Anonymous lock")))
	37
	38 (defun acquire-lock (lock &optional (wait-p t))
	39 (if wait-p
	40 (ccl:process-lock lock ccl:current-process)
	41 ;; this is broken, but it's better than a no-op
	42 (ccl:without-interrupts
	43 (when (null (ccl::lock.value lock))
	44 (ccl:process-lock lock ccl:current-process)))))
	45
	46 (defun release-lock (lock)
	47 (ccl:process-unlock lock))
	48
	49 (defmacro with-lock-held ((place) &body body)
	50 `(ccl:with-lock-grabbed (,place) ,@body))
	51
	52 (defun thread-yield ()
	53 (ccl:process-allow-schedule))
	54
	55 ;;; Introspection/debugging
	56
	57 (defun all-threads ()
	58 ccl:all-processes)
	59
	60 (defun interrupt-thread (thread function &rest args)
	61 (declare (dynamic-extent args))
	62 (apply #'ccl:process-interrupt thread function args))
	63
	64 (defun destroy-thread (thread)
	65 (signal-error-if-current-thread thread)
	66 (ccl:process-kill thread))
	67
	68 (mark-supported)