Use block I/O in cat, head, wc instead of read-char loops
ober
ce79f5d2b8f2eed1580a02abed2a785ac7079a40
--- a/lib/jerboa-coreutils/cat.sls +++ b/lib/jerboa-coreutils/cat.sls @@ -69,6 +69,40 @@ (write-char c out))) (loop (+ i 1)))))))) + ;; Fast binary block copy — no character decoding overhead + (def (cat-fast port) + (let ((buf (make-bytevector 65536)) + (out (standard-output-port))) + (let loop () + (let ((n (get-bytevector-n! port buf 0 65536))) + (unless (eof-object? n) + (put-bytevector out buf 0 n) + (loop)))) + (flush-output-port out))) + + ;; Line-oriented cat with flags (get-line instead of read-char) + (def (cat-lines port number-lines? number-nonblank? squeeze? + show-ends? show-tabs? show-nonprinting?) + (let loop ((line-num 1) (prev-blank? #f)) + (let ((line (get-line port))) + (unless (eof-object? line) + (let* ((blank? (string=? line "")) + (skip? (and squeeze? prev-blank? blank?))) + (unless skip? + (when number-lines? + (if (and number-nonblank? blank?) + (void) + (begin + (display-right-aligned line-num 6) + (display "\t")))) + (display (transform-line line show-tabs? show-nonprinting?)) + (when show-ends? (display "$")) + (newline)) + (loop (if (and number-lines? (not skip?) + (not (and number-nonblank? blank?))) + (+ line-num 1) line-num) + blank?)))))) + (def (main . args) (parameterize ((program-name "cat")) (call-with-getopt @@ -80,49 +114,19 @@ (show-ends? (or (hash-get opt 'show-ends) (hash-get opt 'show-all) (hash-get opt 've))) (show-tabs? (or (hash-get opt 'show-tabs) (hash-get opt 'show-all) (hash-get opt 'vt))) (show-nonprinting? (or (hash-get opt 'show-nonprinting) (hash-get opt 'show-all) (hash-get opt 've) (hash-get opt 'vt)))) - (let ((line-num 1) - (prev-blank? #f)) - (process-cat-files - (if (null? files) '("-") files) - (lambda (port) - ;; Character-by-character reading to correctly handle files - ;; without trailing newline - (let loop ((line-buf (open-output-string))) - (let ((c (read-char port))) - (cond - ((eof-object? c) - ;; Flush remaining content (last line without trailing newline) - (let ((line (get-output-string line-buf))) - (when (> (string-length line) 0) - (let* ((blank? #f) - (skip? #f)) - (when number-lines? - (display-right-aligned line-num 6) - (display "\t") - (set! line-num (+ line-num 1))) - (display (transform-line line show-tabs? show-nonprinting?)) - (when show-ends? (display "$")))))) - ((eqv? c #\newline) - ;; Complete line - (let* ((line (get-output-string line-buf)) - (blank? (string=? line "")) - (skip? (and squeeze? prev-blank? blank?))) - (unless skip? - (when number-lines? - (if (and number-nonblank? blank?) - (void) - (begin - (display-right-aligned line-num 6) - (display "\t") - (set! line-num (+ line-num 1))))) - (display (transform-line line show-tabs? show-nonprinting?)) - (when show-ends? (display "$")) - (newline)) - (set! prev-blank? blank?) - (loop (open-output-string)))) - (else - (write-char c line-buf) - (loop line-buf)))))))))) + (let ((fancy? (or number-lines? squeeze? show-ends? + show-tabs? show-nonprinting?))) + (process-cat-files + (if (null? files) '("-") files) + (lambda (port) + (if fancy? + (cat-lines port number-lines? number-nonblank? squeeze? + show-ends? show-tabs? show-nonprinting?) + ;; Plain cat: fast binary block copy + (cat-fast (if (equal? port (current-input-port)) + (standard-input-port) + (open-file-input-port + (port-name port)))))))))) args 'program: "cat" 'help: "Concatenate FILE(s) to standard output." --- a/lib/jerboa-coreutils/head.sls +++ b/lib/jerboa-coreutils/head.sls @@ -61,20 +61,36 @@ (if s s (begin (die "invalid number of lines: '~a'" str) 0)))) + ;; Fast line-counting head using block reads (def (head-lines file n) (let ((proc (lambda (port) (if (>= n 0) - ;; Positive: output first n lines - (let loop ((i 0)) - (when (< i n) - (let ((c (read-char port))) - (unless (eof-object? c) - (write-char c) - (if (eqv? c #\newline) - (loop (+ i 1)) - (loop i)))))) - ;; Negative: output all but last |n| lines + ;; Positive: output first n lines using block I/O + (let ((buf (make-bytevector 65536)) + (out (standard-output-port))) + (let loop ((remaining n)) + (when (> remaining 0) + (let ((got (get-bytevector-n! port buf 0 65536))) + (unless (eof-object? got) + ;; Scan for newlines in this block + (let scan ((i 0) (rem remaining)) + (cond + ((<= rem 0) + ;; Done — already wrote enough + (void)) + ((>= i got) + ;; Exhausted this block, need more + (put-bytevector out buf 0 got) + (loop rem)) + ((= (bytevector-u8-ref buf i) 10) ;; newline + (if (= rem 1) + ;; This is the last newline we need — write up to here and stop + (begin (put-bytevector out buf 0 (+ i 1)) + (flush-output-port out)) + (scan (+ i 1) (- rem 1)))) + (else (scan (+ i 1) rem))))))))) + ;; Negative: output all but last |n| lines (keep existing approach) (let* ((skip (- n)) (all-lines (read-all-lines-raw port)) (total (length all-lines)) @@ -85,15 +101,15 @@ (when (cdr (car rest)) (newline)) (loop (cdr rest) (+ i 1))))))))) (if (equal? file "-") - (proc (current-input-port)) + (proc (standard-input-port)) (with-catch (lambda (e) (warn "cannot open '~a' for reading: No such file or directory" file) (set! exit-status 1)) (lambda () - (let ((port (open-input-file file))) + (let ((port (open-file-input-port file))) (try (proc port) - (finally (close-input-port port))))))))) + (finally (close-port port))))))))) ;; Read all lines preserving trailing newline info ;; Returns list of (content . has-newline?) @@ -120,31 +136,36 @@ (set! c (read-char port)) (loop buf))))))) + ;; Fast byte-count head using block I/O (def (head-bytes file n) (let ((proc (lambda (port) (if (>= n 0) ;; Positive: output first n bytes - (let loop ((i 0)) - (when (< i n) - (let ((c (read-char port))) - (unless (eof-object? c) - (write-char c) - (loop (+ i 1)))))) + (let ((buf (make-bytevector 65536)) + (out (standard-output-port))) + (let loop ((remaining n)) + (when (> remaining 0) + (let* ((to-read (min remaining 65536)) + (got (get-bytevector-n! port buf 0 to-read))) + (unless (eof-object? got) + (put-bytevector out buf 0 got) + (loop (- remaining got)))))) + (flush-output-port out)) ;; Negative: output all but last |n| bytes (let* ((content (read-all-as-string port)) (len (string-length content)) (to-print (max 0 (- len (- n))))) (display (substring content 0 to-print))))))) (if (equal? file "-") - (proc (current-input-port)) + (proc (standard-input-port)) (with-catch (lambda (e) (warn "cannot open '~a' for reading: No such file or directory" file) (set! exit-status 1)) (lambda () - (let ((port (open-input-file file))) + (let ((port (open-file-input-port file))) (try (proc port) - (finally (close-input-port port))))))))) + (finally (close-port port))))))))) ) ;; end library --- a/lib/jerboa-coreutils/wc.sls +++ b/lib/jerboa-coreutils/wc.sls @@ -126,40 +126,52 @@ (if (<= v 0) d (loop (quotient v 10) (+ d 1)))))) + ;; Byte classification for whitespace detection + (define (ws-byte? b) + (or (= b 10) (= b 32) (= b 9) (= b 13) (= b 12) (= b 11))) + + ;; Count UTF-8 lead bytes (chars = bytes that aren't continuation bytes 10xxxxxx) + (define (utf8-lead? b) + (not (= (fxlogand b #xC0) #x80))) + + ;; Fast block-based counting (def (count-file file) (let ((proc (lambda (port) - (let loop ((lines 0) (words 0) (bytes 0) (chars 0) - (max-line 0) (line-len 0) (in-word? #f)) - (let ((c (read-char port))) - (if (eof-object? c) - (values lines words bytes chars (max max-line line-len)) - (let* ((b (char->integer c)) - (byte-count (cond ((< b #x80) 1) ((< b #x800) 2) - ((< b #x10000) 3) (else 4))) - (nl? (eqv? c #\newline)) - (ws? (or nl? (eqv? c #\space) (eqv? c #\tab) - (eqv? c #\return) (eqv? c #\page) - (eqv? c (integer->char 11)))) - (word-start? (and (not in-word?) (not ws?))) - (new-words (if word-start? (+ words 1) words))) - (loop (if nl? (+ lines 1) lines) - new-words - (+ bytes byte-count) - (+ chars 1) - (if nl? (max max-line line-len) max-line) - (if nl? 0 (+ line-len 1)) - (not ws?))))))))) + (let ((buf (make-bytevector 65536))) + (let loop ((lines 0) (words 0) (bytes 0) (chars 0) + (max-line 0) (line-len 0) (in-word? #f)) + (let ((n (get-bytevector-n! port buf 0 65536))) + (if (eof-object? n) + (values lines words bytes chars (max max-line line-len)) + ;; Scan the block + (let scan ((i 0) (l lines) (w words) (c chars) + (ml max-line) (ll line-len) (iw? in-word?)) + (if (>= i n) + (loop l w (+ bytes n) c ml ll iw?) + (let ((b (bytevector-u8-ref buf i))) + (let* ((nl? (= b 10)) + (ws? (ws-byte? b)) + (word-start? (and (not iw?) (not ws?))) + (new-w (if word-start? (+ w 1) w)) + (new-c (if (utf8-lead? b) (+ c 1) c))) + (scan (+ i 1) + (if nl? (+ l 1) l) + new-w + new-c + (if nl? (max ml ll) ml) + (if nl? 0 (+ ll 1)) + (not ws?))))))))))))) (if (equal? file "-") - (proc (current-input-port)) + (proc (standard-input-port)) (with-catch (lambda (e) (warn "~a: No such file or directory" file) (values 0 0 0 0 0)) (lambda () - (let ((port (open-input-file file))) + (let ((port (open-file-input-port file))) (try (proc port) - (finally (close-input-port port))))))))) + (finally (close-port port))))))))) (def (print-counts lines words bytes chars max-line show-lines? show-words? show-bytes?