thread: break-suspend as a faster virtual register

Slightly speeds up atomic mode for io.
This commit is contained in:
Matthew Flatt 2019-01-14 18:03:21 -07:00
parent ad2c0624b5
commit 0e6c441f37
5 changed files with 19 additions and 13 deletions

View File

@ -1,8 +1,8 @@
;; We get a small number of virtual registers for fast,
;; pthread-specific bindings.
;; The last virtual register is reserved for use by the thread system
(meta define num-reserved-virtual-registers 1)
;; The last two virtual registers are reserved for use by the thread system
(meta define num-reserved-virtual-registers 2)
(meta define virtual-register-initial-values '())

View File

@ -41,7 +41,7 @@
;; Special handling of `current-atomic`: use the last virtual register;
;; we rely on the fact that the register's default value is 0.
(define-syntax (define stx)
(syntax-case stx (current-atomic make-pthread-parameter unsafe-make-place-local)
(syntax-case stx (current-atomic current-break-suspend make-pthread-parameter unsafe-make-place-local)
;; Recognize definition of `current-atomic`:
[(_ current-atomic (make-pthread-parameter 0))
(with-syntax ([(_ id _) stx]
@ -50,6 +50,14 @@
(syntax-rules ()
[(_) (virtual-register n)]
[(_ v) (set-virtual-register! n v)])))]
;; Recognize definition of `current-break-suspend`:
[(_ current-break-suspend (make-pthread-parameter 0))
(with-syntax ([(_ id _) stx]
[n (datum->syntax #'here (- (virtual-register-count) 2))])
#'(define-syntax id
(syntax-rules ()
[(_) (virtual-register n)]
[(_ v) (set-virtual-register! n v)])))]
;; Workaround for redirected access of `unsafe-make-place-local` from #%pthread:
[(_ alias-id unsafe-make-place-local) #'(begin)]
;; Chain to place-register handling:

View File

@ -1,5 +1,6 @@
#lang racket/base
(require "../common/check.rkt"
(require racket/fixnum
"../common/check.rkt"
"../host/thread.rkt"
"port.rkt"
"output-port.rkt"
@ -28,10 +29,10 @@
(define (do-write-bytes who out bstr start end)
(let loop ([i start])
(cond
[(= i end) (- i start)]
[(fx= i end) (fx- i start)]
[else
(define n (write-some-bytes who out bstr i end #:buffer-ok? #t))
(loop (+ n i))])))
(loop (fx+ n i))])))
(define/who (write-bytes bstr [out (current-output-port)] [start-pos 0] [end-pos (and (bytes? bstr)
(bytes-length bstr))])

View File

@ -1,5 +1,6 @@
#lang racket/base
(require "../common/internal-error.rkt"
(require racket/fixnum
"../common/internal-error.rkt"
"../host/thread.rkt"
"port.rkt"
"output-port.rkt"
@ -17,7 +18,7 @@
(start-atomic)
(check-not-closed who out)
(cond
[(= start end)
[(fx= start end)
(end-atomic)
0]
[else

View File

@ -723,11 +723,7 @@
(define break-enabled-default-cell (make-thread-cell #t))
;; For disabling breaks, such as through `unsafe-start-atomic`:
(define-place-local break-suspend 0)
(define current-break-suspend
(case-lambda
[() break-suspend]
[(v) (set! break-suspend v)]))
(define current-break-suspend (make-pthread-parameter 0))
(define (current-break-enabled-cell)
(continuation-mark-set-first #f