Description: <short summary of the patch>
 TODO: Put a short summary on the line above and replace this paragraph
 with a longer explanation of this change. Complete the meta-information
 with other relevant fields (see below for details). To make it easier, the
 information below has been extracted from the changelog. Adjust it or drop
 it.
 .
 gcl (2.6.7-99) unstable; urgency=low
 .
   * case default error checking
Author: Camm Maguire <camm@debian.org>

---
The information above should follow the Patch Tagging Guidelines, please
checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
are templates for supplementary fields that you might want to add:

Origin: <vendor|upstream|other>, <url of original patch>
Bug: <url in upstream bugtracker>
Bug-Debian: http://bugs.debian.org/<bugnumber>
Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber>
Forwarded: <no|not-needed|url proving that it has been forwarded>
Reviewed-By: <name and email of someone who approved the patch>
Last-Update: <YYYY-MM-DD>

--- gcl-2.6.7.orig/lsp/gcl_evalmacros.lsp
+++ gcl-2.6.7/lsp/gcl_evalmacros.lsp
@@ -254,20 +254,33 @@
                         (go ,label))))
   )
 
-(defmacro case (keyform &rest clauses &aux (form nil) (key (gensym)))
-  (dolist (clause (reverse clauses) `(let ((,key ,keyform)) ,form))
-          (declare (object clause))
-    (cond ((or (eq (car clause) 't) (eq (car clause) 'otherwise))
-           (setq form `(progn ,@(cdr clause))))
-          ((consp (car clause))
-           (setq form `(if (member ,key ',(car clause))
-                           (progn ,@(cdr clause))
-                           ,form)))
-          ((car clause)
-           (setq form `(if (eql ,key ',(car clause))
-                           (progn ,@(cdr clause))
-                           ,form)))))
-  )
+(defmacro case (keyform &rest clauses &aux (key (load-time-value (gensym "CASE"))) (c (reverse clauses)))
+  (declare (optimize (safety 2)))
+  (labels ((sw (x) `(eql ,key ',x))(dfp (x) (or (eq x t) (eq x 'otherwise)))
+	   (v (x) (if (when (listp x) (not (cdr x))) (car x) x))
+	   (m (x c &aux (v (v x))) (if (eq v x) (cons c v) v)))
+	  `(let ((,key ,keyform))
+	     (declare (ignorable ,key))
+	     ,(let ((df (when (dfp (caar c)) (m (cdr (pop c)) 'progn))))
+		(reduce (lambda (y c &aux (a (pop c))(v (v a)))
+			  (when (dfp a) (error "default case must be last"))
+			  `(if ,(if (when (eq a v) (listp v)) (m (mapcar #'sw v) 'or) (sw v)) ,(m c 'progn) ,y))
+			c :initial-value df)))))
+
+;; (defmacro case (keyform &rest clauses &aux (form nil) (key (gensym)))
+;;   (dolist (clause (reverse clauses) `(let ((,key ,keyform)) ,form))
+;;           (declare (object clause))
+;;     (cond ((or (eq (car clause) 't) (eq (car clause) 'otherwise))
+;;            (setq form `(progn ,@(cdr clause))))
+;;           ((consp (car clause))
+;;            (setq form `(if (member ,key ',(car clause))
+;;                            (progn ,@(cdr clause))
+;;                            ,form)))
+;;           ((car clause)
+;;            (setq form `(if (eql ,key ',(car clause))
+;;                            (progn ,@(cdr clause))
+;;                            ,form)))))
+;;   )
 
 
 (defmacro return (&optional (val nil)) `(return-from nil ,val))
--- gcl-2.6.7.orig/cmpnew/gcl_cmpif.lsp
+++ gcl-2.6.7/cmpnew/gcl_cmpif.lsp
@@ -330,32 +330,55 @@
   (when (endp args) (too-few-args 'case 1 0))
   (let* ((info (make-info))
          (key-form (c1expr* (car args) info))
-         (clauses nil))
+         clauses)
     (cond ((subtypep (info-type (second key-form)) 'fixnum)
-	   (return-from c1case  (c1expr (convert-case-to-switch
-				 args default )))))
-    (dolist (clause (cdr args))
-      (cmpck (endp clause) "The CASE clause ~S is illegal." clause)
-      (case (car clause)
-            ((nil))
-            ((t otherwise)
-             (when default
-                   (cmperr (if (eq default 't)
-                               "ECASE had an OTHERWISE clause."
-                               "CASE had more than one OTHERWISE clauses.")))
-             (setq default (c1progn (cdr clause)))
-             (add-info info (cadr default)))
-            (t (let* ((keylist
-                       (cond ((consp (car clause))
-                              (mapcar #'(lambda (key) (if (symbolp key) key
-                                                          (add-object key)))
-                                      (car clause)))
-                             ((symbolp (car clause)) (list (car clause)))
-                             (t (list (add-object (car clause))))))
-                      (body (c1progn (cdr clause))))
-                 (add-info info (cadr body))
-                 (push (cons keylist body) clauses)))))
-    (list 'case info key-form (reverse clauses) (or default (c1nil)))))
+	   (return-from c1case  (c1expr (convert-case-to-switch args default )))))
+    (do ((c (cdr args) (cdr c))) ((not c))
+	(let* ((clause (car c)))
+	  (cmpck (endp clause) "The CASE clause ~S is illegal." clause)
+	  (let* ((k (pop clause))(dfp (unless default (member k '(t otherwise))))
+		 (keylist
+		  (cond ((listp k)
+			 (mapcar (lambda (key) (if (symbolp key) key (add-object key))) k))
+			((symbolp k) 
+			 (when dfp (when (cdr c) (cmperr "default case found in bad place")))
+			 (list k))
+			((list (add-object k)))))
+		 (body (c1progn clause)))
+	    (add-info info (cadr body))
+	    (if dfp (setq default body) (push (cons keylist body) clauses)))))
+    (list 'case info key-form (nreverse clauses) (or default (c1nil)))))
+
+;; (defun c1case (args &optional (default nil))
+;;   (when (endp args) (too-few-args 'case 1 0))
+;;   (let* ((info (make-info))
+;;          (key-form (c1expr* (car args) info))
+;;          (clauses nil))
+;;     (cond ((subtypep (info-type (second key-form)) 'fixnum)
+;; 	   (return-from c1case  (c1expr (convert-case-to-switch
+;; 				 args default )))))
+;;     (dolist (clause (cdr args))
+;;       (cmpck (endp clause) "The CASE clause ~S is illegal." clause)
+;;       (case (car clause)
+;;             ((nil))
+;;             ((t otherwise)
+;;              (when default
+;;                    (cmperr (if (eq default 't)
+;;                                "ECASE had an OTHERWISE clause."
+;;                                "CASE had more than one OTHERWISE clauses.")))
+;;              (setq default (c1progn (cdr clause)))
+;;              (add-info info (cadr default)))
+;;             (t (let* ((keylist
+;;                        (cond ((consp (car clause))
+;;                               (mapcar #'(lambda (key) (if (symbolp key) key
+;;                                                           (add-object key)))
+;;                                       (car clause)))
+;;                              ((symbolp (car clause)) (list (car clause)))
+;;                              (t (list (add-object (car clause))))))
+;;                       (body (c1progn (cdr clause))))
+;;                  (add-info info (cadr body))
+;;                  (push (cons keylist body) clauses)))))
+;;     (list 'case info key-form (reverse clauses) (or default (c1nil)))))
 
 (defun c2case (key-form clauses default
                &aux (cvar (next-cvar)) (*vs* *vs*) (*inline-blocks* 0))
