io: repairs

racket/src/io/file/main.rkt

@@ -180,7 +180,9 @@
                  (rktio_set_file_modify_seconds rktio host-path secs)
                  (rktio_get_file_modify_seconds rktio host-path)))
   (define r (if (and (not secs) (not (rktio-error? r0)))
-                (rktio_timestamp_ref r0)
+                (begin0
+                  (rktio_timestamp_ref r0)
+                  (rktio_free r0))
                 r0))
   (end-atomic)
   (cond

racket/src/io/host/bootstrap.rkt

@@ -100,6 +100,7 @@
                          'end-atomic end-atomic
                          'start-atomic/no-interrupts start-atomic
                          'end-atomic/no-interrupts end-atomic
+                         'in-atomic-mode? in-atomic-mode?
                          'current-custodian current-custodian
                          'custodian-shut-down? (lambda (c)
                                                  (define v (box 1))

racket/src/io/host/thread.rkt

@@ -4,6 +4,7 @@
 (provide atomically
          non-atomically
          atomically/no-interrupts
+         assert-atomic
          check-current-custodian)
 
 (define table
@@ -47,6 +48,7 @@
         end-atomic
         start-atomic/no-interrupts ; => disable GC, too, if GC can call back
         end-atomic/no-interrupts
+        in-atomic-mode?
         current-custodian
         unsafe-custodian-register
         unsafe-custodian-unregister
@@ -76,6 +78,13 @@
       (let () e ...)
       (end-atomic/no-interrupts))))
 
+;; Enable for debugging
+(define (assert-atomic)
+  (void)
+  #;
+  (unless (in-atomic-mode?)
+    (error 'assert-atomic "not in atomic mode")))
+
 ;; in atomic mode
 (define (check-current-custodian who)
   (when (custodian-shut-down? (current-custodian))

racket/src/io/port/bytes-input.rkt

@@ -34,7 +34,7 @@
     [(= v amt) v]
     [else
      (let loop ([got v])
-       (define v (read-some-bytes! who in bstr got amt #:keep-eof? #t #:special-ok? #f))
+       (define v (read-some-bytes! who in bstr (+ start got) end #:keep-eof? #t #:special-ok? #f))
        (cond
          [(eof-object? v)
           got]

racket/src/io/port/pipe.rkt

@@ -158,6 +158,7 @@
      
      #:read-byte
      (lambda ()
+       (assert-atomic)
        (cond
          [(input-empty?)
           (if output-closed?
@@ -177,6 +178,7 @@
 
      #:read-in
      (lambda (dest-bstr dest-start dest-end copy?)
+       (assert-atomic)
        (cond
          [(input-empty?)
           (if output-closed?
@@ -205,6 +207,7 @@
 
      #:peek-byte
      (lambda ()
+       (assert-atomic)
        (cond
          [(input-empty?)
           (if output-closed?
@@ -216,6 +219,7 @@
      
      #:peek-in
      (lambda (dest-bstr dest-start dest-end skip progress-evt copy?)
+       (assert-atomic)
        (define content-amt (content-length))
        (cond
          [(and progress-evt
@@ -250,6 +254,7 @@
 
      #:byte-ready
      (lambda (work-done!)
+       (assert-atomic)
        (or output-closed?
            (not (zero? (content-length)))))
 
@@ -273,6 +278,7 @@
      ;; Allows `amt` to be zero and #f for other arguments,
      ;; which is helpful for `open-input-peek-via-read`.
      (lambda (amt progress-evt ext-evt finish)
+       (assert-atomic)
        ;; `progress-evt` is a `semepahore-peek-evt`, and `ext-evt`
        ;; is constrained; we can send them over to different threads
        (cond
@@ -314,6 +320,7 @@
      #:write-out
      ;; in atomic mode
      (lambda (src-bstr src-start src-end nonblock? enable-break? copy?)
+       (assert-atomic)
        (let try-again ()
          (define top-pos (if (zero? start)
                              (sub1 len)

racket/src/io/port/ready.rkt

@@ -31,7 +31,7 @@
     (cond
       [(byte-ready? in)
        (define peek-byte (core-input-port-peek-byte in))
-       (define b (and peek-byte (peek-byte)))
+       (define b (and peek-byte (atomically (peek-byte))))
        (cond
          [(and b
                (or (eof-object? b)

racket/src/io/port/string-input.rkt

@@ -313,7 +313,7 @@
   (let ([in (->core-input-port in)])
     (define peek-byte (and (zero? skip-k)
                            (core-input-port-peek-byte in)))
-    (define b (and peek-byte (peek-byte)))
+    (define b (and peek-byte (atomically (peek-byte))))
     (cond
       [(and b
             (or (eof-object? b)

racket/src/thread/atomic.rkt

@@ -12,6 +12,8 @@
          start-atomic/no-interrupts
          end-atomic/no-interrupts
 
+         in-atomic-mode?
+
          set-end-atomic-callback!
 
          start-implicit-atomic-mode
@@ -53,6 +55,9 @@
   (host:enable-interrupts)
   (end-atomic))
 
+(define (in-atomic-mode?)
+  (positive? (current-atomic)))
+
 ;; ----------------------------------------
 
 (define end-atomic-callback #f)

racket/src/thread/instance.rkt

@@ -43,6 +43,7 @@
           'end-atomic end-atomic
           'start-atomic/no-interrupts start-atomic/no-interrupts
           'end-atomic/no-interrupts end-atomic/no-interrupts
+          'in-atomic-mode? in-atomic-mode?
           'current-custodian current-custodian
           'unsafe-custodian-register unsafe-custodian-register
           'unsafe-custodian-unregister unsafe-custodian-unregister