Skip to content
Snippets Groups Projects
Commit 13ad1c59 authored by wlott's avatar wlott
Browse files

Pass the sigcontext alien into internal-error-arguments instead of a

pointer to the sigcontext.
parent 5eb910af
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;; Scott Fahlman (FAHLMAN@CMUC). ;;; Scott Fahlman (FAHLMAN@CMUC).
;;; ********************************************************************** ;;; **********************************************************************
;;; ;;;
;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pmax-vm.lisp,v 1.3 1990/11/26 15:16:43 wlott Exp $ ;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/pmax-vm.lisp,v 1.4 1990/11/26 18:55:08 wlott Exp $
;;; ;;;
;;; This file contains the PMAX specific runtime stuff. ;;; This file contains the PMAX specific runtime stuff.
;;; ;;;
...@@ -57,36 +57,29 @@ ...@@ -57,36 +57,29 @@
;;; Given the sigcontext, extract the internal error arguments from the ;;; Given the sigcontext, extract the internal error arguments from the
;;; instruction stream. ;;; instruction stream.
;;; ;;;
(defun internal-error-arguments (scp) (defun internal-error-arguments (sc)
(alien-bind ((sc (make-alien 'mach:sigcontext (alien-bind ((sc sc mach:sigcontext t))
#.(c-sizeof 'mach:sigcontext) (let ((pc (alien-access (mach:sigcontext-pc (alien-value sc)))))
scp) (declare (type system-area-pointer pc))
mach:sigcontext (when (logbitp 31
t) (alien-access (mach:sigcontext-cause (alien-value sc))))
(regs (mach:sigcontext-regs (alien-value sc)) mach:int-array t)) (setf pc (sap+ pc 4)))
(let* ((original-pc (alien-access (mach:sigcontext-pc (alien-value sc)))) (when (= (sap-ref-8 pc 4) 255)
(pc (sap+ original-pc (setf pc (sap+ pc 1)))
(+ (if (logbitp 31 (let* ((length (sap-ref-8 pc 4))
(alien-access (vector (make-array length :element-type '(unsigned-byte 8))))
(mach:sigcontext-cause (declare (type (unsigned-byte 8) length)
(alien-value sc)))) (type (simple-array (unsigned-byte 8) (*)) vector))
4 (copy-from-system-area pc (* vm:byte-bits 5)
0) vector (* vm:word-bits
(if (= (sap-ref-8 original-pc 4) 255) vm:vector-data-offset)
1 (* length vm:byte-bits))
0)))) (let* ((index 0)
(length (sap-ref-8 pc 4)) (error-number (c::read-var-integer vector index)))
(vector (make-array length :element-type '(unsigned-byte 8)))) (collect ((sc-offsets))
(copy-from-system-area pc (* vm:byte-bits 5) (loop
vector (* vm:word-bits (when (>= index length)
vm:vector-data-offset) (return))
(* length vm:byte-bits)) (sc-offsets (c::read-var-integer vector index)))
(let* ((index 0) (values error-number (sc-offsets))))))))
(error-number (c::read-var-integer vector index)))
(collect ((sc-offsets))
(loop
(when (>= index length)
(return))
(sc-offsets (c::read-var-integer vector index)))
(values error-number (sc-offsets)))))))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment