X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1-translators.lisp;h=c8eb5e933f0d1303d78d9d8883b93404ab47aea4;hb=94ac5b7c3ff37850210b6fc9a7593cf1c5752993;hp=c749de948c317e172532837b571ad00eb4637709;hpb=510a9c48b7a80bf89ee54bdbd92519e76e8e178d;p=sbcl.git

diff --git a/src/compiler/ir1-translators.lisp b/src/compiler/ir1-translators.lisp
index c749de9..c8eb5e9 100644
--- a/src/compiler/ir1-translators.lisp
+++ b/src/compiler/ir1-translators.lisp
@@ -12,7 +12,7 @@
 
 (in-package "SB!C")
 
-;;;; control special forms
+;;;; special forms for control
 
 (def-ir1-translator progn ((&rest forms) start cont)
   #!+sb-doc
@@ -84,7 +84,6 @@
       (push env-entry (continuation-lexenv-uses cont))
       (ir1-convert-progn-body dummy cont forms))))
 
-
 (def-ir1-translator return-from ((name &optional value) start cont)
   #!+sb-doc
   "Return-From Block-Name Value-Form
@@ -356,39 +355,32 @@
 ;;; VOP or %VOP.. -- WHN 2001-06-11
 ;;; FIXME: Look at doing this ^, it doesn't look too hard actually.
 (def-ir1-translator %primitive ((name &rest args) start cont)
-  (unless (symbolp name)
-    (compiler-error "internal error: Primitive name ~S is not a symbol." name))
+  (declare (type symbol name))
   (let* ((template (or (gethash name *backend-template-names*)
-		       (compiler-error
-			"internal error: Primitive name ~A is not defined."
-			name)))
+		       (bug "undefined primitive ~A" name)))
 	 (required (length (template-arg-types template)))
 	 (info (template-info-arg-count template))
 	 (min (+ required info))
 	 (nargs (length args)))
     (if (template-more-args-type template)
 	(when (< nargs min)
-	  (compiler-error "internal error: Primitive ~A was called ~
-                           with ~R argument~:P, ~
-	    		   but wants at least ~R."
-			  name
-			  nargs
-			  min))
+	  (bug "Primitive ~A was called with ~R argument~:P, ~
+	    	but wants at least ~R."
+	       name
+	       nargs
+	       min))
 	(unless (= nargs min)
-	  (compiler-error "internal error: Primitive ~A was called ~
-                           with ~R argument~:P, ~
-			   but wants exactly ~R."
-			  name
-			  nargs
-			  min)))
+	  (bug "Primitive ~A was called with ~R argument~:P, ~
+                but wants exactly ~R."
+	       name
+	       nargs
+	       min)))
 
     (when (eq (template-result-types template) :conditional)
-      (compiler-error
-       "%PRIMITIVE was used with a conditional template."))
+      (bug "%PRIMITIVE was used with a conditional template."))
 
     (when (template-more-results-type template)
-      (compiler-error
-       "%PRIMITIVE was used with an unknown values template."))
+      (bug "%PRIMITIVE was used with an unknown values template."))
 
     (ir1-convert start
 		 cont
@@ -473,7 +465,7 @@
 ;;; FUNCALL is implemented on %FUNCALL, which can only call functions
 ;;; (not symbols). %FUNCALL is used directly in some places where the
 ;;; call should always be open-coded even if FUNCALL is :NOTINLINE.
-(deftransform funcall ((function &rest args) * * :when :both)
+(deftransform funcall ((function &rest args) * *)
   (let ((arg-names (make-gensym-list (length args))))
     `(lambda (function ,@arg-names)
        (%funcall ,(if (csubtypep (continuation-type function)
@@ -498,7 +490,6 @@
       (values nil t)))
 
 (deftransform %coerce-callable-to-fun ((thing) (function) *
-				       :when :both
 				       :important t)
   "optimize away possible call to FDEFINITION at runtime"
   'thing)