thread: break-suspend as a faster virtual register
Slightly speeds up atomic mode for io.
This commit is contained in:
parent
ad2c0624b5
commit
0e6c441f37
|
@ -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 '())
|
||||
|
||||
|
|
|
@ -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:
|
||||
|
|
|
@ -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))])
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user