perf: single/multi-char RS use bulk get-string-n reads (was read-char byte-by-byte)

ober

feef20ebef3e64f95923bc943a3ae11134728e0b

diff --git a/lib/jerboa-awk/main.sls b/lib/jerboa-awk/main.sls
index 92e9386..f635aae 100644
--- a/lib/jerboa-awk/main.sls
+++ b/lib/jerboa-awk/main.sls
@@ -29,6 +29,7 @@
   (define max-program-chars (configured-positive-int "JAWK_MAX_PROGRAM_CHARS" default-max-program-chars))
   (define max-record-chars (configured-positive-int "JAWK_MAX_RECORD_CHARS" default-max-record-chars))
   (define max-call-depth (configured-positive-int "JAWK_MAX_CALL_DEPTH" default-max-call-depth))
+  (define record-read-chunk-size 8192)
 
   (define (check-sized-string! who label value limit)
     (when (> (string-length value) limit)
@@ -232,43 +233,62 @@
                 (loop (cons line lines) #t next-total)))))))
       ((= (string-length rs) 1)
        (let ((sep (string-ref rs 0)))
-         (let loop ((chars '()) (count 0))
-           (let ((c (read-char port)))
-             (cond
-               ((eof-object? c)
-                (if (null? chars) #f
-                    (check-record-text! (list->string (reverse chars)))))
-               ((char=? c sep)
-                (check-record-text! (list->string (reverse chars))))
-               (else
-                (let ((next-count (+ count 1)))
-                  (when (> next-count max-record-chars)
-                    (error 'read-record "input record exceeds JAWK_MAX_RECORD_CHARS" next-count max-record-chars))
-                  (loop (cons c chars) next-count))))))))
+         ;; Bulk get-string-n reads replace the old char-by-char read-char loop.
+         ;; record-buffer holds (carry ready ...) for single-char RS: the car is
+         ;; the unterminated fragment carried across reads and the cdr are
+         ;; records already split off in a previous chunk.
+         (let ((rb (awk-env-record-buffer env)))
+           (let ((carry (if (pair? rb) (car rb) ""))
+                 (ready (if (pair? rb) (cdr rb) '())))
+             (if (pair? ready)
+               (begin
+                 (awk-env-record-buffer-set! env (cons carry (cdr ready)))
+                 (check-record-text! (car ready)))
+               (let loop ((carry carry))
+                 (let ((chunk (get-string-n port record-read-chunk-size)))
+                   (if (eof-object? chunk)
+                     (begin
+                       (awk-env-record-buffer-set! env '())
+                       (if (string=? carry "") #f (check-record-text! carry)))
+                     (let* ((s (if (string=? carry "") chunk (string-append carry chunk)))
+                            (pieces (split-on-char s sep))
+                            (new-carry (last-element pieces))
+                            (complete (reverse (cdr (reverse pieces)))))
+                       (when (> (string-length new-carry) max-record-chars)
+                         (error 'read-record "input record exceeds JAWK_MAX_RECORD_CHARS"
+                                (string-length new-carry) max-record-chars))
+                       (if (pair? complete)
+                         (let ((recs (check-records! complete)))
+                           (awk-env-record-buffer-set! env (cons new-carry (cdr recs)))
+                           (car recs))
+                         (loop new-carry)))))))))))
       (else
-       ;; Multi-char RS — regex split, buffered
+       ;; Multi-char RS — regex split, buffered.  Bulk get-string-n reads replace
+       ;; the old char-by-char read-char loop that consed up to 1 MiB of chars.
        (if (pair? (awk-env-record-buffer env))
          (let ((rec (car (awk-env-record-buffer env))))
            (awk-env-record-buffer-set! env (cdr (awk-env-record-buffer env)))
            rec)
-         (let loop ((chars '()) (count 0))
-           (let ((c (read-char port)))
-             (if (eof-object? c)
-               (if (null? chars) #f
-                   (let* ((all (list->string (reverse chars)))
-                          (records (check-records! (pregexp-split (env-regex env rs) all)))
-                          (records (if (and (pair? records)
-                                           (string=? (last-element records) ""))
-                                     (reverse (cdr (reverse records)))
-                                     records)))
-                     (if (null? records) #f
-                         (begin
-                           (awk-env-record-buffer-set! env (cdr records))
-                           (car records)))))
-               (let ((next-count (+ count 1)))
-                 (when (> next-count max-record-chars)
-                   (error 'read-record "input record exceeds JAWK_MAX_RECORD_CHARS" next-count max-record-chars))
-                 (loop (cons c chars) next-count)))))))))
+         (let ((out (open-output-string)) (count 0))
+           (let loop ()
+             (let ((chunk (get-string-n port record-read-chunk-size)))
+               (if (eof-object? chunk)
+                 (let* ((all (get-output-string out))
+                        (records (check-records! (pregexp-split (env-regex env rs) all)))
+                        (records (if (and (pair? records)
+                                         (string=? (last-element records) ""))
+                                   (reverse (cdr (reverse records)))
+                                   records)))
+                   (if (null? records) #f
+                       (begin
+                         (awk-env-record-buffer-set! env (cdr records))
+                         (car records))))
+                 (begin
+                   (set! count (+ count (string-length chunk)))
+                   (when (> count max-record-chars)
+                     (error 'read-record "input record exceeds JAWK_MAX_RECORD_CHARS" count max-record-chars))
+                    (put-string out chunk)
+                    (loop))))))))))
 
   (define (last-element lst)
     (if (null? (cdr lst)) (car lst) (last-element (cdr lst))))