Hi all,

Here are two patches to restore row/column counting in read-line and
read-string, which takes care of #978.  This is a cumulative based
on the *fixed* version of read-string (see my previous post to -hackers).

I split up the patches because I'm not 100% sure it's desirable to count
port position in read-string for performance reasons.  The original
read-string simply adds the number of read characters to the column,
which will result in bogus line/column counts.  It might be preferable
to just not modify the position at all.

Just removing the port position bookkeeping altogether is better, I
think.  I haven't done any benchmarks but Chicken's notoriously awful
I/O performance might partially be due to the port position bookkeeping.

If this turns out to be true that this is a big bottleneck, it makes
sense to leave the bookkeeping up to applications.  Perhaps it could be
convenient to add a custom "counted port" that can wrap other port
types.

Our current implementation of column counting does not take into account
multibyte UTF-8 characters.  I'm not sure if we need to take care of this.
An input file might not be in UTF-8 encoding, in which case "fixing"
UTF-8 counting will cause the count to be incorrect on those files.
We could just assume all ports are UTF-8 since that's the "native"
Chicken character set.  The only way to *truly* fix this is to make
ports aware of their encoding, but that's just... annoying :)

Cheers,
Peter
-- 
http://www.more-magic.net
>From edcf73fbca897de5d645bae20b7d71de41c1ea5a Mon Sep 17 00:00:00 2001
From: Peter Bex <[email protected]>
Date: Sat, 16 Feb 2013 15:07:44 +0100
Subject: [PATCH 1/2] Restore row and column number tracking in read-line
 (partially fixes #978)

---
 library.scm   | 19 ++++++++++++-------
 posixunix.scm | 12 +++++++++---
 tcp.scm       | 10 ++++++++--
 3 files changed, 29 insertions(+), 12 deletions(-)

diff --git a/library.scm b/library.scm
index 31e1e0c..e19d031 100644
--- a/library.scm
+++ b/library.scm
@@ -3544,11 +3544,16 @@ EOF
              (end (if limit (fx+ pos limit) size)))
         (if (fx>= pos size)
             #!eof
-            (receive (next line)
+            (receive (next line full-line?)
                 (##sys#scan-buffer-line
                  buf (if (fx> end size) size end) pos
                  (lambda (pos) (values #f pos #f) ) )
-              (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1)) ; lineno
+              ;; Update row & column position
+              (if full-line?
+                  (begin
+                    (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1))
+                    (##sys#setislot p 5 0))
+                  (##sys#setislot p 5 (fx+ (##sys#slot p 5) (##sys#size 
line))))
               (##sys#setislot p 10 next)
               line) ) ) )
      (lambda (p)                       ; read-buffered
@@ -3582,26 +3587,26 @@ EOF
          (receive (buf offset limit) (eos-handler pos)
            (if buf
                (loop buf offset offset limit line)
-               (values offset line))))
+               (values offset line #f))))
        (let ((c (##core#inline "C_subchar" buf pos)))
          (cond ((eq? c #\newline)
-                (values (fx+ pos 1) (copy&append buf offset pos line)))
+                (values (fx+ pos 1) (copy&append buf offset pos line) #t))
                ((and (eq? c #\return)  ; \r\n -> drop \r from string
                      (fx> limit (fx+ pos 1))
                      (eq? (##core#inline "C_subchar" buf (fx+ pos 1)) 
#\newline))
-                (values (fx+ pos 2) (copy&append buf offset pos line)))
+                (values (fx+ pos 2) (copy&append buf offset pos line) #t))
                ((and (eq? c #\return)  ; Edge case (#568): \r{read}[\n|xyz]
                      (fx= limit (fx+ pos 1)))
                 (let ((line (copy&append buf offset pos line)))
                   (receive (buf offset limit) (eos-handler pos)
                     (if buf
                         (if (eq? (##core#inline "C_subchar" buf offset) 
#\newline)
-                            (values (fx+ offset 1) line)
+                            (values (fx+ offset 1) line #t)
                             ;; "Restore" \r we didn't copy, loop w/ new string
                             (loop buf offset offset limit
                                   (##sys#string-append line "\r")))
                         ;; Restore \r here, too (when we reached EOF)
-                        (values offset (##sys#string-append line "\r"))))))
+                        (values offset (##sys#string-append line "\r") #t)))))
                (else (loop buf offset (fx+ pos 1) limit line)) ) ) ) ) )
 
 (define (open-input-string string)
diff --git a/posixunix.scm b/posixunix.scm
index 650d2c3..82c95f9 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -1383,13 +1383,13 @@ EOF
                               (if (eq? 0 buflen) 
                                   m
                                   (loop n m start) ) ] ) ) )
-                  (lambda (port limit) ; read-line
+                  (lambda (p limit)    ; read-line
                     (when (fx>= bufpos buflen)
                       (fetch))
                     (if (fx>= bufpos buflen)
                         #!eof
                         (let ((limit (or limit (fx- (##sys#fudge 21) bufpos))))
-                          (receive (next line)
+                          (receive (next line full-line?)
                               (##sys#scan-buffer-line
                                buf
                                (fxmin buflen (fx+ bufpos limit))
@@ -1406,7 +1406,13 @@ EOF
                                                       (fxmin buflen
                                                               (fx+ bufpos 
limit)))
                                               (values #f bufpos #f)))))))
-                            (##sys#setislot port 4 (fx+ (##sys#slot port 4) 1))
+                            ;; Update row & column position
+                            (if full-line?
+                                (begin
+                                  (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1))
+                                  (##sys#setislot p 5 0))
+                                (##sys#setislot p 5 (fx+ (##sys#slot p 5)
+                                                         (##sys#size line))))
                             (set! bufpos next)
                             line)) ) )
                   (lambda (port)               ; read-buffered
diff --git a/tcp.scm b/tcp.scm
index 758c7d2..c84d639 100644
--- a/tcp.scm
+++ b/tcp.scm
@@ -434,7 +434,7 @@ EOF
                 (if (fx>= bufindex buflen)
                     #!eof
                     (let ((limit (or limit (fx- (##sys#fudge 21) bufindex))))
-                      (receive (next line)
+                      (receive (next line full-line?)
                           (##sys#scan-buffer-line
                            buf
                             (fxmin buflen (fx+ bufindex limit))
@@ -450,7 +450,13 @@ EOF
                                                        (fxmin buflen
                                                                (fx+ bufindex 
limit)))
                                                (values #f bufindex #f))))) ) )
-                        (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1)) ; lineno
+                        ;; Update row & column position
+                        (if full-line?
+                            (begin
+                              (##sys#setislot p 4 (fx+ (##sys#slot p 4) 1))
+                              (##sys#setislot p 5 0))
+                            (##sys#setislot p 5 (fx+ (##sys#slot p 5)
+                                                     (##sys#size line))))
                         (set! bufindex next)
                         line) )) )
               (lambda (p)              ; read-buffered
-- 
1.8.0.1

>From ebd31da92f9ab66d7d4b2a37b5d4e1a317fe3442 Mon Sep 17 00:00:00 2001
From: Peter Bex <[email protected]>
Date: Sat, 16 Feb 2013 15:41:45 +0100
Subject: [PATCH 2/2] Also add column/row counting to read-line

---
 extras.scm | 22 ++++++++++++++++------
 1 file changed, 16 insertions(+), 6 deletions(-)

diff --git a/extras.scm b/extras.scm
index 0e8b144..510dabb 100644
--- a/extras.scm
+++ b/extras.scm
@@ -155,12 +155,22 @@
            (if rdstring
               (let loop ((start start) (n n) (m 0))
                 (let ((n2 (rdstring port n dest start)))
-                  (##sys#setislot port 5 ; update port-position
-                                  (fx+ (##sys#slot port 5) n2))
-                  (cond ((eq? n2 0) m)
-                        ((or (not n) (fx< n2 n)) 
-                         (loop (fx+ start n2) (and n (fx- n n2)) (fx+ m n2)))
-                        (else (fx+ n2 m)))))
+                  (if (and (fx> m 0) (or (not n) (fx< n2 n)))
+                      (loop (fx+ start n2) (and n (fx- n n2)) (fx+ m n2))
+                      ;; Calculate port position
+                      (let scan ((pos 0)
+                                 (line (##sys#slot port 4))
+                                 (col (##sys#slot port 5))
+                                 (stop (fx+ n2 m)))
+                        (cond ((eq? pos stop)
+                               (##sys#setislot port 4 line)
+                               (##sys#setislot port 5 col)
+                               stop)
+                              ((eq? (##core#inline "C_subchar" dest pos)
+                                    #\newline)
+                               (scan (fx+ pos 1) (fx+ line 1) 0 stop))
+                              (else
+                               (scan (fx+ pos 1) line (fx+ col 1) stop)))))))
               (let loop ((start start) (n n) (m 0))
                 (let ((n2 (let ((c (##sys#read-char-0 port)))
                             (if (eof-object? c)
-- 
1.8.0.1

_______________________________________________
Chicken-hackers mailing list
[email protected]
https://lists.nongnu.org/mailman/listinfo/chicken-hackers

Reply via email to