I only found how to kill a thread that I have assigned to a variable:
(setf *foo* (bt:make-thread (lambda () (loop)) :name "Foo2")) --> (bt:destroy-thread *foo*)
How can I kill just any thread that I can see with (bt:all-threads):
(bt:make-thread (lambda () (loop)) :name "Foo") --> ?
You can kill any thread. There is nothing special about it. If you get a list of threads, just get the thread you want to kill and pass it to the function.
The function destroy-thread does not see a variable. Since it is a function, Lisp uses the usual evaluation rules. It gets passed a thread. The thread just happens to be the value of a variable in your example.
It could be the value of a function call:
(defun my-thread ()
*foo*)
(bt:destroy-thread (my-thread))
or even part of a data structure, for example a list:
(defun my-thread ()
(list 1 *foo* 3))
(bt:destroy-thread (second (my-thread)))
A thread is just another object.
If you get a list of threads, then you need to identify the correct thread. For example by looking at the name of the thread.
(bt:destroy-thread (nth index (bt:all-threads)))
It maybe be good the check if thread is alive, (bt:thread-alive-p <thread>) and not the current one, (bt:current-thread <thread>) Before killing it..
Related
I am trying to build a common lisp implementation of the channel construct of Golang for a personal project (also to learn lisp). So far I've implemented the channels as objects of a class, containing a queue, a lock and a condition variable to signal listening functions that a new message has been added to the queue. I'm using bordeaux threads to create threads, locks, condition variables and join the executions (from the lisp cookbook).
This is the channel class and the recive function:
(defclass channel ()
((messages :initform '()
:accessor messages
:documentation "Messages in the channel")
(lock :initform (bt:make-lock)
:accessor lock
:documentation
"Lock to push/pop messages in the channel")
(cv :initarg :cv
:initform (bt:make-condition-variable)
:accessor cv
:documentation
"Condtional variable to notify the channel of a new message")))
(defmethod recive-loop ((self channel))
(with-slots (lock cv messages) self
(let ((to-ret nil))
(loop
(bt:with-lock-held (lock)
(if (not (null messages))
(setf to-ret (car (pop messages)))
(bt:condition-wait cv lock))
(if to-ret (return to-ret)))))))
(defmethod recive ((self channel))
(with-slots (name thread) self
(let ((thread
(bt:make-thread #'(lambda() (recive-loop self))
:name name)))
(bt:join-thread thread))))
(defmacro gorun (f &rest args)
(flet ((fn () (apply f args)))
(bt:make-thread #'fn
:initial-bindings (list args)
:name "gorun worker")))
gorun should be the equivalent of go routine() for go (without the light threading). To test the setup I've built a printer function over a channel
(defvar printch (channel))
(defun printover (ch)
(let ((x (recive ch)))
(format t "Recived variable x: ~d~%" x)))
but when I run
(gorun printover printch)
The interpreter (using sbcl, but with clisp the same happens) gives back an error:
There is no applicable method for the generic function
#<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::RECIVE (1)>
when called with arguments
(PRINTCH).
[Condition of type SB-PCL::NO-APPLICABLE-METHOD-ERROR]
See also:
Common Lisp Hyperspec, 7.6.6 [:section]
Restarts:
0: [RETRY] Retry calling the generic function.
1: [ABORT] abort thread (#<THREAD "gorun worker" RUNNING {100293E9F3}>)
Backtrace:
0: ((:METHOD NO-APPLICABLE-METHOD (T)) #<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::RECIVE (1)> PRINTCH) [fast-method]
Locals:
SB-PCL::ARGS = (PRINTCH)
GENERIC-FUNCTION = #<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::RECIVE (1)>
1: (SB-PCL::CALL-NO-APPLICABLE-METHOD #<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::RECIVE (1)> (PRINTCH))
Locals:
ARGS = (PRINTCH)
GF = #<STANDARD-GENERIC-FUNCTION COMMON-LISP-USER::RECIVE (1)>
2: (PRINTOVER PRINTCH)
Locals:
CH = PRINTCH
3: ((LAMBDA NIL :IN BORDEAUX-THREADS::BINDING-DEFAULT-SPECIALS))
[No Locals]
I'm confused, since the method to run over the channel printch should be the one I've defined.
Trying to call a class method inside of a new thread, but got no applicable method
A macros is supposed to return code to run in place of the original call. Your macro is creating the thread at expansion time.
If you're not using backtick in a macro definition, there's usually something wrong with it. You should figure out what the code would look like without the macro, then define a macro that returns code with that same structure in a backticked list, replacing the places that need to vary with the parameters, using comma to expand them.
(defmacro gorun (f &rest args)
`(bt:make-thread (function ,f)
:initial-bindings (list ,#args)
:name "gorun worker"))
In the above, you need to substitute the function name into a (function ...) expression, and the args list as the :initial-bindings argument.
In multi-threaded environments it is often the case that special variables are thread-local. The global binding is visible from all threads, but if you bind one locally its value will not automatically be transferred to a thread created in that context. It has to be done explicitly, and I wrote a pair of macros recently just for that.
The first one captures bindings into lexically-scoped variables; the other bind the original variables back to the values captured in a different context.
I am using an intermediate data structure in the code to store bindings:
(defstruct bindings data)
The first macro is with-captured-bindings:
(defmacro with-captured-bindings ((&rest symbols) as name &body body)
(assert (eq as :as))
(loop for s in (alexandria:flatten
(sublis
'((:stdio *standard-output* *error-output* *standard-input*)
(:path *default-pathname-defaults*))
symbols))
for g = (gensym)
collect (list g s) into capture
collect (list s g) into rebind
finally
(return
`(let ,capture
,#(subst (make-bindings :data rebind)
name
body)))))
The capture variable holds a list of bindings to initialize the lexically-scoped variables. The rebind variables is a list of bindings to set back special variables to their values in another thread.
I inject with subst an instance of the bindings struct in the code. It helps to have a dedicated data structure, but the crude search-and-replace approach means the symbols name will not be usable as a function, local macro, etc. in body. I don't think it is too much of a problem.
Also, I define aliases like :stdio and :path for commonly used variables.
The second macro is with-bindings:
(defmacro with-bindings (bindings &body body)
(check-type bindings bindings)
`(let ,(bindings-data bindings)
,#body))
This replaces the intermediate struct with the proper code. The final code does not have this struct anymore and can be processed as usual.
For example:
(defvar *my-var* "hello")
(with-captured-bindings (:stdio :path *my-var*) :as <bindings>
(sb-thread:make-thread
(lambda ()
(with-bindings <bindings>
(print *var*)))))
A first application of macroexpand gives:
(LET ((#:G3882 *STANDARD-OUTPUT*)
(#:G3883 *ERROR-OUTPUT*)
(#:G3884 *STANDARD-INPUT*)
(#:G3885 *DEFAULT-PATHNAME-DEFAULTS*)
(#:G3886 *MY-VAR*))
(SB-THREAD:MAKE-THREAD
(LAMBDA ()
(WITH-BINDINGS #S(BINDINGS
:DATA ((*STANDARD-OUTPUT* #:G3882)
(*ERROR-OUTPUT* #:G3883)
(*STANDARD-INPUT* #:G3884)
(*DEFAULT-PATHNAME-DEFAULTS* #:G3885)
(*MY-VAR* #:G3886)))
(PRINT *MY-VAR*)))))
Notice that there is #S(BINDINGS ...) object in the tree.
The full expansion is:
(LET ((#:G3887 *STANDARD-OUTPUT*)
(#:G3888 *ERROR-OUTPUT*)
(#:G3889 *STANDARD-INPUT*)
(#:G3890 *DEFAULT-PATHNAME-DEFAULTS*)
(#:G3891 *MY-VAR*))
(SB-THREAD:MAKE-THREAD
(LAMBDA ()
(LET ((*STANDARD-OUTPUT* #:G3887)
(*ERROR-OUTPUT* #:G3888)
(*STANDARD-INPUT* #:G3889)
(*DEFAULT-PATHNAME-DEFAULTS* #:G3890)
(*MY-VAR* #:G3891))
(PRINT *MY-VAR*)))))
The basic discussion of queues in the lparallel library at https://z0ltan.wordpress.com/2016/09/09/basic-concurrency-and-parallelism-in-common-lisp-part-4a-parallelism-using-lparallel-fundamentals/#channels says that queues "enable message passing between worker threads." The test below uses a shared queue to coordinate a main and a subordinate thread, where the main simply waits for the completion of the subordinate before exiting:
(defun foo (q)
(sleep 1)
(lparallel.queue:pop-queue q)) ;q is now empty
(defun test ()
(setf lparallel:*kernel* (lparallel:make-kernel 1))
(let ((c (lparallel:make-channel))
(q (lparallel.queue:make-queue)))
(lparallel.queue:push-queue 0 q)
(lparallel:submit-task c #'foo q)
(loop do (sleep .2)
(print (lparallel.queue:peek-queue q))
when (lparallel.queue:queue-empty-p q)
do (return)))
(lparallel:end-kernel :wait t))
This works as expected producing output:
* (test)
0
0
0
0
NIL
(#<SB-THREAD:THREAD "lparallel" FINISHED values: NIL {10068F2B03}>)
My question is about whether I'm using the queue functionality of lparallel correctly or fully. It would seem that a queue is simply a substitute for using a global variable to hold a thread-shared object. What is the design advantage of using a queue? Is it generally good practice to assign one queue to each submitted task (assuming the task needs to communicate)? Thanks for any deeper insights.
Multithreaded work is done by managing concurrent access to mutable
shared states, i.e. you have a lock around a common data-structure,
and each thread read or write into it.
It is however recommended to minimize the number of data being
accessed concurrently. Queues are a way to decouple workers from each
others, by having each thread manage its local state and exchange data
only through messages; this is thread-safe because the access to
queues is controlled by locks and condition
variables.
What you are doing in your main thread is polling for when the queue
is empty; this might work but this is counter-productive, since queues
are used as a synchronization mechanism but here you are doing the
synchronization yourself.
(ql:quickload :lparallel)
(defpackage :so (:use :cl
:lparallel
:lparallel.queue
:lparallel.kernel-util))
(in-package :so)
Let's change foo so that it gets two queues, one for incoming
requests, and one for replies. Here, we perform a simple transform to
the data being sent and for each input message, there is exactly one
output message, but this needs not always be the case.
(defun foo (in out)
(push-queue (1+ (pop-queue in)) out))
Change test so that the control-flow is only based on reading/writing to queues:
(defun test ()
(with-temp-kernel (1)
(let ((c (make-channel))
(foo-in (make-queue))
(foo-out (make-queue)))
(submit-task c #'foo foo-in foo-out)
;; submit data to task (could be blocking)
(push-queue 0 foo-in)
;; wait for message from task (could be blocking too)
(pop-queue foo-out))))
But how can you can avoid polling in test if there are multiple tasks running? Don’t you need to continuously check when any one of them is done so you can push-queue more work to it?
You could use a different concurrency mechanism, similar to listen and poll/epoll, where you watch for multiple
source of events and react whenever one of them is ready. There are languages like Go (select) and Erlang (receive) where
this is quite natural to express. On the Lisp side, the Calispel library provide a similar alternation mechanism (pri-alt and fair-alt). For example, the following it taken from Calispel's test code:
(pri-alt ((? control msg)
(ecase msg
(:clean-up (setf cleanup? t))
(:high-speed (setf slow? nil))
(:low-speed (setf slow? t))))
((? channel msg)
(declare (type fixnum msg))
(vector-push-extend msg out))
((otherwise :timeout (if cleanup? 0 nil))
(! reader-results out)
(! thread-expiration (bt:current-thread))
(return)))
In the case of lparallel, there is no such mechanism, but you can go pretty far with queues only, provided you tag your messages with identifiers.
If you need to react as soon as either a task t1 or t2 gives a result, then make both of those task write in the same result channel:
(let ((t1 (foo :id 1 :in i1 :out res))
(t2 (bar :id 2 :in i2 :out res)))
(destructuring-bind (id message) (pop-queue res)
(case id
(1 ...)
(2 ...))))
If you need to synchronize code for when both t1 and t2 emit result, let them write in different channels:
(let ((t1 (foo :id 1 :in i1 :out o1))
(t2 (bar :id 2 :in i2 :out o2)))
(list (pop-queue o1)
(pop-queue o2)))
I've got some threads returned by core.async/thread involved in some process, which I'm about to shut down. I'm not shutting down my entire program, just these threads. How can I terminate the threads?
The .stop method of the Java Thread class is deprecated but I'd be happy to use it, except that core.async/thread returns not a Thread, but a ManyToManyChannel:
user=> (clojure.core.async/thread)
#object[clojure.core.async.impl.channels.ManyToManyChannel 0x780e97c0
"clojure.core.async.impl.channels.ManyToManyChannel#780e97c0"]
user=> (type *1)
clojure.core.async.impl.channels.ManyToManyChannel
I haven't found any documentation on ManyToManyChannel. That sounds like a strange name for the type of a thread, so there might be something elementary here that I don't understand. But here's my current naïve, nonsensical-sounding question: How do you kill a ManyToManyChannel?
clojure.repl/thread-stopper seems to have no effect on ManyToManyChannels.
You let the thread terminate naturally. If external termination is necessary, you have to implement it.
(defn terminatable [input-ch terminate-ch]
(thread
(loop []
(let [[v ch] (alts!! [input-ch terminate-ch])]
(if (identical? ch input-ch)
(if (some? v)
(do (process-input v) (recur))
;; else input-ch has closed -> don't call recur,
;; thread terminates
)
;; else we received sth. from terminate-ch,
;; or terminate-ch has closed -> don't call recur,
;; thread terminates
)))))
Then terminate externally via
(close! terminate-ch)
Finally you can determine when the thread is terminated by taking from the channel returned by thread.
I. e.
(take! (terminatable (chan) (doto (chan) close!))
(fn [_] (println "Thread is terminated")))
Based on core.async walk through example, I created below similar code to handle some CPU intensive jobs using multiple channels with a timeout of 10 seconds. However after the main thread returns, the CPU usage remains around 700% (8 CPUs machine). I have to manually run nrepl-close in emacs to shut down the Java process.
Is there any proper way to kill macro thread produced by (go..) block ? I tried close! each chan, but it doesn't work. I want to make sure CPU usage back to 0 by Java process after main thread returns.
(defn [] RETURNED-STR-FROM-SOME-CPU-INTENSE-JOB (do... (str ...)))
(let [n 1000
cs (repeatedly n chan)]
(doseq [c cs]
(go
(>! c (RETURNED-STR-FROM-SOME-CPU-INTENSE-JOB ))))
(dotimes [i n]
(let [[result source] (alts!! (conj cs (timeout 10000))) ] ;;wait for 10 seconds for each job
(if (list-contains? cs source) ;;if returned chan belongs to cs
(prn "OK JOB FINISHED " result)
(prn "JOB TIMEOUT")
)))
(doseq [i cs]
(close! i)) ;;not useful for "killing" macro thread
(prn "JOBS ARE DONE"))
;;Btw list-contains? function is used to judge whether an element is in a list
;;http://stackoverflow.com/questions/3249334/test-whether-a-list-contains-a-specific-value-in-clojure
(defn list-contains? [coll value]
(let [s (seq coll)]
(if s
(if (= (first s) value) true (recur (rest s) value))
false)))
In REPL there seems to be no clean way yet.
I first tried a very dirty way by using deprecated method Thread.stop
(doseq [i #threadpool ]
(.stop i))
It seemed worked as CPU usage dropped once the main thread returned to REPL, but if I run the program again in REPL, it'd just hang at the go block part!!
Then I googled around and found this blog and it says
One final thing to note: we don't explicitly do any work to shutdown the go routines. Go routines will automatically stop operation when the main function exits. Thus, go routines are like daemon threads in the JVM (well, except for the "thread" part ...)
So I tried again by making my project into a uberjar and run it on a command console, and it turned out that CPU usage would drop immediately when blinking cursor returns to the console!
Based on answer for another related question How to control number of threads in (go...), I've found a better way to properly kill all the threads started by (go...) block:
First alter the executor var and supply a custom thread pool
;; def, not defonce, so that the executor can be re-defined
;; Number of threads are fixed to be 4
(def my-executor
(java.util.concurrent.Executors/newFixedThreadPool
4
(conc/counted-thread-factory "my-async-dispatch-%d" true)))
(alter-var-root #'clojure.core.async.impl.dispatch/executor
(constantly (delay (tp/thread-pool-executor my-executor))))
Then call .shutdownNow and .awaitTermination method at the end of (go...) block
(.shutdownNow my-executor)
(while (not (.awaitTermination my-executor 10 java.util.concurrent.TimeUnit/SECONDS ) )
(prn "...waiting 10 secs for executor pool to finish") )
[UPDATE]
The shutdown executor method above seems not pure enough. The final solution for my case is to send a function with control of its own timeout into go block, using thunk-timeout function. Credits go to this post. Example below
(defn toSendToGo [args timeoutUnits]
(let [result (atom nil)
timeout? (atom false)]
(try
( thunk-timeout
(fn [] (reset! result (myFunction args))) timeoutUnits)
(catch java.util.concurrent.TimeoutException e (do (prn "!Time out after " timeoutUnits " seconds!!") (reset! timeout? true)) ))
(if #timeout? (do sth))
#result))
(let [c ( chan)]
(go (>! c (toSendToGo args timeoutUnits))))
(shutdown-agents)
Implementation-specific, JVM: both agents and channels use a global thread pool, and the termination function for agents iterates and closes all open threads in the VM. Empty the channels first: this action is immediate and non-reversible (especially if you are in a REPL).
I'm finding it extremely frustrating working out how to kill a thread in Racket.
It seems like it's basic enough that it's not explicitly in any guide or documentation (there's stuff which seems related, but I can't understand how to apply it to my situation because it doesn't offer a mental model for how the process works).
Every time I attempt to (kill-thread thread-name), it returns the error that the thread is in fact a procedure. However, starting the same thread works fine.
What am I doing wrong?
Here's my (horrible) code at the current time, I've never worked much with threads before in or out of Racket so this is probably beyond disgusting:
(define game
(lambda ()
(let loop ()
(sleep 2)
(printf "game running \n")
(loop))))
(define start (lambda () (thread game)))
(define stop (lambda () (with-handlers
([exn:fail?
(lambda (exn)
(displayln (string-append "Failed to kill main game thread. " (exn-message exn)))
#f)])
(kill-thread (start)))))
E: I've tried replacing "(start)" with "game", and thunking/unthinking start/stop in various combinations.
Right now, you're creating the new thread and deleting it immediately with (kill-thread (start)), while the old one is untouched.
If you only need to keep track of the single main game thread (aka thats the only thing passing through start and stop) you can use set! and a global variable to keep track of the thread:
#lang racket
(define game
(lambda ()
(let loop ()
(sleep 2)
(printf "game running \n")
(loop))))
(define GAME-THREAD (void))
(define start (lambda () (set! GAME-THREAD (thread game))))
(define stop (lambda () (with-handlers
([exn:fail?
(lambda (exn)
(displayln (string-append "Failed to kill main game thread. " (exn-message exn)))
#f)])
(kill-thread GAME-THREAD))))