syndicate-lang
/
racket-ssh-2012
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Read whole buffers at once, rather than a character at a time

This commit is contained in:
Tony Garnock-Jones 2011-11-04 13:22:51 -04:00
parent 6b967002c5
commit f70354c683
1 changed files with 18 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
cook-port.rkt
View File

@ -45,26 +45,30 @@
(define-values (cooked-in cooked-out) (make-pipe))
(thread
(lambda ()
(define input-buffer (make-bytes 4096))
(let loop ((b (buffer '() #f)))
(if (port-closed? cooked-out)
;; our job here is
'done
(let ((s (read-string 1 raw-in)))
(if (eof-object? s)
(let ((count (read-bytes-avail! input-buffer raw-in)))
(if (eof-object? count)
(begin (close-output-port cooked-out)
(loop b))
(begin (update-buffer b (string-ref s 0) prompt
(lambda ()
(close-output-port cooked-out)
(close-input-port raw-in))
(lambda (line new-b)
(write-string "\r\n" raw-out)
(write-string line cooked-out)
(newline cooked-out)
(loop new-b))
(lambda (new-b feedback)
(write-string feedback raw-out)
(loop new-b))))))))))
(let process-bytes ((i 0) (b b))
(if (>= i count)
(loop b)
(update-buffer b (integer->char (bytes-ref input-buffer i)) prompt
(lambda ()
(close-output-port cooked-out)
(close-input-port raw-in))
(lambda (line new-b)
(write-string "\r\n" raw-out)
(write-string line cooked-out)
(newline cooked-out)
(process-bytes (+ i 1) new-b))
(lambda (new-b feedback)
(write-string feedback raw-out)
(process-bytes (+ i 1) new-b)))))))))))
(values cooked-in (cook-output raw-out)))
(define (cook-output raw-out)