From: lisphacker Date: Sat, 7 Apr 2007 20:00:24 +0000 (+0000) Subject: 1.0.2.42: x86 backend cleanups X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=48ff891135e403e49037940bbad18d262e23df5e;p=sbcl.git 1.0.2.42: x86 backend cleanups * Defined frame-byte-offset and frame-word-offset for calculating offsets within a stack frame. * Modified most direct references to stack data to use frame-byte-offset and frame-word-offset instead of an inline calculation. --- diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp index c4200f3..85d4452 100644 --- a/src/compiler/x86/call.lisp +++ b/src/compiler/x86/call.lisp @@ -133,7 +133,7 @@ ;; The start of the actual code. ;; Save the return-pc. - (popw ebp-tn (- (1+ return-pc-save-offset))) + (popw ebp-tn (frame-word-offset return-pc-save-offset)) ;; If copy-more-arg follows it will allocate the correct stack ;; size. The stack is not allocated first here as this may expose @@ -267,7 +267,7 @@ (inst cmp ecx-tn (fixnumize i)) (inst jmp :be default-lab) - (loadw edx-tn ebx-tn (- (1+ i))) + (loadw edx-tn ebx-tn (frame-word-offset i)) (inst mov tn edx-tn))) (emit-label defaulting-done) @@ -306,7 +306,7 @@ (emit-label no-stack-args) (inst lea edi-tn (make-ea :dword :base ebp-tn - :disp (* (- (1+ register-arg-count)) n-word-bytes))) + :disp (frame-byte-offset register-arg-count))) ;; Load EAX with NIL so we can quickly store it, and set up ;; stuff for the loop. (inst mov eax-tn nil-value) @@ -321,7 +321,7 @@ ;; and then default the remaining stack arguments. (emit-label regs-defaulted) ;; Save EDI. - (storew edi-tn ebx-tn (- (1+ 1))) + (storew edi-tn ebx-tn (frame-word-offset 1)) ;; Compute the number of stack arguments, and if it's zero or ;; less, don't copy any stack arguments. (inst sub ecx-tn (fixnumize register-arg-count)) @@ -337,12 +337,12 @@ ;; Compute a pointer to where the stack args go. (inst lea edi-tn (make-ea :dword :base ebp-tn - :disp (* (- (1+ register-arg-count)) n-word-bytes))) + :disp (frame-byte-offset register-arg-count))) ;; Save ESI, and compute a pointer to where the args come from. - (storew esi-tn ebx-tn (- (1+ 2))) + (storew esi-tn ebx-tn (frame-word-offset 2)) (inst lea esi-tn (make-ea :dword :base ebx-tn - :disp (* (- (1+ register-arg-count)) n-word-bytes))) + :disp (frame-byte-offset register-arg-count))) ;; Do the copy. (inst shr ecx-tn word-shift) ; make word count (inst std) @@ -351,7 +351,7 @@ ;; solaris requires DF being zero. #!+sunos (inst cld) ;; Restore ESI. - (loadw esi-tn ebx-tn (- (1+ 2))) + (loadw esi-tn ebx-tn (frame-word-offset 2)) ;; Now we have to default the remaining args. Find out how many. (inst sub eax-tn (fixnumize (- nvals register-arg-count))) (inst neg eax-tn) @@ -369,7 +369,7 @@ #!+sunos (inst cld) ;; Restore EDI, and reset the stack. (emit-label restore-edi) - (loadw edi-tn ebx-tn (- (1+ 1))) + (loadw edi-tn ebx-tn (frame-word-offset 1)) (inst mov esp-tn ebx-tn)))) (values)) @@ -479,7 +479,7 @@ #+nil (format t "*call-local: ret-tn on stack; offset=~S~%" (tn-offset ret-tn)) (storew (make-fixup nil :code-object return) - ebp-tn (- (1+ (tn-offset ret-tn))))) + ebp-tn (frame-word-offset (tn-offset ret-tn)))) ((sap-reg) (inst lea ret-tn (make-fixup nil :code-object return))))) @@ -518,7 +518,7 @@ (tn-offset ret-tn)) ;; Stack (storew (make-fixup nil :code-object return) - ebp-tn (- (1+ (tn-offset ret-tn))))) + ebp-tn (frame-word-offset (tn-offset ret-tn)))) ((sap-reg) ;; Register (inst lea ret-tn (make-fixup nil :code-object return))))) @@ -566,7 +566,7 @@ (tn-offset ret-tn)) ;; Stack (storew (make-fixup nil :code-object return) - ebp-tn (- (1+ (tn-offset ret-tn))))) + ebp-tn (frame-word-offset (tn-offset ret-tn)))) ((sap-reg) ;; Register (inst lea ret-tn (make-fixup nil :code-object return))))) @@ -651,8 +651,7 @@ (cond ((zerop (tn-offset old-fp)) ;; Zot all of the stack except for the old-fp. (inst lea esp-tn (make-ea :dword :base ebp-tn - :disp (- (* (1+ ocfp-save-offset) - n-word-bytes)))) + :disp (frame-byte-offset ocfp-save-offset))) ;; Restore the old fp from its save location on the stack, ;; and zot the stack. (inst pop ebp-tn)) @@ -680,7 +679,7 @@ ;; Zot all of the stack except for the old-fp and return-pc. (inst lea esp-tn (make-ea :dword :base ebp-tn - :disp (- (* (1+ (tn-offset return-pc)) n-word-bytes)))) + :disp (frame-byte-offset (tn-offset return-pc)))) ;; Restore the old fp. old-fp may be either on the stack in its ;; save location or in a register, in either case this restores it. (move ebp-tn old-fp) @@ -858,12 +857,12 @@ (move old-fp-tmp old-fp) (storew old-fp-tmp ebp-tn - (- (1+ ocfp-save-offset))))) + (frame-word-offset ocfp-save-offset)))) ((any-reg descriptor-reg) (format t "** tail-call old-fp in reg not S0~%") (storew old-fp ebp-tn - (- (1+ ocfp-save-offset))))) + (frame-word-offset ocfp-save-offset)))) ;; For tail call, we have to push the ;; return-pc so that it looks like we CALLed @@ -889,7 +888,7 @@ '(inst sub esp-tn (fixnumize 3))) ;; Save the fp - (storew ebp-tn new-fp (- (1+ ocfp-save-offset))) + (storew ebp-tn new-fp (frame-word-offset ocfp-save-offset)) (move ebp-tn new-fp) ; NB - now on new stack frame. ))) @@ -992,8 +991,7 @@ ;; Drop the stack above it and pop it off. (cond ((zerop (tn-offset old-fp)) (inst lea esp-tn (make-ea :dword :base ebp-tn - :disp (- (* (1+ ocfp-save-offset) - n-word-bytes)))) + :disp (frame-byte-offset ocfp-save-offset))) (inst pop ebp-tn)) (t ;; Should this ever happen, we do the same as above, but @@ -1024,8 +1022,7 @@ ;; into a temp reg while we fix the stack. ;; Drop stack above return-pc (inst lea esp-tn (make-ea :dword :base ebp-tn - :disp (- (* (1+ (tn-offset return-pc)) - n-word-bytes)))) + :disp (frame-byte-offset (tn-offset return-pc)))) ;; Set single-value return flag (inst clc) ;; Restore the old frame pointer @@ -1096,8 +1093,7 @@ (inst ret)) (t (inst jmp (make-ea :dword :base ebx - :disp (- (* (1+ (tn-offset return-pc)) - n-word-bytes)))))) + :disp (frame-byte-offset (tn-offset return-pc)))))) (trace-table-entry trace-table-normal))) diff --git a/src/compiler/x86/char.lisp b/src/compiler/x86/char.lisp index f44f327..d4fcfce 100644 --- a/src/compiler/x86/char.lisp +++ b/src/compiler/x86/char.lisp @@ -103,12 +103,14 @@ (character-stack #!-sb-unicode (inst mov - (make-ea :byte :base fp :disp (- (* (1+ (tn-offset y)) 4))) + ;; XXX: If the sb-unicode case needs to handle c-call, + ;; why does the non-unicode case not need to? + (make-ea :byte :base fp :disp (frame-byte-offset (tn-offset y))) x) #!+sb-unicode (if (= (tn-offset fp) esp-offset) (storew x fp (tn-offset y)) ; c-call - (storew x fp (- (1+ (tn-offset y))))))))) + (storew x fp (frame-word-offset (tn-offset y)))))))) (define-move-vop move-character-arg :move-arg (any-reg character-reg) (character-reg)) diff --git a/src/compiler/x86/debug.lisp b/src/compiler/x86/debug.lisp index 4a8f0ec..3869b6a 100644 --- a/src/compiler/x86/debug.lisp +++ b/src/compiler/x86/debug.lisp @@ -55,7 +55,7 @@ (:result-types *) (:generator 5 (inst mov result (make-ea :dword :base sap - :disp (- (* (1+ index) n-word-bytes)))))) + :disp (frame-byte-offset index))))) (define-vop (write-control-stack) (:translate %set-stack-ref) @@ -85,7 +85,7 @@ (:result-types *) (:generator 5 (inst mov (make-ea :dword :base sap - :disp (- (* (1+ index) n-word-bytes))) + :disp (frame-byte-offset index)) value) (move result value))) diff --git a/src/compiler/x86/float.lisp b/src/compiler/x86/float.lisp index 621a1cd..cd2c3ba 100644 --- a/src/compiler/x86/float.lisp +++ b/src/compiler/x86/float.lisp @@ -42,9 +42,9 @@ (macrolet ((ea-for-xf-stack (tn kind) `(make-ea :dword :base ebp-tn - :disp (- (* (+ (tn-offset ,tn) - (ecase ,kind (:single 1) (:double 2) (:long 3))) - n-word-bytes))))) + :disp (frame-byte-offset + (+ (tn-offset ,tn) + (ecase ,kind (:single 0) (:double 1) (:long 2))))))) (defun ea-for-sf-stack (tn) (ea-for-xf-stack tn :single)) (defun ea-for-df-stack (tn) @@ -79,13 +79,14 @@ (macrolet ((ea-for-cxf-stack (tn kind slot &optional base) `(make-ea :dword :base ,base - :disp (- (* (+ (tn-offset ,tn) - (* (ecase ,kind - (:single 1) - (:double 2) - (:long 3)) - (ecase ,slot (:real 1) (:imag 2)))) - n-word-bytes))))) + :disp (frame-byte-offset + (+ (tn-offset ,tn) + -1 + (* (ecase ,kind + (:single 1) + (:double 2) + (:long 3)) + (ecase ,slot (:real 1) (:imag 2)))))))) (defun ea-for-csf-real-stack (tn &optional (base ebp-tn)) (ea-for-cxf-stack tn :single :real base)) (defun ea-for-csf-imag-stack (tn &optional (base ebp-tn)) @@ -613,6 +614,7 @@ (inst fxch x))))) (,stack-sc (if (= (tn-offset fp) esp-offset) + ;; C-call (let* ((offset (* (tn-offset y) n-word-bytes)) (ea (make-ea :dword :base fp :disp offset))) (with-tn@fp-top(x) @@ -621,14 +623,15 @@ (:double '((inst fstd ea))) #!+long-float (:long '((store-long-float ea)))))) + ;; Lisp stack (let ((ea (make-ea :dword :base fp - :disp (- (* (+ (tn-offset y) - ,(case format - (:single 1) - (:double 2) - (:long 3))) - n-word-bytes))))) + :disp (frame-byte-offset + (+ (tn-offset y) + ,(case format + (:single 0) + (:double 1) + (:long 2))))))) (with-tn@fp-top(x) ,@(ecase format (:single '((inst fst ea))) @@ -1830,12 +1833,12 @@ (:policy :fast-safe) (:vop-var vop) (:generator 2 - (let ((offset (1+ (tn-offset temp)))) - (storew hi-bits ebp-tn (- offset)) - (storew lo-bits ebp-tn (- (1+ offset))) + (let ((offset (tn-offset temp))) + (storew hi-bits ebp-tn (frame-word-offset offset)) + (storew lo-bits ebp-tn (frame-word-offset (1+ offset))) (with-empty-tn@fp-top(res) (inst fldd (make-ea :dword :base ebp-tn - :disp (- (* (1+ offset) n-word-bytes)))))))) + :disp (frame-byte-offset (1+ offset)))))))) #!+long-float (define-vop (make-long-float) @@ -1850,13 +1853,13 @@ (:policy :fast-safe) (:vop-var vop) (:generator 3 - (let ((offset (1+ (tn-offset temp)))) - (storew exp-bits ebp-tn (- offset)) - (storew hi-bits ebp-tn (- (1+ offset))) - (storew lo-bits ebp-tn (- (+ offset 2))) + (let ((offset (tn-offset temp))) + (storew exp-bits ebp-tn (frame-word-offset offset)) + (storew hi-bits ebp-tn (frame-word-offset (1+ offset))) + (storew lo-bits ebp-tn (frame-word-offset (+ offset 2))) (with-empty-tn@fp-top(res) (inst fldl (make-ea :dword :base ebp-tn - :disp (- (* (+ offset 2) n-word-bytes)))))))) + :disp (frame-byte-offset (+ offset 2)))))))) (define-vop (single-float-bits) (:args (float :scs (single-reg descriptor-reg) @@ -1903,12 +1906,11 @@ (double-reg (with-tn@fp-top(float) (let ((where (make-ea :dword :base ebp-tn - :disp (- (* (+ 2 (tn-offset temp)) - n-word-bytes))))) + :disp (frame-byte-offset (1+ (tn-offset temp)))))) (inst fstd where))) - (loadw hi-bits ebp-tn (- (1+ (tn-offset temp))))) + (loadw hi-bits ebp-tn (frame-word-offset (tn-offset temp)))) (double-stack - (loadw hi-bits ebp-tn (- (1+ (tn-offset float))))) + (loadw hi-bits ebp-tn (frame-word-offset (tn-offset float)))) (descriptor-reg (loadw hi-bits float (1+ double-float-value-slot) other-pointer-lowtag))))) @@ -1928,12 +1930,11 @@ (double-reg (with-tn@fp-top(float) (let ((where (make-ea :dword :base ebp-tn - :disp (- (* (+ 2 (tn-offset temp)) - n-word-bytes))))) + :disp (frame-byte-offset (1+ (tn-offset temp)))))) (inst fstd where))) - (loadw lo-bits ebp-tn (- (+ 2 (tn-offset temp))))) + (loadw lo-bits ebp-tn (frame-word-offset (1+ (tn-offset temp))))) (double-stack - (loadw lo-bits ebp-tn (- (+ 2 (tn-offset float))))) + (loadw lo-bits ebp-tn (frame-word-offset (1+ (tn-offset float))))) (descriptor-reg (loadw lo-bits float double-float-value-slot other-pointer-lowtag))))) @@ -1954,16 +1955,15 @@ (long-reg (with-tn@fp-top(float) (let ((where (make-ea :dword :base ebp-tn - :disp (- (* (+ 3 (tn-offset temp)) - n-word-bytes))))) + :disp (frame-byte-offset (+ 2 (tn-offset temp)))))) (store-long-float where))) (inst movsx exp-bits (make-ea :word :base ebp-tn - :disp (* (- (1+ (tn-offset temp))) n-word-bytes)))) + :disp (frame-byte-offset (tn-offset temp))))) (long-stack (inst movsx exp-bits (make-ea :word :base ebp-tn - :disp (* (- (1+ (tn-offset float))) n-word-bytes)))) + :disp (frame-byte-offset (tn-offset temp))))) (descriptor-reg (inst movsx exp-bits (make-ea :word :base float @@ -1987,12 +1987,11 @@ (long-reg (with-tn@fp-top(float) (let ((where (make-ea :dword :base ebp-tn - :disp (- (* (+ 3 (tn-offset temp)) - n-word-bytes))))) + :disp (frame-byte-offset (+ 2 (tn-offset temp)))))) (store-long-float where))) - (loadw hi-bits ebp-tn (- (+ (tn-offset temp) 2)))) + (loadw hi-bits ebp-tn (frame-word-offset (1+ (tn-offset temp))))) (long-stack - (loadw hi-bits ebp-tn (- (+ (tn-offset float) 2)))) + (loadw hi-bits ebp-tn (frame-word-offset (1+ (tn-offset temp))))) (descriptor-reg (loadw hi-bits float (1+ long-float-value-slot) other-pointer-lowtag))))) @@ -2013,12 +2012,11 @@ (long-reg (with-tn@fp-top(float) (let ((where (make-ea :dword :base ebp-tn - :disp (- (* (+ 3 (tn-offset temp)) - n-word-bytes))))) + :disp (frame-byte-offset (+ 2 (tn-offset temp)))))) (store-long-float where))) - (loadw lo-bits ebp-tn (- (+ (tn-offset temp) 3)))) + (loadw lo-bits ebp-tn (frame-word-offset (+ (tn-offset temp) 2)))) (long-stack - (loadw lo-bits ebp-tn (- (+ (tn-offset float) 3)))) + (loadw lo-bits ebp-tn (frame-word-offset (+ (tn-offset float) 2)))) (descriptor-reg (loadw lo-bits float long-float-value-slot other-pointer-lowtag))))) diff --git a/src/compiler/x86/insts.lisp b/src/compiler/x86/insts.lisp index 1f4c432..05d9b33 100644 --- a/src/compiler/x86/insts.lisp +++ b/src/compiler/x86/insts.lisp @@ -728,7 +728,7 @@ (emit-mod-reg-r/m-byte segment #b11 reg (reg-tn-encoding thing))) (stack ;; Convert stack tns into an index off of EBP. - (let ((disp (- (* (1+ (tn-offset thing)) n-word-bytes)))) + (let ((disp (frame-byte-offset (tn-offset thing)))) (cond ((<= -128 disp 127) (emit-mod-reg-r/m-byte segment #b01 reg #b101) (emit-byte segment disp)) diff --git a/src/compiler/x86/move.lisp b/src/compiler/x86/move.lisp index 31903d5..6d1ceb5 100644 --- a/src/compiler/x86/move.lisp +++ b/src/compiler/x86/move.lisp @@ -127,36 +127,24 @@ character-widetag))))) (move y x))) ((control-stack) - (if (sc-is x immediate) - (let ((val (tn-value x))) - (if (= (tn-offset fp) esp-offset) - ;; C-call - (etypecase val - (integer - (storew (fixnumize val) fp (tn-offset y))) - (symbol - (storew (+ nil-value (static-symbol-offset val)) - fp (tn-offset y))) - (character - (storew (logior (ash (char-code val) n-widetag-bits) - character-widetag) - fp (tn-offset y)))) - ;; Lisp stack + (let ((frame-offset (if (= (tn-offset fp) esp-offset) + ;; C-call + (tn-offset y) + ;; Lisp stack + (frame-word-offset (tn-offset y))))) + (if (sc-is x immediate) + (let ((val (tn-value x))) (etypecase val (integer - (storew (fixnumize val) fp (- (1+ (tn-offset y))))) + (storew (fixnumize val) fp frame-offset)) (symbol (storew (+ nil-value (static-symbol-offset val)) - fp (- (1+ (tn-offset y))))) + fp frame-offset)) (character (storew (logior (ash (char-code val) n-widetag-bits) character-widetag) - fp (- (1+ (tn-offset y)))))))) - (if (= (tn-offset fp) esp-offset) - ;; C-call - (storew x fp (tn-offset y)) - ;; Lisp stack - (storew x fp (- (1+ (tn-offset y)))))))))) + fp frame-offset)))) + (storew x fp frame-offset))))))) (define-move-vop move-arg :move-arg (any-reg descriptor-reg) @@ -415,7 +403,7 @@ ((signed-stack unsigned-stack) (if (= (tn-offset fp) esp-offset) (storew x fp (tn-offset y)) ; c-call - (storew x fp (- (1+ (tn-offset y))))))))) + (storew x fp (frame-word-offset (tn-offset y)))))))) (define-move-vop move-word-arg :move-arg (descriptor-reg any-reg signed-reg unsigned-reg) (signed-reg unsigned-reg)) diff --git a/src/compiler/x86/nlx.lisp b/src/compiler/x86/nlx.lisp index 4a35f6d..35760ab 100644 --- a/src/compiler/x86/nlx.lisp +++ b/src/compiler/x86/nlx.lisp @@ -24,7 +24,7 @@ (defun catch-block-ea (tn) (aver (sc-is tn catch-block)) (make-ea :dword :base ebp-tn - :disp (- (* (+ (tn-offset tn) catch-block-size) n-word-bytes)))) + :disp (frame-byte-offset (+ -1 (tn-offset tn) catch-block-size)))) ;;;; Save and restore dynamic environment. @@ -189,9 +189,9 @@ (inst jmp :le default-lab) (sc-case tn ((descriptor-reg any-reg) - (loadw tn start (- (1+ i)))) + (loadw tn start (frame-word-offset i))) ((control-stack) - (loadw move-temp start (- (1+ i))) + (loadw move-temp start (frame-word-offset i)) (inst mov tn move-temp))))) (let ((defaulting-done (gen-label))) (emit-label defaulting-done) diff --git a/src/compiler/x86/sap.lisp b/src/compiler/x86/sap.lisp index 3f5ae15..eb46d70 100644 --- a/src/compiler/x86/sap.lisp +++ b/src/compiler/x86/sap.lisp @@ -65,7 +65,7 @@ (sap-stack (if (= (tn-offset fp) esp-offset) (storew x fp (tn-offset y)) ; c-call - (storew x fp (- (1+ (tn-offset y))))))))) + (storew x fp (frame-word-offset (tn-offset y)))))))) (define-move-vop move-sap-arg :move-arg (descriptor-reg sap-reg) (sap-reg)) diff --git a/src/compiler/x86/vm.lisp b/src/compiler/x86/vm.lisp index 5099c3c..d0a9a41 100644 --- a/src/compiler/x86/vm.lisp +++ b/src/compiler/x86/vm.lisp @@ -408,7 +408,14 @@ ;;; offsets of special stack frame locations (def!constant ocfp-save-offset 0) (def!constant return-pc-save-offset 1) -(def!constant code-save-offset 2) + +(declaim (inline frame-word-offset)) +(defun frame-word-offset (index) + (- (1+ index))) + +(declaim (inline frame-byte-offset)) +(defun frame-byte-offset (index) + (* (frame-word-offset index) n-word-bytes)) ;;; FIXME: This is a bad comment (changed since when?) and there are others ;;; like it in this file. It'd be nice to clarify them. Failing that deleting diff --git a/version.lisp-expr b/version.lisp-expr index 5d089c8..927791c 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.4.41" +"1.0.4.42"