1.0.31.20: smaller code for failing ECASE/ETYPECASE

(ERROR 'CASE-FAILURE ...) generates a lot of code.  Commonize the code in
a CASE-FAILURE function and have the macros call that function instead.
This change results in fewer entries in the constant vector and smaller
code since fewer arguments have to be loaded.  This makes the error case
slightly slower, but that's not a problem.

Shrinks core size by ~160K on x86-64.

diff --git a/src/code/macros.lisp b/src/code/macros.lisp
index 731d81f..6adf8ef 100644 (file)
--- a/src/code/macros.lisp
+++ b/src/code/macros.lisp
@@ -303,11 +303,7 @@ invoked. In that case it will store into PLACE and start over."
          (cond
           ,@(nreverse clauses)
           ,@(if errorp
-                `((t (error 'case-failure
-                            :name ',name
-                            :datum ,keyform-value
-                            :expected-type ',expected-type
-                            :possibilities ',keys))))))))
+                `((t (case-failure ',name ,keyform-value ',keys))))))))
 ) ; EVAL-WHEN
 
 (defmacro-mundanely case (keyform &body cases)

diff --git a/src/code/target-error.lisp b/src/code/target-error.lisp
index 659ed28..035d44a 100644 (file)
--- a/src/code/target-error.lisp
+++ b/src/code/target-error.lisp
@@ -176,6 +176,15 @@ with that condition (or with no condition) will be returned."
         :interactive read-evaluated-form
         value))))
 
+(defun case-failure (name value keys)
+  (error 'case-failure
+         :name name
+         :datum value
+         :expected-type (if (eq name 'ecase)
+                            `(member ,@keys)
+                            `(or ,@keys))
+         :possibilities keys))
+
 (defun case-body-error (name keyform keyform-value expected-type keys)
   (restart-case
       (error 'case-failure

diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 60ac39a..58d6309 100644 (file)
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -1427,6 +1427,7 @@
 ;; FIXME: This function does not return, but due to the implementation
 ;; of FILTER-LVAR we cannot write it here.
 (defknown %compile-time-type-error (t t t) *)
+(defknown sb!kernel::case-failure (t t t) nil)
 
 (defknown %odd-key-args-error () nil)
 (defknown %unknown-key-arg-error (t) nil)

diff --git a/version.lisp-expr b/version.lisp-expr
index 989c2b9..7da4cbc 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.31.19"
+"1.0.31.20"