/[cmucl]/src/code/rt-vm.lisp
ViewVC logotype

Diff of /src/code/rt-vm.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.2 by wlott, Mon Apr 22 19:22:51 1991 UTC revision 1.3 by wlott, Sun Apr 28 20:13:53 1991 UTC
# Line 74  Line 74 
74  ;;;  ;;;
75  (defun internal-error-arguments (sc)  (defun internal-error-arguments (sc)
76    (alien-bind ((sc sc mach:sigcontext t))    (alien-bind ((sc sc mach:sigcontext t))
77      (values (error-number-or-lose 'unknown-error)      (let ((pc (alien-access (mach:sigcontext-iar (alien-value sc)))))
78              nil)))        (declare (type system-area-pointer pc))
79          (let* ((length (sap-ref-8 pc 4))
80                 (vector (make-array length :element-type '(unsigned-byte 8))))
81            (declare (type (unsigned-byte 8) length)
82                     (type (simple-array (unsigned-byte 8) (*)) vector))
83            (copy-from-system-area pc (* vm:byte-bits 5)
84                                   vector (* vm:word-bits
85                                             vm:vector-data-offset)
86                                   (* length vm:byte-bits))
87            (let* ((index 0)
88                   (error-number (c::read-var-integer vector index)))
89              (collect ((sc-offsets))
90                (loop
91                  (when (>= index length)
92                    (return))
93                  (sc-offsets (c::read-var-integer vector index)))
94                (values error-number (sc-offsets))))))))
95    
96    
97    
98  ;;; SIGCONTEXT-FLOATING-POINT-MODES  --  Interface  ;;; SIGCONTEXT-FLOATING-POINT-MODES  --  Interface

Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3

  ViewVC Help
Powered by ViewVC 1.1.5