1.0.28.68: move PPC over to slimmed-down EMIT-ERROR-BREAK interface

nyef pointed out that compiler/generic/array.lisp was kinda ugly with the
#!+ condition goo it in.  This patch is the first step towards moving all
backends over to the slimmer EMIT-ERROR-BREAK interface--one that doesn't
require duplicating lots of error generation code in VOP generation
functions.

diff --git a/src/assembly/ppc/arith.lisp b/src/assembly/ppc/arith.lisp
index fd5fad9..5f99d5a 100644 (file)
--- a/src/assembly/ppc/arith.lisp
+++ b/src/assembly/ppc/arith.lisp
@@ -217,7 +217,7 @@
                           (:res quo any-reg nl2-offset)
                           (:res rem any-reg nl0-offset))
   (aver (location= rem dividend))
-  (let ((error (generate-error-code nil division-by-zero-error
+  (let ((error (generate-error-code nil 'division-by-zero-error
                                     dividend divisor)))
     (inst cmpwi divisor 0)
     (inst beq error))
@@ -242,7 +242,7 @@
                           (:res rem any-reg nl0-offset))
 
   (aver (location= rem dividend))
-  (let ((error (generate-error-code nil division-by-zero-error
+  (let ((error (generate-error-code nil 'division-by-zero-error
                                     dividend divisor)))
     (inst cmpwi divisor 0)
     (inst beq error))
@@ -267,7 +267,7 @@
                           (:res quo signed-reg nl2-offset)
                           (:res rem signed-reg nl0-offset))
 
-  (let ((error (generate-error-code nil division-by-zero-error
+  (let ((error (generate-error-code nil 'division-by-zero-error
                                     dividend divisor)))
     (inst cmpwi divisor 0)
     (inst beq error))

diff --git a/src/assembly/ppc/assem-rtns.lisp b/src/assembly/ppc/assem-rtns.lisp
index 6536197..b0b7057 100644 (file)
--- a/src/assembly/ppc/assem-rtns.lisp
+++ b/src/assembly/ppc/assem-rtns.lisp
@@ -153,7 +153,7 @@
                           (:temp target-uwp any-reg nl2-offset))
   (declare (ignore start count))
 
-  (let ((error (generate-error-code nil invalid-unwind-error)))
+  (let ((error (generate-error-code nil 'invalid-unwind-error)))
     (inst cmpwi block 0)
     (inst beq error))
 
@@ -191,7 +191,7 @@
 
   loop
 
-  (let ((error (generate-error-code nil unseen-throw-tag-error target)))
+  (let ((error (generate-error-code nil 'unseen-throw-tag-error target)))
     (inst cmpwi catch 0)
     (inst beq error))
 

diff --git a/src/compiler/generic/array.lisp b/src/compiler/generic/array.lisp
index cf0f2fd..744f89e 100644 (file)
--- a/src/compiler/generic/array.lisp
+++ b/src/compiler/generic/array.lisp
@@ -24,8 +24,8 @@
   (:save-p :compute-only)
   (:generator 1
     (error-call vop
-                #!+(or x86 x86-64) 'nil-array-accessed-error
-                #!-(or x86 x86-64) nil-array-accessed-error
+                #!+(or x86 x86-64 ppc) 'nil-array-accessed-error
+                #!-(or x86 x86-64 ppc) nil-array-accessed-error
                 object)))
 
 ;;; It shouldn't be possible to fall through to here in normal user
@@ -52,8 +52,8 @@
   (:save-p :compute-only)
   (:generator 1
     (error-call vop
-                #!+(or x86 x86-64) 'nil-array-accessed-error
-                #!-(or x86 x86-64) nil-array-accessed-error
+                #!+(or x86 x86-64 ppc) 'nil-array-accessed-error
+                #!-(or x86 x86-64 ppc) nil-array-accessed-error
                 object)))
 
 (define-vop (data-vector-ref-with-offset/simple-array-nil)
@@ -71,8 +71,8 @@
   (:save-p :compute-only)
   (:generator 1
     (error-call vop
-                #!+(or x86 x86-64) 'nil-array-accessed-error
-                #!-(or x86 x86-64) nil-array-accessed-error
+                #!+(or x86 x86-64 ppc) 'nil-array-accessed-error
+                #!-(or x86 x86-64 ppc) nil-array-accessed-error
                 object)))
 
 (define-vop (data-vector-set/simple-array-nil)
@@ -91,8 +91,8 @@
   (:save-p :compute-only)
   (:generator 1
     (error-call vop
-                #!+(or x86 x86-64) 'nil-array-accessed-error
-                #!-(or x86 x86-64) nil-array-accessed-error
+                #!+(or x86 x86-64 ppc) 'nil-array-accessed-error
+                #!-(or x86 x86-64 ppc) nil-array-accessed-error
                 object)))
 \f
 ;;; FIXME: There is probably plenty of other array stuff that looks

diff --git a/src/compiler/ppc/array.lisp b/src/compiler/ppc/array.lisp
index 81f79c0..8ae5ee1 100644 (file)
--- a/src/compiler/ppc/array.lisp
+++ b/src/compiler/ppc/array.lisp
@@ -78,7 +78,7 @@
   (:vop-var vop)
   (:save-p :compute-only)
   (:generator 5
-    (let ((error (generate-error-code vop invalid-array-index-error
+    (let ((error (generate-error-code vop 'invalid-array-index-error
                                       array bound index)))
       (inst cmplw index bound)
       (inst bge error)

diff --git a/src/compiler/ppc/call.lisp b/src/compiler/ppc/call.lisp
index e8cfc9a..b490dee 100644 (file)
--- a/src/compiler/ppc/call.lisp
+++ b/src/compiler/ppc/call.lisp
@@ -1208,7 +1208,7 @@ default-value-8
                 (:vop-var vop)
                 (:save-p :compute-only)
                 (:generator 1000
-                  (error-call vop ,error ,@args)))))
+                  (error-call vop ',error ,@args)))))
   (frob arg-count-error invalid-arg-count-error
     sb!c::%arg-count-error nargs)
   (frob type-check-error object-not-type-error sb!c::%type-check-error

diff --git a/src/compiler/ppc/cell.lisp b/src/compiler/ppc/cell.lisp
index 00bff09..c3a3fbd 100644 (file)
--- a/src/compiler/ppc/cell.lisp
+++ b/src/compiler/ppc/cell.lisp
@@ -54,7 +54,7 @@
   (:generator 9
     (move obj-temp object)
     (loadw value obj-temp symbol-value-slot other-pointer-lowtag)
-    (let ((err-lab (generate-error-code vop unbound-symbol-error obj-temp)))
+    (let ((err-lab (generate-error-code vop 'unbound-symbol-error obj-temp)))
       (inst cmpwi value unbound-marker-widetag)
       (inst beq err-lab))))
 
@@ -115,7 +115,7 @@
     (move obj-temp object)
     (loadw value obj-temp fdefn-fun-slot other-pointer-lowtag)
     (inst cmpw value null-tn)
-    (let ((err-lab (generate-error-code vop undefined-fun-error obj-temp)))
+    (let ((err-lab (generate-error-code vop 'undefined-fun-error obj-temp)))
       (inst beq err-lab))))
 
 (define-vop (set-fdefn-fun)

diff --git a/src/compiler/ppc/macros.lisp b/src/compiler/ppc/macros.lisp
index 06f3226..e566001 100644 (file)
--- a/src/compiler/ppc/macros.lisp
+++ b/src/compiler/ppc/macros.lisp
@@ -252,62 +252,36 @@
 
 \f
 ;;;; Error Code
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defun emit-error-break (vop kind code values)
-    (let ((vector (gensym)))
-      `((let ((vop ,vop))
-          (when vop
-            (note-this-location vop :internal-error)))
-        (inst unimp ,kind)
-        (with-adjustable-vector (,vector)
-          (write-var-integer (error-number-or-lose ',code) ,vector)
-          ,@(mapcar #'(lambda (tn)
-                        `(let ((tn ,tn))
-                           (write-var-integer (make-sc-offset (sc-number
-                                                               (tn-sc tn))
-                                                              (tn-offset tn))
-                                              ,vector)))
-                    values)
-          (inst byte (length ,vector))
-          (dotimes (i (length ,vector))
-            (inst byte (aref ,vector i))))
-        (emit-alignment word-shift)))))
-
-(defmacro error-call (vop error-code &rest values)
+(defun emit-error-break (vop kind code values)
+  (assemble ()
+    (when vop
+      (note-this-location vop :internal-error))
+    (inst unimp kind)
+    (with-adjustable-vector (vector)
+      (write-var-integer code vector)
+      (dolist (tn values)
+        (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)))
+      (emit-alignment word-shift))))
+
+(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 cerror-call (vop label error-code &rest values)
-  "Cause a continuable error.  If the error is continued, execution resumes at
-  LABEL."
-  `(progn
-     ,@(emit-error-break vop cerror-trap error-code values)
-     (inst b ,label)))
-
-(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)
-       start-lab)))
-
-(defmacro generate-cerror-code (vop error-code &rest values)
-  "Generate-CError-Code Error-code Value*
-  Emit code for a continuable error with the specified Error-Code and
-  context Values.  If the error is continued, execution resumes after
-  the GENERATE-CERROR-CODE form."
-  (with-unique-names (continue error)
-    `(let ((,continue (gen-label)))
-       (emit-label ,continue)
-       (assemble (*elsewhere*)
-         (let ((,error (gen-label)))
-           (emit-label ,error)
-           (cerror-call ,vop ,continue ,error-code ,@values)
-           ,error)))))
+  (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)))
 \f
 ;;;; PSEUDO-ATOMIC
 

diff --git a/src/compiler/ppc/move.lisp b/src/compiler/ppc/move.lisp
index b410c4c..966925b 100644 (file)
--- a/src/compiler/ppc/move.lisp
+++ b/src/compiler/ppc/move.lisp
@@ -123,7 +123,7 @@
   (:vop-var vop)
   (:save-p :compute-only)
   (:generator 666
-    (error-call vop object-not-type-error x type)))
+    (error-call vop 'object-not-type-error x type)))
 
 
 \f

diff --git a/src/compiler/ppc/subprim.lisp b/src/compiler/ppc/subprim.lisp
index e825565..1f3c090 100644 (file)
--- a/src/compiler/ppc/subprim.lisp
+++ b/src/compiler/ppc/subprim.lisp
@@ -22,7 +22,7 @@
   (:generator 50
     (let ((done (gen-label))
           (loop (gen-label))
-          (not-list (generate-cerror-code vop object-not-list-error object)))
+          (not-list (gen-label)))
       (move ptr object)
       (move count zero-tn)
 
@@ -37,7 +37,8 @@
       (inst addi count count (fixnumize 1))
       (test-type ptr loop nil (list-pointer-lowtag) :temp temp)
 
-      (cerror-call vop done object-not-list-error ptr)
+      (emit-label not-list)
+      (error-call vop 'object-not-list-error ptr)
 
       (emit-label done)
       (move result count))))

diff --git a/src/compiler/ppc/type-vops.lisp b/src/compiler/ppc/type-vops.lisp
index 2780264..4e46b6d 100644 (file)
--- a/src/compiler/ppc/type-vops.lisp
+++ b/src/compiler/ppc/type-vops.lisp
@@ -144,7 +144,7 @@
                                                 ((lowtag-mask) type-codes)))
                          (move result value))
                        `((let ((err-lab
-                                (generate-error-code vop ,error-code value)))
+                                (generate-error-code vop ',error-code value)))
                            (test-type value err-lab t (,@type-codes) :temp temp)
                            (move result value))))))))
        ,@(when ptype
@@ -175,7 +175,7 @@
 
 (define-vop (check-signed-byte-32 check-type)
   (:generator 45
-    (let ((nope (generate-error-code vop object-not-signed-byte-32-error value))
+    (let ((nope (generate-error-code vop 'object-not-signed-byte-32-error value))
           (yep (gen-label)))
       (inst andi. temp value #x3)
       (inst beq yep)
@@ -239,7 +239,7 @@
 (define-vop (check-unsigned-byte-32 check-type)
   (:generator 45
     (let ((nope
-           (generate-error-code vop object-not-unsigned-byte-32-error value))
+           (generate-error-code vop 'object-not-unsigned-byte-32-error value))
           (yep (gen-label))
           (fixnum (gen-label))
           (single-word (gen-label)))
@@ -299,7 +299,7 @@
 (define-vop (check-symbol check-type)
   (:generator 12
     (let ((drop-thru (gen-label))
-          (error (generate-error-code vop object-not-symbol-error value)))
+          (error (generate-error-code vop 'object-not-symbol-error value)))
       (inst cmpw value null-tn)
       (inst beq drop-thru)
       (test-type value error t (symbol-header-widetag) :temp temp)
@@ -318,7 +318,7 @@
 
 (define-vop (check-cons check-type)
   (:generator 8
-    (let ((error (generate-error-code vop object-not-cons-error value)))
+    (let ((error (generate-error-code vop 'object-not-cons-error value)))
       (inst cmpw value null-tn)
       (inst beq error)
       (test-type value error t (list-pointer-lowtag) :temp temp)

diff --git a/src/compiler/ppc/values.lisp b/src/compiler/ppc/values.lisp
index beb3057..7f868c1 100644 (file)
--- a/src/compiler/ppc/values.lisp
+++ b/src/compiler/ppc/values.lisp
@@ -105,7 +105,7 @@
       (inst addi csp-tn csp-tn n-word-bytes)
       (storew temp csp-tn -1)
       (test-type list loop nil (list-pointer-lowtag) :temp ndescr)
-      (error-call vop bogus-arg-to-values-list-error list)
+      (error-call vop 'bogus-arg-to-values-list-error list)
 
       (emit-label done)
       (inst sub count csp-tn start))))

diff --git a/version.lisp-expr b/version.lisp-expr
index 564e940..7d7fe8c 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.28.67"
+"1.0.28.68"