impl-mcl.lisp - clic - Clic is an command line interactive client for gopher written in Common LISP
 (HTM) git clone git://bitreich.org/clic/ git://enlrupgkhuxnvlhsf6lc3fziv5h2hhfrinws65d7roiv6bfj7d652fid.onion/clic/
 (DIR) Log
 (DIR) Files
 (DIR) Refs
 (DIR) Tags
 (DIR) README
 (DIR) LICENSE
       ---
       impl-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)