47 lines
1.8 KiB
Racket
47 lines
1.8 KiB
Racket
#lang syndicate
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
|
|
|
(provide linked-thread)
|
|
|
|
(require "engine.rkt")
|
|
(require (only-in racket/exn exn->string))
|
|
|
|
(define-logger syndicate/driver-support)
|
|
|
|
(define (linked-thread thread-proc
|
|
#:name [name (gensym 'linked-thread)]
|
|
#:peer [peer (ref (entity/stop-on-retract #:name (list name 'monitor)))]
|
|
#:custodian [c (make-custodian)])
|
|
(define handle #f)
|
|
(define armed? #t)
|
|
|
|
(define (!)
|
|
(when armed?
|
|
(set! armed? #f)
|
|
(log-syndicate/driver-support-info "~a shutdown" name)
|
|
(turn-retract! this-turn handle)
|
|
(queue-task! (actor-engine this-actor) (lambda () (custodian-shutdown-all c)))
|
|
(actor-remove-exit-hook! this-actor !)))
|
|
|
|
(on-stop (!))
|
|
(actor-add-exit-hook! this-actor !)
|
|
|
|
(log-syndicate/driver-support-info "~a startup" name)
|
|
(set! handle
|
|
(parameterize ((current-custodian c))
|
|
(define facet this-facet)
|
|
(turn-assert! this-turn
|
|
peer
|
|
(embedded
|
|
(thread (lambda ()
|
|
(with-handlers
|
|
([(lambda (_e) #t)
|
|
(lambda (e)
|
|
(log-syndicate/driver-support-error "~a crashed:\n~a"
|
|
name
|
|
(exn->string e))
|
|
(void))])
|
|
(thread-proc facet))
|
|
(turn! facet !))))))))
|