Changeset 7718 for branches

Timestamp:

Nov 24, 2007, 6:24:00 PM (17 years ago)

Author:

Gary Byers

Message:

break->compiler-bug.

File:

• branches/working-0711/ccl/compiler/X86/x862.lisp (modified) (23 diffs)

branches/working-0711/ccl/compiler/X86/x862.lisp

@@ -48 +48 @@
   (if (eq (acode-operator x) (%nx1-operator immediate))
     (cadr x)
-    (error "~&Bug: not an immediate: ~s" x)))
+    (compiler-bug "not an immediate: ~s" x)))
 
 (defmacro with-x86-p2-declarations (declsform &body body)
@@ -251 +251 @@
        ((eq cell bottom) res)
     (if (null cell)
-      (error "Horrible compiler bug.")
+      (compiler-bug "Horrible compiler bug.")
       (if (eq (lcell-kind cell) kind)
         (push cell res)))))
@@ -347 +347 @@
 (defun x862-reverse-cr-bit (cr-bit)
   (or (svref *x862-reversed-cr-bits* cr-bit)
-      (error "Can't reverse CR bit ~d" cr-bit)))
+      (compiler-bug "Can't reverse CR bit ~d" cr-bit)))
 
 
@@ -657 +657 @@
                     (if lap-label
                       (x86-lap-label-address lap-label)
-                      (error "Missing or bad ~s label: ~s" 
-                             (if start-p 'start 'end) sym)))
+                      (compiler-bug "Missing or bad ~s label: ~s" 
+                                    (if start-p 'start 'end) sym)))
                   x8664::fulltag-function)))
           (destructuring-bind (var sym startlab endlab) info
@@ -1100 +1100 @@
               (x862-form seg nil nil f ))
             (apply fn seg vreg xfer (%cdr form)))
-          (error "x862-form ? ~s" form))))))
+          (compiler-bug "x862-form ? ~s" form))))))
 
 ;;; dest is a float reg - form is acode
 (defun x862-form-float (seg freg xfer form)
   (declare (ignore xfer))
-  (when (or (nx-null form)(nx-t form))(error "x862-form to freg ~s" form))
+  (when (or (nx-null form)(nx-t form))(compiler-bug "x862-form to freg ~s" form))
   (when (and (= (get-regspec-mode freg) hard-reg-class-fpr-mode-double)
              (x862-form-typep form 'double-float))
@@ -1114 +1114 @@
              (setq fn (svref *x862-specials* (%ilogand #.operator-id-mask (acode-operator form)))))      
       (apply fn seg freg nil (%cdr form))
-      (error "x862-form ? ~s" form))))
+      (compiler-bug "x862-form ? ~s" form))))
 
 
@@ -2483 +2483 @@
       (when tail-p
         #-no-compiler-bugs
-        (unless (or immp symp lfunp (typep fn 'lreg) (fixnump fn)) (error "Well, well, well.  How could this have happened ?"))
+        (unless (or immp symp lfunp (typep fn 'lreg) (fixnump fn)) (compiler-bug "Well, well, well.  How could this have happened ?"))
         (when a-reg
           (x862-copy-register seg destreg a-reg))
@@ -2505 +2505 @@
           (if (x862-mvpass-p xfer)
             (let* ((call-reg (if symp ($ x8664::fname) ($ x8664::temp0))))
-              (unless mvpass-label (error "bug: no label for mvpass"))
+              (unless mvpass-label (compiler-bug "no label for mvpass"))
               (if label-p
                 (x862-copy-register seg call-reg ($ x8664::fn))
@@ -2877 +2877 @@
                ($ x8664::arg_z)
                (make-wired-lreg x8664::imm0 :mode mode)))
-            (t (error "Unknown register class for reg ~s" reg))))))
+            (t (compiler-bug "Unknown register class for reg ~s" reg))))))
 
 ;;; The compiler often generates superfluous pushes & pops.  Try to
@@ -3963 +3963 @@
       (progn
         (when (%ilogbitp $vbitpunted bits)
-          (error "bind-var: var ~s was punted" var))
+          (compiler-bug "bind-var: var ~s was punted" var))
         (when make-vcell
           (with-node-target (x8664::allocptr) closed
@@ -3999 +3999 @@
                    (not (logbitp $vbitpunted bits))))
       (let ((endnote (%car (%cdddr (assq var *x862-recorded-symbols*)))))
-        (unless endnote (error "x862-close-var for ~s" (var-name var)))
+        (unless endnote (compiler-bug "x862-close-var for ~s" (var-name var)))
         (setf (vinsn-note-class endnote) :end-variable-scope)
         (append-dll-node (vinsn-note-label endnote) seg)))))
