Index: /trunk/ccl/level-1/l1-dcode.lisp
===================================================================
--- /trunk/ccl/level-1/l1-dcode.lisp	(revision 265)
+++ /trunk/ccl/level-1/l1-dcode.lisp	(revision 266)
@@ -746,7 +746,7 @@
         (let ((method (%find-1st-arg-combined-method dt (%lexpr-ref args args-len 0))))
 	  (%apply-lexpr-tail-wise method args))
-        (error "0 args to ~s" (%gf-dispatch-table-gf dt))))
+        (signal-program-error "0 args to ~s" (%gf-dispatch-table-gf dt))))
     (let* ()  ; happens if traced
-      (when (null args) (error "0 args to ~s" (%gf-dispatch-table-gf dt)))
+      (when (null args) (signal-program-error "0 args to ~s" (%gf-dispatch-table-gf dt)))
       (let ((method (%find-1st-arg-combined-method dt (%car args))))
         (apply method args)))))
@@ -779,10 +779,10 @@
     (let* ((args-len (list-length args))
            (argnum (%gf-dispatch-table-argnum dt)))
-      (when (< args-len argnum) (error "Too few args ~s to ~s." args-len (%gf-dispatch-table-gf dt)))
+      (when (< args-len argnum) (signal-program-error "Too few args ~s to ~s." args-len (%gf-dispatch-table-gf dt)))
       (let ((method (%find-nth-arg-combined-method dt (nth argnum args) args)))
         (apply method args)))
     (let* ((args-len (%lexpr-count args))
            (argnum (%gf-dispatch-table-argnum dt)))
-      (when (< args-len argnum) (error "Too few args ~s to ~s." args-len (%gf-dispatch-table-gf dt)))
+      (when (< args-len argnum) (signal-program-error "Too few args ~s to ~s." args-len (%gf-dispatch-table-gf dt)))
       (let ((method (%find-nth-arg-combined-method dt (%lexpr-ref args args-len argnum) args)))
 	(%apply-lexpr-tail-wise method args)))))
@@ -1198,5 +1198,5 @@
 
 (defun nth-arg-dcode-too-few-args (gf-or-cm)
-  (error "Too few args to: ~s" (combined-method-gf gf-or-cm)))
+  (signal-program-error "Too few args to: ~s" (combined-method-gf gf-or-cm)))
 
 (defun nth-arg-combined-method-trap-0 (gf-or-cm table wrapper args)
@@ -1393,5 +1393,5 @@
     (let* ((args-len (list-length args))
            (argnum (car stuff)))
-      (when (>= argnum args-len)(Error "Too few args to ~s." (%method-gf (cddr stuff))))
+      (when (>= argnum args-len)(signal-program-error  "Too few args to ~s." (%method-gf (cddr stuff))))
       (let* ((arg (nth argnum args))
              (thing (assq arg (cadr stuff)))) ; are these things methods or method-functions? - fns    
@@ -1401,5 +1401,5 @@
     (let* ((args-len (%lexpr-count args))
            (argnum (car stuff)))
-      (when (>= argnum args-len)(Error "Too few args to ~s." (%method-gf (cddr stuff))))
+      (when (>= argnum args-len)(signal-program-error "Too few args to ~s." (%method-gf (cddr stuff))))
       (let* ((arg (%lexpr-ref args args-len argnum))
              (thing (assq arg (cadr stuff)))) ; are these things methods or method-functions? - fns    
@@ -1415,5 +1415,5 @@
     (let* ((args-len (list-length args))
            (argnum (car stuff)))
-      (when (>= argnum args-len)(Error "Too few args to ~s." (%method-gf (cddr stuff))))
+      (when (>= argnum args-len)(signal-program-error "Too few args to ~s." (%method-gf (cddr stuff))))
       (let* ((arg (nth argnum args))
              (thing (assoc arg (cadr stuff)))) ; are these things methods or method-functions?    
@@ -1423,5 +1423,5 @@
     (let* ((args-len (%lexpr-count args))
            (argnum (car stuff)))
-      (when (>= argnum args-len)(Error "Too few args to ~s." (%method-gf (cddr stuff))))
+      (when (>= argnum args-len)(signal-program-error "Too few args to ~s." (%method-gf (cddr stuff))))
       (let* ((arg (%lexpr-ref args args-len argnum))
              (thing (assoc arg (cadr stuff)))) ; are these things methods or method-functions?    
@@ -1619,5 +1619,5 @@
                    ; oh screw it - old-args may be lexpr too
                    (let ((old-args (cddr magic)))
-                     (when (< args-len numreq) (error "Too few args to ~S" gf))
+                     (when (< args-len numreq) (signal-program-error "Too few args to ~S" gf))
                      (when (null (cmp-args-old-args args old-args numreq))
                        ; required args not eq - usually true, we expect