1.0.2.42: x86 backend cleanups
authorlisphacker <lisphacker>
Sat, 7 Apr 2007 20:00:24 +0000 (20:00 +0000)
committerlisphacker <lisphacker>
Sat, 7 Apr 2007 20:00:24 +0000 (20:00 +0000)
  * 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.

src/compiler/x86/call.lisp
src/compiler/x86/char.lisp
src/compiler/x86/debug.lisp
src/compiler/x86/float.lisp
src/compiler/x86/insts.lisp
src/compiler/x86/move.lisp
src/compiler/x86/nlx.lisp
src/compiler/x86/sap.lisp
src/compiler/x86/vm.lisp
version.lisp-expr

index c4200f3..85d4452 100644 (file)
 
     ;; 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
 
             (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)
       (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)
       ;; 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))
       ;; 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)
       ;; 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)
       #!+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))
 \f
          #+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)))))
 
                        (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)))))
                        (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)))))
           (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))
        ;; 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)
                                       (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
                                '(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.
                           )))
           ;; 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
        ;; 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
            (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 f44f327..d4fcfce 100644 (file)
       (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 4a8f0ec..3869b6a 100644 (file)
@@ -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 621a1cd..cd2c3ba 100644 (file)
@@ -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)
 (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))
                                  (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)
                                          (: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)))
   (: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)
   (: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)
        (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)))))
        (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)))))
        (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
        (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)))))
        (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 1f4c432..05d9b33 100644 (file)
         (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 31903d5..6d1ceb5 100644 (file)
                                    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)
       ((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 4a35f6d..35760ab 100644 (file)
@@ -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))))
 
 \f
 ;;;; Save and restore dynamic environment.
                  (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 3f5ae15..eb46d70 100644 (file)
@@ -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 5099c3c..d0a9a41 100644 (file)
 ;;; 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
index 5d089c8..927791c 100644 (file)
@@ -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"