diff --git a/racket/src/io/port/bytes-output.rkt b/racket/src/io/port/bytes-output.rkt index 15c7515a23..0924093821 100644 --- a/racket/src/io/port/bytes-output.rkt +++ b/racket/src/io/port/bytes-output.rkt @@ -16,7 +16,9 @@ write-bytes-avail* write-bytes-avail/enable-break write-bytes-avail-evt - port-writes-atomic?) + port-writes-atomic? + + unsafe-write-bytes) (module+ internal (provide do-write-bytes)) @@ -48,15 +50,29 @@ (define n (write-some-bytes who out bstr i end #:buffer-ok? #t)) (loop (fx+ n i))]))) -(define/who (write-bytes bstr [out (current-output-port)] [start-pos 0] [end-pos (and (bytes? bstr) - (bytes-length bstr))]) - (check who bytes? bstr) - (check who output-port? out) - (check who exact-nonnegative-integer? start-pos) - (check who exact-nonnegative-integer? end-pos) - (check-range who start-pos end-pos (bytes-length bstr) bstr) - (let ([out (->core-output-port out)]) - (do-write-bytes who out bstr start-pos end-pos))) +(define/who write-bytes + (case-lambda + [(bstr) + (check who bytes? bstr) + (let ([out (->core-output-port (current-output-port))]) + (do-write-bytes who out bstr 0 (bytes-length bstr)))] + [(bstr out) + (check who bytes? bstr) + (let ([out (->core-output-port out who)]) + (do-write-bytes who out bstr 0 (bytes-length bstr)))] + [(bstr out start-pos) + (write-bytes bstr out start-pos (and (bytes? bstr) (bytes-length bstr)))] + [(bstr out start-pos end-pos) + (check who bytes? bstr) + (let ([out (->core-output-port out who)]) + (check who exact-nonnegative-integer? start-pos) + (check who exact-nonnegative-integer? end-pos) + (check-range who start-pos end-pos (bytes-length bstr) bstr) + (do-write-bytes who out bstr start-pos end-pos))])) + +;; `o` must be a core output port +(define (unsafe-write-bytes who bstr o) + (do-write-bytes who o bstr 0 (bytes-length bstr))) (define (do-write-bytes-avail who bstr out start-pos end-pos #:zero-ok? [zero-ok? #f] diff --git a/racket/src/io/port/write.rkt b/racket/src/io/port/write.rkt index f4dbeae9ca..0a39896571 100644 --- a/racket/src/io/port/write.rkt +++ b/racket/src/io/port/write.rkt @@ -17,9 +17,9 @@ #:enable-break? [enable-break? #f]) (let try-again ([out out] [extra-count-outs null]) (start-atomic) - (check-not-closed who out) (cond [(fx= start end) + (check-not-closed who out) (end-atomic) 0] [else @@ -37,6 +37,7 @@ (end-atomic) v] [else + (check-not-closed who out) (define write-out (method core-output-port out write-out)) (cond [(procedure? write-out) diff --git a/racket/src/io/print/main.rkt b/racket/src/io/print/main.rkt index 93a3f1a020..dfd3599301 100644 --- a/racket/src/io/print/main.rkt +++ b/racket/src/io/print/main.rkt @@ -52,8 +52,7 @@ install-do-global-print!)) (define/who (display v [o (current-output-port)]) - (check who output-port? o) - (let ([co (->core-output-port o)]) + (let ([co (->core-output-port o who)]) (define display-handler (core-output-port-display-handler co)) (if display-handler (display-handler v o) @@ -63,7 +62,7 @@ (define (do-display who v o [max-length #f]) (cond [(and (bytes? v) (not max-length)) - (write-bytes v o) + (unsafe-write-bytes who v o) (void)] [(and (string? v) (not max-length)) (write-string v o) @@ -74,8 +73,7 @@ (void)])) (define/who (write v [o (current-output-port)]) - (check who output-port? o) - (let ([co (->core-output-port o)]) + (let ([co (->core-output-port o who)]) (define write-handler (core-output-port-write-handler co)) (if write-handler (write-handler v o) @@ -88,9 +86,8 @@ (void)) (define/who (print v [o (current-output-port)] [quote-depth PRINT-MODE/UNQUOTED]) - (check who output-port? o) - (check who print-mode? #:contract "(or/c 0 1)" quote-depth) - (let ([co (->core-output-port o)]) + (let ([co (->core-output-port o who)]) + (check who print-mode? #:contract "(or/c 0 1)" quote-depth) (define print-handler (core-output-port-print-handler co)) (if print-handler (print-handler v o quote-depth) @@ -122,15 +119,15 @@ (global-print v o2 quote-depth) (define bstr (get-output-bytes o2)) (if ((bytes-length bstr) . <= . max-length) - (write-bytes bstr o) + (unsafe-write-bytes who bstr o) (begin - (write-bytes (subbytes bstr 0 (sub3 max-length)) o) - (write-bytes #"..." o)))]) + (unsafe-write-bytes who (subbytes bstr 0 (sub3 max-length)) o) + (unsafe-write-bytes who #"..." o)))]) (void)))) (define/who (newline [o (current-output-port)]) (check who output-port? o) - (write-bytes #"\n" o) + (unsafe-write-bytes 'newline #"\n" o) (void)) ;; ----------------------------------------