From: Nathan F. <nf...@us...> - 2005-08-19 22:21:19
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv21308/src/code Modified Files: interr.lisp mips-vm.lisp Log Message: 0.9.3.69: THS patch-mania (from sbcl-devel, title and date as noted): * "Fix race condition for initial thread startup", 16 August 2005; * "Make internal startup functions in thread.c static", 16 August 2005; * "Minor MIPS code improvements", 16 August 2005; * "MIPS C runtime fixes", 19 August 2005 * "Support stack-allocated closures on MIPS", 19 August 2005; * "Assorted minor (non-)changes", 19 August 2005. Index: interr.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/interr.lisp,v retrieving revision 1.33 retrieving revision 1.34 diff -u -d -r1.33 -r1.34 --- interr.lisp 14 Jul 2005 16:30:35 -0000 1.33 +++ interr.lisp 19 Aug 2005 22:21:02 -0000 1.34 @@ -463,4 +463,4 @@ (error 'undefined-alien-function-error)) (defun memory-fault-error () - (error 'memory-fault-error)) \ No newline at end of file + (error 'memory-fault-error)) Index: mips-vm.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/mips-vm.lisp,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- mips-vm.lisp 16 Aug 2005 12:40:31 -0000 1.8 +++ mips-vm.lisp 19 Aug 2005 22:21:02 -0000 1.9 @@ -1,6 +1,8 @@ (in-package "SB!VM") + (define-alien-type os-context-t (struct os-context-t-struct)) + ;;;; MACHINE-TYPE and MACHINE-VERSION @@ -12,6 +14,7 @@ (defun get-machine-version () #!+little-endian "little-endian" #!-little-endian "big-endian") + ;;;; FIXUP-CODE-OBJECT @@ -100,36 +103,23 @@ (let ((pc (context-pc context)) (cause (context-bd-cause-int context))) (declare (type system-area-pointer pc)) - (/show0 "got PC=..") - (/hexstr (sap-int pc)) ;; KLUDGE: This exposure of the branch delay mechanism hurts. (when (logbitp 31 cause) (setf pc (sap+ pc 4))) - (when (= (sap-ref-8 pc 4) 255) - (setf pc (sap+ pc 1))) - (/show0 "now PC=..") - (/hexstr (sap-int pc)) - (let* ((length (sap-ref-8 pc 4)) - (vector (make-array length :element-type '(unsigned-byte 8)))) - (declare (type (unsigned-byte 8) length) - (type (simple-array (unsigned-byte 8) (*)) vector)) - (/show0 "LENGTH,VECTOR,ERROR-NUMBER=..") - (/hexstr length) - (/hexstr vector) - (copy-ub8-from-system-area pc 5 vector 0 length) - (let* ((index 0) - (error-number (sb!c:read-var-integer vector index))) - (/hexstr error-number) - (collect ((sc-offsets)) - (loop - (/show0 "INDEX=..") - (/hexstr index) - (when (>= index length) - (return)) - (sc-offsets (sb!c:read-var-integer vector index))) - (values error-number (sc-offsets))))))) - - - - + (args-for-unimp-inst pc))) +(defun args-for-unimp-inst (pc) + (declare (type system-area-pointer pc)) + (let* ((length (sap-ref-8 pc 4)) + (vector (make-array length :element-type '(unsigned-byte 8)))) + (declare (type (unsigned-byte 8) length) + (type (simple-array (unsigned-byte 8) (*)) vector)) + (copy-ub8-from-system-area pc 5 vector 0 length) + (let* ((index 0) + (error-number (sb!c:read-var-integer vector index))) + (collect ((sc-offsets)) + (loop + (when (>= index length) + (return)) + (sc-offsets (sb!c:read-var-integer vector index))) + (values error-number (sc-offsets)))))) |