From: Douglas K. <sn...@us...> - 2015-01-14 18:42:35
|
The branch "master" has been updated in SBCL: via da0f20df4f4f736f6d0ce2088cdc14e99ecf5f59 (commit) from f9d204ecd1c85654f5b7fd07d16408862eedb3e6 (commit) - Log ----------------------------------------------------------------- commit da0f20df4f4f736f6d0ce2088cdc14e99ecf5f59 Author: Douglas Katzman <do...@go...> Date: Wed Jan 14 13:12:56 2015 -0500 Fix INVALID-ARG-COUNT-ERROR on x86-64 with ud2-breakpoints (Darwin). To my surprise, the "wtf?" branch of INTERNAL-ERROR was taken because INTERNAL-ERROR-ARGS was made to return one hardcoded location - dubiously named arg-count-sc instead of arg-count-sc-offset - only when the trap kind was invalid-arg-count. But VERIFY-ARG-COUNT didn't emit the new trap kind for UD2, nor use the older technique of emitting RCX's sc-offset into the instruction stream after the break. --- src/compiler/x86-64/call.lisp | 12 +----------- src/compiler/x86-64/macros.lisp | 30 +++++++++++++++++++----------- tests/compiler.pure.lisp | 5 +++++ 3 files changed, 25 insertions(+), 22 deletions(-) diff --git a/src/compiler/x86-64/call.lisp b/src/compiler/x86-64/call.lisp index da2ec0e..9280630 100644 --- a/src/compiler/x86-64/call.lisp +++ b/src/compiler/x86-64/call.lisp @@ -1339,17 +1339,7 @@ (:vop-var vop) (:save-p :compute-only) (:generator 3 - (let ((err-lab - #!+ud2-breakpoints - (generate-error-code vop 'invalid-arg-count-error) - #!-ud2-breakpoints - (assemble (*elsewhere*) - (let ((label (gen-label))) - (emit-label label) - (inst int 3) - (note-this-location vop :internal-error) - (inst byte invalid-arg-count-trap) - label)))) + (let ((err-lab (generate-error-code vop 'invalid-arg-count-error))) (cond ((not min) (if (zerop max) (inst test nargs nargs) diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp index d2ac993..017ef5f 100644 --- a/src/compiler/x86-64/macros.lisp +++ b/src/compiler/x86-64/macros.lisp @@ -287,18 +287,21 @@ (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) + (case kind + (#.invalid-arg-count-trap) ; there is no "payload" in this trap kind + (t + (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)))))) + (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 @@ -312,8 +315,13 @@ (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))) + (emit-error-break vop + (case error-code ; should be named ERROR-SYMBOL really + (invalid-arg-count-error invalid-arg-count-trap) + (t error-trap)) + (error-number-or-lose error-code) + values) + start-lab))) ;;;; PSEUDO-ATOMIC diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp index af4945d..dc1b751 100644 --- a/tests/compiler.pure.lisp +++ b/tests/compiler.pure.lisp @@ -5397,3 +5397,8 @@ (with-test (:name :constantp-on-a-literal-function-works) (assert (constantp `(the (function (list) t) ,#'car)))) + +(with-test (:name :arg-count-error) + (assert (eq :win (handler-case (funcall (intern "CONS") 1 2 3) + (sb-int:simple-program-error () :win) + (condition () :lose))))) ----------------------------------------------------------------------- hooks/post-receive -- SBCL |