X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Fdebug.lisp;h=800bfa17eabd26f350c32d51669f50d95526dc3f;hb=203e2acb585b1c13159bbd6ec83c61ad9c095818;hp=f820a758b02c911ab538d60ebb40d747de83b33a;hpb=dfa55a883f94470267b626dae77ce7e7dfac3df6;p=sbcl.git diff --git a/src/compiler/alpha/debug.lisp b/src/compiler/alpha/debug.lisp index f820a75..800bfa1 100644 --- a/src/compiler/alpha/debug.lisp +++ b/src/compiler/alpha/debug.lisp @@ -1,21 +1,15 @@ -;;; -*- Package: ALPHA; Log: C.Log -*- -;;; -;;; ********************************************************************** -;;; This code was written as part of the CMU Common Lisp project at -;;; Carnegie Mellon University, and has been placed in the public domain. -;;; - -;;; -;;; ********************************************************************** -;;; -;;; Compiler support for the new whizzy debugger. -;;; -;;; Written by William Lott. -;;; Converted by Sean Hallgren. -;;; -(in-package "SB!VM") +;;;; Alpha compiler support for the new whizzy debugger +;;;; This software is part of the SBCL system. See the README file for +;;;; more information. +;;;; +;;;; This software is derived from the CMU CL system, which was +;;;; written at Carnegie Mellon University and released into the +;;;; public domain. The software is in the public domain and is +;;;; provided with absolutely no warranty. See the COPYING and CREDITS +;;;; files for more information. +(in-package "SB!VM") (define-vop (debug-cur-sp) (:translate current-sp) @@ -37,7 +31,7 @@ (:translate stack-ref) (:policy :fast-safe) (:args (object :scs (sap-reg) :target sap) - (offset :scs (any-reg))) + (offset :scs (any-reg))) (:arg-types system-area-pointer positive-fixnum) (:temporary (:scs (sap-reg) :from :eval) sap) (:results (result :scs (descriptor-reg))) @@ -55,14 +49,14 @@ (:results (result :scs (descriptor-reg))) (:result-types *) (:generator 4 - (inst ldl result (* offset word-bytes) object))) + (inst ldl result (* offset n-word-bytes) object))) (define-vop (write-control-stack) (:translate %set-stack-ref) (:policy :fast-safe) (:args (object :scs (sap-reg) :target sap) - (offset :scs (any-reg)) - (value :scs (descriptor-reg) :target result)) + (offset :scs (any-reg)) + (value :scs (descriptor-reg) :target result)) (:arg-types system-area-pointer positive-fixnum *) (:results (result :scs (descriptor-reg))) (:result-types *) @@ -76,13 +70,13 @@ (:translate %set-stack-ref) (:policy :fast-safe) (:args (sap :scs (sap-reg)) - (value :scs (descriptor-reg) :target result)) + (value :scs (descriptor-reg) :target result)) (:info offset) (:arg-types system-area-pointer (:constant (signed-byte 14)) *) (:results (result :scs (descriptor-reg))) (:result-types *) (:generator 1 - (inst stl value (* offset word-bytes) sap) + (inst stl value (* offset n-word-bytes) sap) (move value result))) @@ -94,31 +88,31 @@ (:variant-vars lowtag) (:generator 5 (let ((bogus (gen-label)) - (done (gen-label))) + (done (gen-label))) (loadw temp thing 0 lowtag) - (inst srl temp sb!vm:type-bits temp) + (inst srl temp n-widetag-bits temp) (inst beq temp bogus) - (inst sll temp (1- (integer-length sb!vm:word-bytes)) temp) - (unless (= lowtag sb!vm:other-pointer-type) - (inst subq temp (- sb!vm:other-pointer-type lowtag) temp)) + (inst sll temp (1- (integer-length n-word-bytes)) temp) + (unless (= lowtag other-pointer-lowtag) + (inst subq temp (- other-pointer-lowtag lowtag) temp)) (inst subq thing temp code) (emit-label done) (assemble (*elsewhere*) - (emit-label bogus) - (move null-tn code) - (inst br zero-tn done))))) + (emit-label bogus) + (move null-tn code) + (inst br zero-tn done))))) (define-vop (code-from-lra code-from-mumble) (:translate lra-code-header) - (:variant sb!vm:other-pointer-type)) + (:variant other-pointer-lowtag)) (define-vop (code-from-function code-from-mumble) - (:translate function-code-header) - (:variant sb!vm:function-pointer-type)) + (:translate fun-code-header) + (:variant fun-pointer-lowtag)) -(define-vop (make-lisp-obj) +(define-vop (%make-lisp-obj) (:policy :fast-safe) - (:translate make-lisp-obj) + (:translate %make-lisp-obj) (:args (value :scs (unsigned-reg) :target result)) (:arg-types unsigned-num) (:results (result :scs (descriptor-reg))) @@ -134,18 +128,15 @@ (:generator 1 (move thing result))) -(define-vop (function-word-offset) +(define-vop (fun-word-offset) (:policy :fast-safe) - (:translate function-word-offset) + (:translate fun-word-offset) (:args (fun :scs (descriptor-reg))) (:results (res :scs (unsigned-reg))) (:result-types positive-fixnum) (:generator 5 - (loadw res fun 0 function-pointer-type) - (inst srl res sb!vm:type-bits res))) - - - + (loadw res fun 0 fun-pointer-lowtag) + (inst srl res n-widetag-bits res))) (defknown make-number-stack-pointer ((unsigned-byte 32)) system-area-pointer (movable foldable flushable))