X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fmacros.lisp;h=9857d1543137040a6464468cf7b24fe0cbe1346f;hb=9b1fade83db8453b75b8c7380eb12ce41b5b889c;hp=6c53ab48288d3382a6290ffa391ec30f2d1ed57c;hpb=dee739730210c96a20c15a3e08c831c9615ac95f;p=sbcl.git

diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp
index 6c53ab4..9857d15 100644
--- a/src/compiler/x86-64/macros.lisp
+++ b/src/compiler/x86-64/macros.lisp
@@ -230,55 +230,48 @@
       ,@forms)))
 
 ;;;; error code
-(eval-when (#-sb-xc :compile-toplevel :load-toplevel :execute)
-  (defun emit-error-break (vop kind code values)
-    (let ((vector (gensym)))
-      `((progn
-          #!-darwin (inst int 3)                  ; i386 breakpoint instruction
-          ;; On Darwin, we need to use #x0b0f instead of int3 in order
-          ;; to generate a SIGILL instead of a SIGTRAP as darwin/x86
-          ;; doesn't seem to be reliably firing SIGTRAP
-          ;; handlers. Hopefully this will be fixed by Apple at a
-          ;; later date. Do the same on x86-64 as we do on x86 until this gets
-          ;; sorted out.
-          #!+darwin (inst word #x0b0f))
-
-        ;; The return PC points here; note the location for the debugger.
-        (let ((vop ,vop))
-          (when vop
-                (note-this-location vop :internal-error)))
-        (inst byte ,kind)                       ; eg trap_Xyyy
-        (with-adjustable-vector (,vector)       ; interr arguments
-          (write-var-integer (error-number-or-lose ',code) ,vector)
-          ,@(mapcar (lambda (tn)
-                      `(let ((tn ,tn))
-                         ;; classic CMU CL comment:
-                         ;;   zzzzz jrd here. tn-offset is zero for constant
-                         ;;   tns.
-                         (write-var-integer (make-sc-offset (sc-number
-                                                             (tn-sc tn))
-                                                            (or (tn-offset tn)
-                                                                0))
-                                            ,vector)))
-                    values)
-          (inst byte (length ,vector))
-          (dotimes (i (length ,vector))
-            (inst byte (aref ,vector i))))))))
-
-(defmacro error-call (vop error-code &rest values)
+(defun emit-error-break (vop kind code values)
+  (assemble ()
+    #!-darwin
+    (inst int 3)                  ; i386 breakpoint instruction
+    ;; On Darwin, we need to use #x0b0f instead of int3 in order
+    ;; to generate a SIGILL instead of a SIGTRAP as darwin/x86
+    ;; doesn't seem to be reliably firing SIGTRAP
+    ;; handlers. Hopefully this will be fixed by Apple at a
+    ;; later date. Do the same on x86-64 as we do on x86 until this gets
+    ;; sorted out.
+    #!+darwin
+    (inst word #x0b0f)
+    ;; The return PC points here; note the location for the debugger.
+    (when vop
+      (note-this-location vop :internal-error))
+    (inst byte kind)                       ; eg trap_Xyyy
+    (with-adjustable-vector (vector)       ; interr arguments
+      (write-var-integer code vector)
+      (dolist (tn values)
+        ;; classic CMU CL comment:
+        ;;   zzzzz jrd here. tn-offset is zero for constant
+        ;;   tns.
+        (write-var-integer (make-sc-offset (sc-number (tn-sc tn))
+                                           (or (tn-offset tn) 0))
+                           vector))
+      (inst byte (length vector))
+      (dotimes (i (length vector))
+        (inst byte (aref vector i))))))
+
+(defun error-call (vop error-code &rest values)
   #!+sb-doc
   "Cause an error. ERROR-CODE is the error to cause."
-  (cons 'progn
-        (emit-error-break vop error-trap error-code values)))
+  (emit-error-break vop error-trap (error-number-or-lose error-code) values))
 
-(defmacro generate-error-code (vop error-code &rest values)
+(defun generate-error-code (vop error-code &rest values)
   #!+sb-doc
   "Generate-Error-Code Error-code Value*
   Emit code for an error with the specified Error-Code and context Values."
-  `(assemble (*elsewhere*)
-     (let ((start-lab (gen-label)))
-       (emit-label start-lab)
-       (error-call ,vop ,error-code ,@values)
+  (assemble (*elsewhere*)
+    (let ((start-lab (gen-label)))
+      (emit-label start-lab)
+      (emit-error-break vop error-trap (error-number-or-lose error-code) values)
        start-lab)))
 
 
@@ -290,9 +283,8 @@
 ;;; place and there's no logical single place to attach documentation.
 ;;; grep (mostly in src/runtime) is your friend
 
-;;; FIXME: THIS NAME IS BACKWARDS!
-(defmacro maybe-pseudo-atomic (really-p &body body)
-  `(if ,really-p
+(defmacro maybe-pseudo-atomic (not-really-p &body body)
+  `(if ,not-really-p
        (progn ,@body)
        (pseudo-atomic ,@body)))