From 0e6c441f3711d825ec4e00d9c6e8471bdea5fc3b Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 14 Jan 2019 18:03:21 -0700
Subject: [PATCH] thread: break-suspend as a faster virtual register

Slightly speeds up atomic mode for io.
---
 racket/src/cs/rumble/virtual-register.ss |  4 ++--
 racket/src/cs/thread.sls                 | 10 +++++++++-
 racket/src/io/port/bytes-output.rkt      |  7 ++++---
 racket/src/io/port/write.rkt             |  5 +++--
 racket/src/thread/thread.rkt             |  6 +-----
 5 files changed, 19 insertions(+), 13 deletions(-)

diff --git a/racket/src/cs/rumble/virtual-register.ss b/racket/src/cs/rumble/virtual-register.ss
index ddf2b286ba..478f446a1e 100644
--- a/racket/src/cs/rumble/virtual-register.ss
+++ b/racket/src/cs/rumble/virtual-register.ss
@@ -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 '())
 
diff --git a/racket/src/cs/thread.sls b/racket/src/cs/thread.sls
index b381bd782d..6c8f4cf0c6 100644
--- a/racket/src/cs/thread.sls
+++ b/racket/src/cs/thread.sls
@@ -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:
diff --git a/racket/src/io/port/bytes-output.rkt b/racket/src/io/port/bytes-output.rkt
index 8acac742cd..7702c680bc 100644
--- a/racket/src/io/port/bytes-output.rkt
+++ b/racket/src/io/port/bytes-output.rkt
@@ -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))])
diff --git a/racket/src/io/port/write.rkt b/racket/src/io/port/write.rkt
index 859e2bfcab..fdadbb26bc 100644
--- a/racket/src/io/port/write.rkt
+++ b/racket/src/io/port/write.rkt
@@ -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
diff --git a/racket/src/thread/thread.rkt b/racket/src/thread/thread.rkt
index 64fbfcb384..325085a73e 100644
--- a/racket/src/thread/thread.rkt
+++ b/racket/src/thread/thread.rkt
@@ -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