0.6.11.37:

[sbcl.git] / src / compiler / assem.lisp

diff --git a/src/compiler/assem.lisp b/src/compiler/assem.lisp
index 79b992a..83c2157 100644 (file)
--- a/src/compiler/assem.lisp
+++ b/src/compiler/assem.lisp
@@ -311,12 +311,12 @@
                                                (inst-write-dependencies inst))
                                (writes write))
                             (writes)))
-  (assert (segment-run-scheduler segment))
+  (aver (segment-run-scheduler segment))
   (let ((countdown (segment-branch-countdown segment)))
     (when countdown
       (decf countdown)
-      (assert (not (instruction-attributep (inst-attributes inst)
-                                          variable-length))))
+      (aver (not (instruction-attributep (inst-attributes inst)
+                                        variable-length))))
     (cond ((instruction-attributep (inst-attributes inst) branch)
           (unless countdown
             (setf countdown (inst-delay inst)))
@@ -336,7 +336,7 @@
 ;;; instructions would sit there until the scheduler was turned back
 ;;; on, and emitted in the wrong place).
 (defun schedule-pending-instructions (segment)
-  (assert (segment-run-scheduler segment))
+  (aver (segment-run-scheduler segment))
 
   ;; Quick blow-out if nothing to do.
   (when (and (sset-empty (segment-emittable-insts-sset segment))
@@ -565,8 +565,8 @@ p       ;; the branch has two dependents and one of them dpends on
 ;;; remove this instruction from their dependents list. If we were the
 ;;; last dependent, then that dependency can be emitted now.
 (defun note-resolved-dependencies (segment inst)
-  (assert (sset-empty (inst-read-dependents inst)))
-  (assert (sset-empty (inst-write-dependents inst)))
+  (aver (sset-empty (inst-read-dependents inst)))
+  (aver (sset-empty (inst-write-dependents inst)))
   (do-sset-elements (dep (inst-write-dependencies inst))
     ;; These are the instructions who have to be completed before our
     ;; write fires. Doesn't matter how far before, just before.
@@ -709,14 +709,7 @@ p      ;; the branch has two dependents and one of them dpends on
 ;;; necessary.
 (defun emit-byte (segment byte)
   (declare (type segment segment))
-  ;; We could use DECLARE instead of CHECK-TYPE here, but (1) CMU CL's
-  ;; inspired decision to treat DECLARE as ASSERT by default has not
-  ;; been copied by other compilers, and this code runs in the
-  ;; cross-compilation host Common Lisp, not just CMU CL, and (2)
-  ;; classic CMU CL allowed more things here than this, and I haven't
-  ;; tried to proof-read all the calls to EMIT-BYTE to ensure that
-  ;; they're passing appropriate. -- WHN 19990323
-  (check-type byte possibly-signed-assembly-unit)
+  (declare (type possibly-signed-assembly-unit byte))
   (vector-push-extend (logand byte assembly-unit-mask)
                      (segment-buffer segment))
   (incf (segment-current-posn segment))
@@ -853,7 +846,7 @@ p       ;; the branch has two dependents and one of them dpends on
               (emit-skip segment (- (ash 1 alignment) slop) fill-byte)))
           (let ((size (logand (1- (ash 1 bits))
                               (lognot (1- (ash 1 alignment))))))
-            (assert (> size 0))
+            (aver (> size 0))
             (emit-annotation segment (make-alignment bits size fill-byte))
             (emit-skip segment size fill-byte))
           (setf (segment-alignment segment) bits)
@@ -998,7 +991,7 @@ p       ;; the branch has two dependents and one of them dpends on
                 (size (- new-posn posn))
                 (old-size (alignment-size note))
                 (additional-delta (- old-size size)))
-           (assert (<= 0 size old-size))
+           (aver (<= 0 size old-size))
            (unless (zerop additional-delta)
              (setf (segment-last-annotation segment) prev)
              (incf delta additional-delta)
@@ -1387,7 +1380,7 @@ p     ;; the branch has two dependents and one of them dpends on
       (let ((forms nil))
        (dotimes (i num-bytes)
          (let ((pieces (svref bytes i)))
-           (assert pieces)
+           (aver pieces)
            (push `(emit-byte ,segment-arg
                              ,(if (cdr pieces)
                                   `(logior ,@pieces)
@@ -1445,8 +1438,7 @@ p     ;; the branch has two dependents and one of them dpends on
                        (multiple-value-bind (key var)
                            (if (consp name)
                                (values (first name) (second name))
-                               (values (intern (symbol-name name) :keyword)
-                                       name))
+                               (values (keywordicate name) name))
                          `(append (and ,supplied-p (list ',key ,var))
                                   ,(grovel state (cdr lambda-list))))))
                     (&rest