Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/compiler/x86 call.lisp, 1.35, 1.36 char.lisp, 1.8, 1.9 debug.lisp, 1.8, 1.9 float.lisp, 1.20, 1.21 insts.lisp, 1.39, 1.40 move.lisp, 1.13, 1.14 nlx.lisp, 1.20, 1.21 sap.lisp, 1.11, 1.12 vm.lisp, 1.25, 1.26
Update of /cvsroot/sbcl/sbcl/src/compiler/x86 In directory sc8-pr-cvs8.sourceforge.net:/tmp/cvs-serv23177/src/compiler/x86 Modified Files: call.lisp char.lisp debug.lisp float.lisp insts.lisp move.lisp nlx.lisp sap.lisp vm.lisp Log Message: 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. Index: call.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/call.lisp,v retrieving revision 1.35 retrieving revision 1.36 diff -u -d -r1.35 -r1.36 --- call.lisp 5 Dec 2006 20:10:27 -0000 1.35 +++ call.lisp 7 Apr 2007 20:00:24 -0000 1.36 @@ -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))) Index: char.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/char.lisp,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- char.lisp 14 Jul 2005 19:13:47 -0000 1.8 +++ char.lisp 7 Apr 2007 20:00:24 -0000 1.9 @@ -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)) Index: debug.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/debug.lisp,v retrieving revision 1.8 retrieving revision 1.9 diff -u -d -r1.8 -r1.9 --- debug.lisp 14 Jul 2005 19:13:47 -0000 1.8 +++ debug.lisp 7 Apr 2007 20:00:24 -0000 1.9 @@ -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))) Index: float.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/float.lisp,v retrieving revision 1.20 retrieving revision 1.21 diff -u -d -r1.20 -r1.21 --- float.lisp 14 Jul 2005 19:13:47 -0000 1.20 +++ float.lisp 7 Apr 2007 20:00:24 -0000 1.21 @@ -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))))) Index: insts.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/insts.lisp,v retrieving revision 1.39 retrieving revision 1.40 diff -u -d -r1.39 -r1.40 --- insts.lisp 3 Mar 2007 00:42:02 -0000 1.39 +++ insts.lisp 7 Apr 2007 20:00:24 -0000 1.40 @@ -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)) Index: move.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/move.lisp,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -r1.13 -r1.14 --- move.lisp 20 Jul 2006 03:26:13 -0000 1.13 +++ move.lisp 7 Apr 2007 20:00:25 -0000 1.14 @@ -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)) Index: nlx.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/nlx.lisp,v retrieving revision 1.20 retrieving revision 1.21 diff -u -d -r1.20 -r1.21 --- nlx.lisp 13 Jan 2007 21:05:34 -0000 1.20 +++ nlx.lisp 7 Apr 2007 20:00:25 -0000 1.21 @@ -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) Index: sap.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/sap.lisp,v retrieving revision 1.11 retrieving revision 1.12 diff -u -d -r1.11 -r1.12 --- sap.lisp 27 Jan 2007 03:45:50 -0000 1.11 +++ sap.lisp 7 Apr 2007 20:00:25 -0000 1.12 @@ -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)) Index: vm.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/x86/vm.lisp,v retrieving revision 1.25 retrieving revision 1.26 diff -u -d -r1.25 -r1.26 --- vm.lisp 13 Jan 2007 21:05:34 -0000 1.25 +++ vm.lisp 7 Apr 2007 20:00:25 -0000 1.26 @@ -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 |