:operands (list this that)))
(deferr object-not-type-error (object type)
- (error (if (and (%instancep object)
- (layout-invalid (%instance-layout object)))
- 'layout-invalid
- 'type-error)
- :datum object
- :expected-type type))
+ (if (invalid-array-p object)
+ (invalid-array-error object)
+ (error (if (and (%instancep object)
+ (layout-invalid (%instance-layout object)))
+ 'layout-invalid
+ 'type-error)
+ :datum object
+ :expected-type type)))
(deferr layout-invalid-error (object layout)
(error 'layout-invalid
:datum object
:expected-type '(complex long-float)))
+#!+sb-simd-pack
+(deferr object-not-simd-pack-error (object)
+ (error 'type-error
+ :datum object
+ :expected-type 'simd-pack))
+
(deferr object-not-weak-pointer-error (object)
(error 'type-error
:datum object
(/show0 "trapped DEBUG-CONDITION")
(values "<error finding interrupted name -- trapped debug-condition>"
nil)))))
+
+(defun find-caller-of-named-frame (name)
+ (unless *finding-name*
+ (handler-case
+ (let ((*finding-name* t))
+ (do ((frame (sb!di:top-frame) (sb!di:frame-down frame)))
+ ((null frame))
+ (when (and (sb!di::compiled-frame-p frame)
+ (eq name (sb!di:debug-fun-name
+ (sb!di:frame-debug-fun frame))))
+ (let ((caller (sb!di:frame-down frame)))
+ (sb!di:flush-frames-above caller)
+ (return caller)))))
+ ((or error sb!di:debug-condition) ()
+ nil)
+ (sb!di:debug-condition ()
+ nil))))
\f
;;;; INTERNAL-ERROR signal handler
(/hexstr context)
(infinite-error-protect
(/show0 "about to bind ALIEN-CONTEXT")
- (let ((alien-context (locally
- (declare (optimize (inhibit-warnings 3)))
- (sb!alien:sap-alien context (* os-context-t)))))
+ (let* ((alien-context (locally
+ (declare (optimize (inhibit-warnings 3)))
+ (sb!alien:sap-alien context (* os-context-t))))
+ #!+c-stack-is-control-stack
+ (*saved-fp-and-pcs*
+ (cons (cons (%make-lisp-obj (sb!vm:context-register
+ alien-context
+ sb!vm::cfp-offset))
+ (sb!vm:context-pc alien-context))
+ (when (boundp '*saved-fp-and-pcs*)
+ *saved-fp-and-pcs*))))
+ (declare (truly-dynamic-extent *saved-fp-and-pcs*))
(/show0 "about to bind ERROR-NUMBER and ARGUMENTS")
(multiple-value-bind (error-number arguments)
(sb!vm:internal-error-args alien-context)
(error 'undefined-alien-function-error))
#!-win32
-(define-alien-variable current-memory-fault-address unsigned-long)
+(define-alien-variable current-memory-fault-address unsigned)
#!-win32
(defun memory-fault-error ()