1.0.23.52: FORMAT performance tweaking

 * Handle plain ~D using explicitly bindings and OUTPUT-OBJECT to
   avoid paying for WRITE keyword argument parsing.

 * Compile format control strings when SPEED = SPACE.

 * Always transform FORMAT calls when the second argument is a
   function -- trying to save space there doesn't make much sense.

diff --git a/NEWS b/NEWS
index e826d51..9683e65 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -4,6 +4,9 @@
   * new feature: the system now signals a continuable error if standard
     readtable modification is attempted.
   * optimization: faster generic arithmetic dispatch on x86 and x86-64.
+  * optimization: unmodified FORMAT ~D is now approximately 5% faster.
+  * tradeoff: constant FORMAT control strings are now compiled unless
+    SPACE > SPEED (previously only when SPEED > SPACE.)
   * bug fix: Red Hat Enterprise 3 mmap randomization workaround. (thanks
     to Thomas Burdick)
   * bug fix: DEFCLASS and ENSURE-CLASS-USING-CLASS are now expected to

diff --git a/src/code/late-format.lisp b/src/code/late-format.lisp
index 7ed479b..8c5c0c5 100644 (file)
--- a/src/code/late-format.lisp
+++ b/src/code/late-format.lisp
@@ -483,8 +483,10 @@
         `(format-print-integer stream ,(expand-next-arg) ,colonp ,atsignp
                                ,base ,mincol ,padchar ,commachar
                                ,commainterval))
-      `(write ,(expand-next-arg) :stream stream :base ,base :radix nil
-              :escape nil)))
+      `(let ((*print-base* ,base)
+             (*print-radix* nil)
+             (*print-escape* nil))
+         (output-object ,(expand-next-arg) stream))))
 
 (def-format-directive #\D (colonp atsignp params)
   (expand-format-integer 10 colonp atsignp params))

diff --git a/src/code/target-format.lisp b/src/code/target-format.lisp
index 890b943..67fc813 100644 (file)
--- a/src/code/target-format.lisp
+++ b/src/code/target-format.lisp
@@ -290,7 +290,10 @@
            params
          (format-print-integer stream (next-arg) colonp atsignp ,base mincol
                                padchar commachar commainterval))
-       (write (next-arg) :stream stream :base ,base :radix nil :escape nil)))
+       (let ((*print-base* ,base)
+             (*print-radix* nil)
+             (*print-escape* nil))
+         (output-object (next-arg) stream))))
 
 (def-format-interpreter #\D (colonp atsignp params)
   (interpret-format-integer 10))

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index b17b404..f94f1d0 100644 (file)
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -3816,7 +3816,7 @@
 ;;; error messages, and those don't need to be particularly fast.
 #+sb-xc
 (deftransform format ((dest control &rest args) (t simple-string &rest t) *
-                      :policy (> speed space))
+                      :policy (>= speed space))
   (unless (constant-lvar-p control)
     (give-up-ir1-transform "The control string is not a constant."))
   (let ((arg-names (make-gensym-list (length args))))
@@ -3824,15 +3824,13 @@
        (declare (ignore control))
        (format dest (formatter ,(lvar-value control)) ,@arg-names))))
 
-(deftransform format ((stream control &rest args) (stream function &rest t) *
-                      :policy (> speed space))
+(deftransform format ((stream control &rest args) (stream function &rest t))
   (let ((arg-names (make-gensym-list (length args))))
     `(lambda (stream control ,@arg-names)
        (funcall control stream ,@arg-names)
        nil)))
 
-(deftransform format ((tee control &rest args) ((member t) function &rest t) *
-                      :policy (> speed space))
+(deftransform format ((tee control &rest args) ((member t) function &rest t))
   (let ((arg-names (make-gensym-list (length args))))
     `(lambda (tee control ,@arg-names)
        (declare (ignore tee))

diff --git a/tests/print.impure.lisp b/tests/print.impure.lisp
index d1ccc01..81cb0f3 100644 (file)
--- a/tests/print.impure.lisp
+++ b/tests/print.impure.lisp
@@ -414,7 +414,8 @@
 (assert (string= (format nil (formatter "~:C") #\a) "a"))
 
 ;;; This used to trigger an AVER instead.
-(assert (raises-error? (format t "~>") sb-format:format-error))
+(assert (raises-error? (eval '(formatter "~>")) sb-format:format-error))
+(assert (raises-error? (eval '(format t "~>")) sb-format:format-error))
 
 ;;; readably printing hash-tables, check for circularity
 (let ((x (cons 1 2))

diff --git a/version.lisp-expr b/version.lisp-expr
index f6ebf01..c374dbc 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.23.51"
+"1.0.23.52"