+ (sub-access-debug-var-slot
+ (frame-pointer frame)
+ (compiled-debug-var-sc-offset debug-var)
+ escaped)
+ (sub-access-debug-var-slot
+ (frame-pointer frame)
+ (or (compiled-debug-var-save-sc-offset debug-var)
+ (compiled-debug-var-sc-offset debug-var))))))
+
+;;; a helper function for working with possibly-invalid values:
+;;; Do (MAKE-LISP-OBJ VAL) only if the value looks valid.
+;;;
+;;; (Such values can arise in registers on machines with conservative
+;;; GC, and might also arise in debug variable locations when
+;;; those variables are invalid.)
+(defun make-valid-lisp-obj (val)
+ (if (or
+ ;; fixnum
+ (zerop (logand val sb!vm:fixnum-tag-mask))
+ ;; character
+ (and (zerop (logandc2 val #x1fffffff)) ; Top bits zero
+ (= (logand val #xff) sb!vm:character-widetag)) ; char tag
+ ;; unbound marker
+ (= val sb!vm:unbound-marker-widetag)
+ ;; pointer
+ (and (logand val 1)
+ ;; Check that the pointer is valid. XXX Could do a better
+ ;; job. FIXME: e.g. by calling out to an is_valid_pointer
+ ;; routine in the C runtime support code
+ (or (< sb!vm:read-only-space-start val
+ (* sb!vm:*read-only-space-free-pointer*
+ sb!vm:n-word-bytes))
+ (< sb!vm:static-space-start val
+ (* sb!vm:*static-space-free-pointer*
+ sb!vm:n-word-bytes))
+ (< sb!vm:dynamic-space-start val
+ (sap-int (dynamic-space-free-pointer))))))
+ (make-lisp-obj val)
+ :invalid-object))
+
+#!-(or x86 x86-64)
+(defun sub-access-debug-var-slot (fp sc-offset &optional escaped)
+ (macrolet ((with-escaped-value ((var) &body forms)
+ `(if escaped
+ (let ((,var (sb!vm:context-register
+ escaped
+ (sb!c:sc-offset-offset sc-offset))))
+ ,@forms)
+ :invalid-value-for-unescaped-register-storage))
+ (escaped-float-value (format)
+ `(if escaped
+ (sb!vm:context-float-register
+ escaped
+ (sb!c:sc-offset-offset sc-offset)
+ ',format)
+ :invalid-value-for-unescaped-register-storage))
+ (with-nfp ((var) &body body)
+ `(let ((,var (if escaped
+ (sb!sys:int-sap
+ (sb!vm:context-register escaped
+ sb!vm::nfp-offset))
+ #!-alpha
+ (sb!sys:sap-ref-sap fp (* nfp-save-offset
+ sb!vm:n-word-bytes))
+ #!+alpha
+ (sb!vm::make-number-stack-pointer
+ (sb!sys:sap-ref-32 fp (* nfp-save-offset
+ sb!vm:n-word-bytes))))))
+ ,@body)))
+ (ecase (sb!c:sc-offset-scn sc-offset)
+ ((#.sb!vm:any-reg-sc-number
+ #.sb!vm:descriptor-reg-sc-number
+ #!+rt #.sb!vm:word-pointer-reg-sc-number)
+ (sb!sys:without-gcing
+ (with-escaped-value (val) (sb!kernel:make-lisp-obj val))))
+
+ (#.sb!vm:character-reg-sc-number
+ (with-escaped-value (val)
+ (code-char val)))
+ (#.sb!vm:sap-reg-sc-number
+ (with-escaped-value (val)
+ (sb!sys:int-sap val)))
+ (#.sb!vm:signed-reg-sc-number
+ (with-escaped-value (val)
+ (if (logbitp (1- sb!vm:n-word-bits) val)
+ (logior val (ash -1 sb!vm:n-word-bits))
+ val)))
+ (#.sb!vm:unsigned-reg-sc-number
+ (with-escaped-value (val)
+ val))
+ (#.sb!vm:non-descriptor-reg-sc-number
+ (error "Local non-descriptor register access?"))
+ (#.sb!vm:interior-reg-sc-number
+ (error "Local interior register access?"))
+ (#.sb!vm:single-reg-sc-number
+ (escaped-float-value single-float))
+ (#.sb!vm:double-reg-sc-number
+ (escaped-float-value double-float))
+ #!+long-float
+ (#.sb!vm:long-reg-sc-number
+ (escaped-float-value long-float))
+ (#.sb!vm:complex-single-reg-sc-number
+ (if escaped
+ (complex
+ (sb!vm:context-float-register
+ escaped (sb!c:sc-offset-offset sc-offset) 'single-float)
+ (sb!vm:context-float-register
+ escaped (1+ (sb!c:sc-offset-offset sc-offset)) 'single-float))
+ :invalid-value-for-unescaped-register-storage))
+ (#.sb!vm:complex-double-reg-sc-number
+ (if escaped
+ (complex
+ (sb!vm:context-float-register
+ escaped (sb!c:sc-offset-offset sc-offset) 'double-float)
+ (sb!vm:context-float-register
+ escaped (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 2 #!-sparc 1)
+ 'double-float))
+ :invalid-value-for-unescaped-register-storage))
+ #!+long-float
+ (#.sb!vm:complex-long-reg-sc-number
+ (if escaped
+ (complex
+ (sb!vm:context-float-register
+ escaped (sb!c:sc-offset-offset sc-offset) 'long-float)
+ (sb!vm:context-float-register
+ escaped (+ (sb!c:sc-offset-offset sc-offset) #!+sparc 4)
+ 'long-float))
+ :invalid-value-for-unescaped-register-storage))
+ (#.sb!vm:single-stack-sc-number
+ (with-nfp (nfp)
+ (sb!sys:sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)
+ sb!vm:n-word-bytes))))
+ (#.sb!vm:double-stack-sc-number
+ (with-nfp (nfp)
+ (sb!sys:sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)
+ sb!vm:n-word-bytes))))
+ #!+long-float
+ (#.sb!vm:long-stack-sc-number
+ (with-nfp (nfp)
+ (sb!sys:sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)
+ sb!vm:n-word-bytes))))
+ (#.sb!vm:complex-single-stack-sc-number
+ (with-nfp (nfp)
+ (complex
+ (sb!sys:sap-ref-single nfp (* (sb!c:sc-offset-offset sc-offset)
+ sb!vm:n-word-bytes))
+ (sb!sys:sap-ref-single nfp (* (1+ (sb!c:sc-offset-offset sc-offset))
+ sb!vm:n-word-bytes)))))
+ (#.sb!vm:complex-double-stack-sc-number
+ (with-nfp (nfp)
+ (complex
+ (sb!sys:sap-ref-double nfp (* (sb!c:sc-offset-offset sc-offset)
+ sb!vm:n-word-bytes))
+ (sb!sys:sap-ref-double nfp (* (+ (sb!c:sc-offset-offset sc-offset) 2)
+ sb!vm:n-word-bytes)))))
+ #!+long-float
+ (#.sb!vm:complex-long-stack-sc-number
+ (with-nfp (nfp)
+ (complex
+ (sb!sys:sap-ref-long nfp (* (sb!c:sc-offset-offset sc-offset)
+ sb!vm:n-word-bytes))
+ (sb!sys:sap-ref-long nfp (* (+ (sb!c:sc-offset-offset sc-offset)
+ #!+sparc 4)
+ sb!vm:n-word-bytes)))))
+ (#.sb!vm:control-stack-sc-number
+ (sb!kernel:stack-ref fp (sb!c:sc-offset-offset sc-offset)))
+ (#.sb!vm:character-stack-sc-number
+ (with-nfp (nfp)
+ (code-char (sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
+ sb!vm:n-word-bytes)))))
+ (#.sb!vm:unsigned-stack-sc-number
+ (with-nfp (nfp)
+ (sb!sys:sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
+ sb!vm:n-word-bytes))))
+ (#.sb!vm:signed-stack-sc-number
+ (with-nfp (nfp)
+ (sb!sys:signed-sap-ref-32 nfp (* (sb!c:sc-offset-offset sc-offset)
+ sb!vm:n-word-bytes))))
+ (#.sb!vm:sap-stack-sc-number
+ (with-nfp (nfp)
+ (sb!sys:sap-ref-sap nfp (* (sb!c:sc-offset-offset sc-offset)
+ sb!vm:n-word-bytes)))))))