suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

thread: break-suspend as a faster virtual register

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
racket/src/cs/rumble/virtual-register.ss
View File

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

10
racket/src/cs/thread.sls
View File

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

7
racket/src/io/port/bytes-output.rkt
View File

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

5
racket/src/io/port/write.rkt
View File

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

6
racket/src/thread/thread.rkt
View File

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