X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86-64%2Fdebug.lisp;h=ef6e0e29cbe190048e787f438548ffd796d1c62a;hb=179812c3ad5dad69239c625ec929a7d486cf568f;hp=74ebd636154b7aac2acdc2cf0f2c99c73fe987aa;hpb=4ebdc81b1a9c6dbed6e98b112afc8dd32b17a2dd;p=sbcl.git diff --git a/src/compiler/x86-64/debug.lisp b/src/compiler/x86-64/debug.lisp index 74ebd63..ef6e0e2 100644 --- a/src/compiler/x86-64/debug.lisp +++ b/src/compiler/x86-64/debug.lisp @@ -34,7 +34,7 @@ (:translate stack-ref) (:policy :fast-safe) (:args (sap :scs (sap-reg) :to :eval) - (offset :scs (any-reg) :target temp)) + (offset :scs (any-reg) :target temp)) (:arg-types system-area-pointer positive-fixnum) (:temporary (:sc unsigned-reg :from (:argument 1)) temp) (:results (result :scs (descriptor-reg))) @@ -43,7 +43,8 @@ (move temp offset) (inst neg temp) (inst mov result - (make-ea :qword :base sap :disp (- n-word-bytes) :index temp)))) + (make-ea :qword :base sap :disp (frame-byte-offset 0) :index temp + :scale (ash 1 (- word-shift n-fixnum-tag-bits)))))) (define-vop (read-control-stack-c) (:translate stack-ref) @@ -55,14 +56,14 @@ (:result-types *) (:generator 5 (inst mov result (make-ea :qword :base sap - :disp (- (* (1+ index) n-word-bytes)))))) + :disp (frame-byte-offset index))))) (define-vop (write-control-stack) (:translate %set-stack-ref) (:policy :fast-safe) (:args (sap :scs (sap-reg) :to :eval) - (offset :scs (any-reg) :target temp) - (value :scs (descriptor-reg) :to :result :target result)) + (offset :scs (any-reg) :target temp) + (value :scs (descriptor-reg) :to :result :target result)) (:arg-types system-area-pointer positive-fixnum *) (:temporary (:sc unsigned-reg :from (:argument 1) :to :result) temp) (:results (result :scs (descriptor-reg))) @@ -71,22 +72,23 @@ (move temp offset) (inst neg temp) (inst mov - (make-ea :qword :base sap :disp (- n-word-bytes) :index temp) value) + (make-ea :qword :base sap :disp (frame-byte-offset 0) :index temp + :scale (ash 1 (- word-shift n-fixnum-tag-bits))) + value) (move result value))) (define-vop (write-control-stack-c) (: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 index) (:arg-types system-area-pointer (:constant (signed-byte 29)) *) (:results (result :scs (descriptor-reg))) (:result-types *) (:generator 5 - (inst mov (make-ea :qword :base sap - :disp (- (* (1+ index) n-word-bytes))) - value) + (inst mov (make-ea :qword :base sap :disp (frame-byte-offset index)) + value) (move result value))) (define-vop (code-from-mumble) @@ -97,20 +99,20 @@ (:variant-vars lowtag) (:generator 5 (let ((bogus (gen-label)) - (done (gen-label))) + (done (gen-label))) (loadw temp thing 0 lowtag) (inst shr temp n-widetag-bits) (inst jmp :z bogus) (inst shl temp (1- (integer-length n-word-bytes))) (unless (= lowtag other-pointer-lowtag) - (inst add temp (- lowtag other-pointer-lowtag))) + (inst add temp (- lowtag other-pointer-lowtag))) (move code thing) (inst sub code temp) (emit-label done) (assemble (*elsewhere*) - (emit-label bogus) - (inst mov code nil-value) - (inst jmp done))))) + (emit-label bogus) + (inst mov code nil-value) + (inst jmp done))))) (define-vop (code-from-lra code-from-mumble) (:translate sb!di::lra-code-header) @@ -120,14 +122,14 @@ (:translate sb!di::fun-code-header) (:variant fun-pointer-lowtag)) -(define-vop (make-lisp-obj) +(define-vop (%make-lisp-obj) (:policy :fast-safe) - (:translate sb!di::make-lisp-obj) + (:translate %make-lisp-obj) (:args (value :scs (unsigned-reg unsigned-stack) :target result)) (:arg-types unsigned-num) (:results (result :scs (descriptor-reg) - :load-if (not (sc-is value unsigned-reg)) - )) + :load-if (not (sc-is value unsigned-reg)) + )) (:generator 1 (move result value))) @@ -136,8 +138,8 @@ (:translate sb!di::get-lisp-obj-address) (:args (thing :scs (descriptor-reg control-stack) :target result)) (:results (result :scs (unsigned-reg) - :load-if (not (and (sc-is thing descriptor-reg) - (sc-is result unsigned-stack))))) + :load-if (not (and (sc-is thing descriptor-reg) + (sc-is result unsigned-stack))))) (:result-types unsigned-num) (:generator 1 (move result thing)))