diff --git a/compiler/mips/debug.lisp b/compiler/mips/debug.lisp new file mode 100644 index 0000000000000000000000000000000000000000..f50b89cf6804db522314b31759baf62cf634ce19 --- /dev/null +++ b/compiler/mips/debug.lisp @@ -0,0 +1,103 @@ +;;; -*- Package: C; Log: C.Log -*- +;;; +;;; ********************************************************************** +;;; This code was written as part of the Spice Lisp project at +;;; Carnegie-Mellon University, and has been placed in the public domain. +;;; If you want to use this code or any part of Spice Lisp, please contact +;;; Scott Fahlman (FAHLMAN@CMUC). +;;; ********************************************************************** +;;; +;;; $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/mips/debug.lisp,v 1.1 1990/06/03 19:11:05 wlott Exp $ +;;; +;;; Compiler support for the new whizzy debugger. +;;; +;;; Written by William Lott. +;;; +(in-package "C") + +(in-package "DI") +(import '(c::current-fp)) +(import '(current-sp current-fp stack-ref %set-stack-ref lra-code-header + function-code-header make-lisp-obj get-lisp-obj-address) + (find-package "C")) + +(in-package "C") + + +(defknown current-sp () system-area-pointer (movable flushable)) +(defknown current-fp () system-area-pointer (movable flushable)) +(defknown stack-ref (system-area-pointer index) t (flushable)) +(defknown %set-stack-ref (system-area-pointer index t) t (unsafe)) +(defknown lra-code-header (t) t (movable flushable)) +(defknown function-code-header (t) t (movable flushable)) +(defknown make-lisp-obj ((unsigned-byte 32)) t (movable flushable)) +(defknown get-lisp-obj-address (t) (unsigned-byte 32) (movable flushable)) + +(define-vop (debug-cur-sp) + (:translate current-sp) + (:policy :fast-safe) + (:results (res :scs (sap-reg))) + (:generator 1 + (move res csp-tn))) + +(define-vop (debug-cur-fp) + (:translate current-fp) + (:policy :fast-safe) + (:results (res :scs (sap-reg))) + (:generator 1 + (move res fp-tn))) + +(define-vop (read-control-stack sap-ref) + (:translate stack-ref) + (:policy :fast-safe) + (:results (result :scs (descriptor-reg))) + (:variant :long nil)) + +(define-vop (write-control-stack sap-set) + (:translate %set-stack-ref) + (:policy :fast-safe) + (:args (object :scs (sap-reg) :target sap) + (offset :scs (descriptor-reg any-reg negative-immediate + zero immediate)) + (value :scs (descriptor-reg) :target result)) + (:arg-types system-area-pointer positive-fixnum *) + (:results (result :scs (descriptor-reg))) + (:variant :long)) + +(define-vop (code-from-mumble) + (:policy :fast-safe) + (:args (thing :scs (descriptor-reg))) + (:results (code :scs (descriptor-reg))) + (:temporary (:scs (non-descriptor-reg)) temp) + (:variant-vars lowtag) + (:generator 5 + (loadw temp thing 0 lowtag) + (inst srl temp vm:type-bits) + (inst sll temp (1- (integer-length vm:word-bytes))) + (unless (= lowtag vm:other-pointer-type) + (inst addu temp (- vm:other-pointer-type lowtag))) + (inst subu code thing temp))) + +(define-vop (code-from-lra code-from-mumble) + (:translate lra-code-header) + (:variant vm:other-pointer-type)) + +(define-vop (code-from-function code-from-mumble) + (:translate function-code-header) + (:variant vm:function-pointer-type)) + +(define-vop (make-lisp-obj) + (:policy :fast-safe) + (:translate make-lisp-obj) + (:args (value :scs (unsigned-reg) :target result)) + (:results (result :scs (descriptor-reg))) + (:generator 1 + (move result value))) + +(define-vop (get-lisp-obj-address) + (:policy :fast-safe) + (:translate get-lisp-obj-address) + (:args (thing :scs (descriptor-reg) :target result)) + (:results (result :scs (unsigned-reg))) + (:generator 1 + (move result thing)))