From 624077bb9547732f619d3582b33c65677445b1e0 Mon Sep 17 00:00:00 2001
From: Dimitri Fontaine <dim@tapoueh.org>
Date: Sun, 3 Aug 2014 19:48:49 +0200
Subject: [PATCH] Count bytes only once when under memory watch.

---
 src/pgsql/copy-format.lisp | 94 +++++++++++++++++++++-----------------
 src/queue.lisp             | 15 +++---
 2 files changed, 58 insertions(+), 51 deletions(-)

diff --git a/src/pgsql/copy-format.lisp b/src/pgsql/copy-format.lisp
index 6feabbd..ef10254 100644
--- a/src/pgsql/copy-format.lisp
+++ b/src/pgsql/copy-format.lisp
@@ -19,48 +19,58 @@
 See http://www.postgresql.org/docs/9.2/static/sql-copy.html#AEN66609 for
 details about the format, and format specs."
   (declare (type simple-array row))
-  (let* (*print-circle* *print-pretty*)
-    (loop
-       with nbcols = (length row)
-       for col across row
-       for i from 1
-       for more? = (< i nbcols)
-       for fn in transforms
-       for preprocessed-col = (if fn (funcall fn col) col)
-       do
-         (if (or (null preprocessed-col)
-                 ;; still accept postmodern :NULL in "preprocessed" data
-                 (eq :NULL preprocessed-col))
-             (progn
-               ;; NULL is expected as \N, two chars
-               (write-char #\\ stream) (write-char #\N stream))
-             (loop
-                ;; From PostgreSQL docs:
-                ;;
-                ;; In particular, the following characters must be preceded
-                ;; by a backslash if they appear as part of a column value:
-                ;; backslash itself, newline, carriage return, and the
-                ;; current delimiter character.
-                for byte across (cl-postgres-trivial-utf-8:string-to-utf-8-bytes preprocessed-col)
-                do (case (code-char byte)
-                     (#\\         (progn (write-char #\\ stream)
-                                         (write-char #\\ stream)))
-                     (#\Space     (write-char #\Space stream))
-                     (#\Newline   (progn (write-char #\\ stream)
-                                         (write-char #\n stream)))
-                     (#\Return    (progn (write-char #\\ stream)
-                                         (write-char #\r stream)))
-                     (#\Tab       (progn (write-char #\\ stream)
-                                         (write-char #\t stream)))
-                     (#\Backspace (progn (write-char #\\ stream)
-                                         (write-char #\b stream)))
-                     (#\Page      (progn (write-char #\\ stream)
-                                         (write-char #\f stream)))
-                     (t           (if (< 32 byte 127)
-                                      (write-char (code-char byte) stream)
-                                      (princ (format nil "\\~o" byte) stream))))))
-       when more? do (write-char #\Tab stream)
-       finally       (write-char #\Newline stream))))
+  (let* ((bytes 0) *print-circle* *print-pretty*)
+    (flet ((write-bytes (char-or-string)
+             (declare (type (or character simple-string) char-or-string))
+             ;; closes over stream and bytes, maintain the count
+             (typecase char-or-string
+               (character  (write-char char-or-string stream)
+                           (incf bytes))
+               (string     (princ char-or-string stream)
+                           (incf bytes (length char-or-string))))))
+      (declare (inline write-bytes))
+      (loop
+         with nbcols = (length row)
+         for col across row
+         for i from 1
+         for more? = (< i nbcols)
+         for fn in transforms
+         for preprocessed-col = (if fn (funcall fn col) col)
+         do
+           (if (or (null preprocessed-col)
+                   ;; still accept postmodern :NULL in "preprocessed" data
+                   (eq :NULL preprocessed-col))
+               (progn
+                 ;; NULL is expected as \N, two chars
+                 (write-bytes #\\) (write-bytes #\N))
+               (loop
+                  ;; From PostgreSQL docs:
+                  ;;
+                  ;; In particular, the following characters must be preceded
+                  ;; by a backslash if they appear as part of a column value:
+                  ;; backslash itself, newline, carriage return, and the
+                  ;; current delimiter character.
+                  for byte across (cl-postgres-trivial-utf-8:string-to-utf-8-bytes preprocessed-col)
+                  do (case (code-char byte)
+                       (#\\         (progn (write-bytes #\\)
+                                           (write-bytes #\\)))
+                       (#\Space     (write-bytes #\Space))
+                       (#\Newline   (progn (write-bytes #\\)
+                                           (write-bytes #\n)))
+                       (#\Return    (progn (write-bytes #\\)
+                                           (write-bytes #\r)))
+                       (#\Tab       (progn (write-bytes #\\)
+                                           (write-bytes #\t)))
+                       (#\Backspace (progn (write-bytes #\\)
+                                           (write-bytes #\b)))
+                       (#\Page      (progn (write-bytes #\\)
+                                           (write-bytes #\f)))
+                       (t           (if (< 32 byte 127)
+                                        (write-bytes (code-char byte))
+                                        (write-bytes (format nil "\\~o" byte)))))))
+         when more? do (write-bytes #\Tab)
+         finally       (progn (write-bytes #\Newline)
+                              (return bytes))))))
 
 
 ;;;
diff --git a/src/queue.lisp b/src/queue.lisp
index deb4be1..b8a1723 100644
--- a/src/queue.lisp
+++ b/src/queue.lisp
@@ -49,16 +49,13 @@
   ;; All the data transformation takes place here, so that we batch fully
   ;; formed COPY TEXT string ready to go in the PostgreSQL stream.
   (handler-case
-      (let ((copy-string (with-output-to-string (s)
-                           (format-vector-row s row (transforms copy)))))
-        (with-slots (data count bytes) *current-batch*
+      (with-slots (data count bytes) *current-batch*
+        (let ((copy-string
+               (with-output-to-string (s)
+                 (let ((c-s-bytes (format-vector-row s row (transforms copy))))
+                   (when *copy-batch-size* ; running under memory watch
+                     (incf bytes c-s-bytes))))))
           (setf (aref data count) copy-string)
-          (when *copy-batch-size*          ; running under memory watch
-            (incf bytes
-                  #+sbcl (length
-                          (sb-ext:string-to-octets copy-string :external-format :utf-8))
-                  #+ccl (ccl:string-size-in-octets copy-string :external-format :utf-8)
-                  #- (or sbcl ccl) (length copy-string)))
           (incf count)))
 
     (condition (e)