@@ -4708 +4708 @@
                            (x862-decode-stack (aref *x862-undo-stack* target-catch))))
     (if (%i< 0 (setq diff (%i- current-cstack target-cstack)))
-      (error "Bug: adjust foreign stack ?"))
+      (compiler-bug "Bug: adjust foreign stack ?"))
     (if (%i< 0 (setq diff (%i- current-vstack target-vstack)))
       (with-x86-local-vinsn-macros (seg)
@@ -4983 +4983 @@
                   (incf num-c-frames))
                 (if (%i> cstack target-cstack)
-                  (error "bug: adjust foreign stack ??"))
+                  (compiler-bug "bug: adjust foreign stack ??"))
                 ;; else what's going on? $sp-stkcons, for one thing
                 (setq cstack target-cstack)))
@@ -5024 +5024 @@
       (declare (fixnum numopt nkeys numreq vtotal doadlword))
       (when (or (> numreq 255) (> numopt 255) (> nkeys 255))
-        (error "A lambda list can contain a maximum of 255 required, 255 optional, and 255 keywords args"))
+        (compiler-bug "A lambda list can contain a maximum of 255 required, 255 optional, and 255 keywords args"))
       (if (fixnump listform)
         (x862-store-ea seg listform argreg)
@@ -5267 +5267 @@
                         (backend-lisp-context-register *target-backend*)
                         (or (assq valform unique-labels)
-                            (error
+                            (compiler-bug
                              "unknown vinsn label ~s" valform))))
                      ((atom valform) valform)
@@ -5317 +5317 @@
                          (unless (eval-predicate pred)
                            (return nil))))
-                 (t (error "Unknown predicate: ~s" f))))
+                 (t (compiler-bug "Unknown predicate: ~s" f))))
              (expand-pseudo-op (f)
                (destructuring-bind (directive arg) f
@@ -5345 +5345 @@
                          (:quad (frag-list-push-64 frag-list 0)
                                 (setq reloctype :expr64))
-                         ((:align :talign) (error "~s expression ~s not constant" directive arg)))
+                         ((:align :talign) (compiler-bug "~s expression ~s not constant" directive arg)))
                        (when reloctype
                          (push
@@ -5358 +5358 @@
                  (emit-x86-lap-label frag-list (assq f unique-labels))
                  (if (atom f)
-                   (error "Invalid form in vinsn body: ~s" f)
+                   (compiler-bug "Invalid form in vinsn body: ~s" f)
                    (if (atom (car f))
                      (if (keywordp (car f))
@@ -5740 +5740 @@
 (defx862 x862-%primitive %primitive (seg vreg xfer &rest ignore)
   (declare (ignore seg vreg xfer ignore))
-  (error "You're probably losing big: using %primitive ..."))
+  (compiler-bug "You're probably losing big: using %primitive ..."))
 
 (defx862 x862-consp consp (seg vreg xfer cc form)
@@ -6225 +6225 @@
             (and nil (format t "~& could use cell ~s for var ~s" cell (var-name varnode)))
             (if (logbitp x862-debug-verbose-bit *x862-debug-mask*)
-              (break "wrong ea for lcell for var ~s: got ~d, expected ~d" 
-                     (var-name varnode) (calc-lcell-offset cell) (logand ea-or-form #xffff))))
+              (compiler-bug "wrong ea for lcell for var ~s: got ~d, expected ~d" 
+                            (var-name varnode) (calc-lcell-offset cell) (logand ea-or-form #xffff))))
           (if (not cell)
             (when (memory-spec-p ea-or-form)
               (if (logbitp x862-debug-verbose-bit *x862-debug-mask*)
-                (format t "~& no lcell for ~s." (var-name varnode))))))
-        
+                (compiler-bug "no lcell for ~s." (var-name varnode))))))
         (unless (or (typep ea-or-form 'lreg) (fixnump ea-or-form))
-          (break "bogus ref to var ~s (~s) : ~s " varnode (var-name varnode) ea-or-form))
+          (compiler-bug "bogus ref to var ~s (~s) : ~s " varnode (var-name varnode) ea-or-form))
         (x862-do-lexical-reference seg vreg ea-or-form)
         (^)))))
@@ -6239 +6238 @@
 (defx862 x862-setq-lexical setq-lexical (seg vreg xfer varspec form)
   (let* ((ea (var-ea varspec)))
-    ;(unless (fixnump ea) (break "setq lexical is losing BIG"))
+    ;(unless (fixnump ea) compiler-bug "setq lexical is losing BIG"))
     (let* ((valreg (x862-one-untargeted-reg-form seg form (if (and (register-spec-p ea) 
                                                                    (or (null vreg) (eq ea vreg)))
@@ -6268 +6267 @@
         (if (= class hard-reg-class-crf)
           (progn
-            ;(break "Would have clobbered a GPR!")
+            ;compiler-bug "Would have clobbered a GPR!")
             (x862-branch seg (x862-cd-true xfer)))
           (progn
@@ -8077 +8076 @@
     (progn
       (unless (logbitp (hard-regspec-value vreg) *backend-imm-temps*)
-        (error "I give up.  When will I get this right ?"))
+        (compiler-bug "I give up.  When will I get this right ?"))
       (let* ((natural-reg (x862-one-targeted-reg-form seg 
                                                       form