X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Finterr.lisp;h=f6b1692c96dc94abe49298ed4821fb7092ad5567;hb=cee8ef591040db9a79cdd19297867672a9529051;hp=3e0e9aef5b927193d5eaf7457e3e1ec7ee51ab3b;hpb=6e60dc9f79037ab84f5bfd8568979c24291c9922;p=sbcl.git diff --git a/src/code/interr.lisp b/src/code/interr.lisp index 3e0e9ae..f6b1692 100644 --- a/src/code/interr.lisp +++ b/src/code/interr.lisp @@ -183,6 +183,17 @@ (symbol fdefn-or-symbol) (fdefn (fdefn-name fdefn-or-symbol))))) +#!+x86-64 +(deferr undefined-alien-fun-error (address) + (error 'undefined-alien-function-error + :name + (and (integerp address) + (sap-foreign-symbol (int-sap address))))) + +#!-x86-64 +(defun undefined-alien-fun-error () + (error 'undefined-alien-function-error)) + (deferr invalid-arg-count-error (nargs) (error 'simple-program-error :format-control "invalid number of arguments: ~S" @@ -330,6 +341,12 @@ :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 @@ -401,9 +418,8 @@ (do ((frame (sb!di:top-frame) (sb!di:frame-down frame))) ((null frame)) (when (and (sb!di::compiled-frame-p frame) - (eq name (sb!debug::clean-debug-fun-name - (sb!di:debug-fun-name - (sb!di:frame-debug-fun 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))))) @@ -422,9 +438,18 @@ (/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) @@ -510,11 +535,8 @@ (defun undefined-alien-variable-error () (error 'undefined-alien-variable-error)) -(defun undefined-alien-function-error () - (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 ()