Changeset 7773 for branches

Timestamp:

Nov 28, 2007, 2:31:41 PM (17 years ago)

Author:

R. Matthew Emerson

Message:

Still more cases where additional imm regs are needed.

File:

• branches/ia32/compiler/X86/x862.lisp (modified) (5 diffs)

branches/ia32/compiler/X86/x862.lisp

@@ -4431 +4431 @@
                                                                       ptr
                                                                       ptr-reg)))
-                          (! mem-set-c-constant-doubleword intval ptr-reg offval))))
+                          (target-word-size-case
+                           (32
+                            (! mem-set-c-constant-fullword intval ptr-reg offval))
+                           (64
+                            (! mem-set-c-constant-doubleword intval ptr-reg offval))))))
                      (t
-                      (with-imm-target () (ptr-reg :address)
-                        (with-imm-target (ptr-reg) (offsetreg :signed-natural)
-                          (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
-                          (! fixnum->signed-natural offsetreg *x862-arg-z*)
-                          (! mem-set-constant-doubleword intval ptr-reg offsetreg)))))
+                      (with-additional-imm-reg ()
+                        (with-imm-target () (ptr-reg :address)
+                          (with-imm-target (ptr-reg) (offsetreg :signed-natural)
+                            (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
+                            (! fixnum->signed-natural offsetreg *x862-arg-z*)
+                            (target-word-size-case
+                             (32 (! mem-set-constant-fullword intval ptr-reg offsetreg))
+                             (64 (! mem-set-constant-doubleword intval ptr-reg offsetreg))))))))
                (if for-value
-                 (with-imm-target () (val-reg :s64)
+                 (with-imm-target () (val-reg (target-word-size-case (32 :s32) (64 :s64)))
                    (x862-lri seg val-reg intval)
                    (<- (set-regspec-mode val-reg (gpr-mode-name-value :address))))))
@@ -4449 +4456 @@
                (multiple-value-bind (address node)
                    (address-and-node-regs)
-                 (with-imm-target (address) (ptr-reg :address)
-                   (x862-pop-register seg ptr-reg)
-                   (! mem-set-c-doubleword address ptr-reg offval))
+                 (with-additional-imm-reg ()
+                   (with-imm-target (address) (ptr-reg :address)
+                     (x862-pop-register seg ptr-reg)
+                     (target-word-size-case
+                      (32 (! mem-set-c-fullword address ptr-reg offval))
+                      (64 (! mem-set-c-doubleword address ptr-reg offval)))))
                  (if for-value
                    (<- node))))
               (t
                (with-imm-target () (ptr-reg :address)
-                 (with-imm-target (ptr-reg) (offset-reg :address)
-                   (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
-                   (! fixnum->signed-natural offset-reg *x862-arg-z*)
-                   (! fixnum-add2 ptr-reg offset-reg)
-                   (x862-push-register seg ptr-reg)))
+                 (with-additional-imm-reg ()
+                   (with-imm-target (ptr-reg) (offset-reg :address)
+                     (x862-two-targeted-reg-forms seg ptr ptr-reg offset ($ *x862-arg-z*))
+                     (! fixnum->signed-natural offset-reg *x862-arg-z*)
+                     (! fixnum-add2 ptr-reg offset-reg)
+                     (x862-push-register seg ptr-reg))))
                (multiple-value-bind (address node)
                    (address-and-node-regs)
-                 (with-imm-target (address) (ptr-reg :address)
-                   (x862-pop-register seg ptr-reg)
-                   (! mem-set-c-doubleword address ptr-reg 0))
+                 (with-additional-imm-reg ()
+                   (with-imm-target (address) (ptr-reg :address)
+                     (x862-pop-register seg ptr-reg)
+                     (target-word-size-case
+                      (32 (! mem-set-c-fullword address ptr-reg 0))
+                      (64 (! mem-set-c-doubleword address ptr-reg 0)))))
                  (if for-value
                    (<- node))))))
@@ -7713 +7727 @@
                (let* ((src (x862-macptr-arg-to-reg seg ptr ($ *x862-imm0* :mode :address))))
                  (if triv-p
-                   (with-imm-temps (src) (x)
-                     (if (acode-fixnum-form-p offset)
-                       (x862-lri seg x (acode-fixnum-form-p offset))
-                       (! fixnum->signed-natural x (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
-                     (! mem-ref-natural dest src x))
+                   (with-additional-imm-reg ()
+                     (with-imm-temps (src) (x)
+                       (if (acode-fixnum-form-p offset)
+                         (x862-lri seg x (acode-fixnum-form-p offset))
+                         (! fixnum->signed-natural x (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
+                       (! mem-ref-natural dest src x)))
                    (progn
                      (! temp-push-unboxed-word src)
                      (x862-open-undo $undostkblk)
                      (let* ((oreg (x862-one-untargeted-reg-form seg offset *x862-arg-z*)))
-                       (with-imm-temps () (src x)
-                         (! temp-pop-unboxed-word src)
-                         (x862-close-undo)
-                         (! fixnum->signed-natural x oreg)
-                         (! mem-ref-natural dest src x)))))))) 
+                       (with-additional-imm-reg (*x862-arg-z*)
+                         (with-imm-temps () (src x)
+                           (! temp-pop-unboxed-word src)
+                           (x862-close-undo)
+                           (! fixnum->signed-natural x oreg)
+                           (! mem-ref-natural dest src x)))))))))
            (^)))))
 
@@ -8102 +8118 @@
            (x862-form seg nil xfer offset))
           ((typep fixoffset '(signed-byte 16))
-           (with-imm-target () (val :natural)
-             (! lisp-word-ref-c val
-                (x862-one-untargeted-reg-form seg base *x862-arg-z*) 
-                fixoffset)
-             (<- val))
+           (format t "~&in constant offset branch")
+           (with-imm-target () (val :natural)
+             (! lisp-word-ref-c val
+                (x862-one-untargeted-reg-form seg base *x862-arg-z*) 
+                fixoffset)
+             (<- val))
            (^))
           (t (multiple-value-bind (breg oreg)
                  (x862-two-untargeted-reg-forms seg base *x862-arg-y* offset *x862-arg-z*)
+               (format t "~&in general offset branch")
                (with-imm-target () (otemp :s32)
                  (! fixnum->signed-natural otemp oreg)
-                 (with-imm-target () (val :natural)
-                   (! lisp-word-ref val breg otemp)
-                   (<- val)))
+                 (with-additional-imm-reg (otemp)
+                   (with-imm-target () (val :natural)
+                     (! lisp-word-ref val breg otemp)
+                     (<- val))))
                (^))))))
 
@@ -9129 +9148 @@
         (let* ((u31y (and (typep fix-y '(unsigned-byte 31)) fix-y)))
           (if (not u31y)
-            (with-imm-target () (xreg :natural)
-              (with-imm-target (xreg) (yreg :natural)
-                (x862-two-targeted-reg-forms seg x xreg y yreg)
-                (! %natural- xreg xreg yreg))
-              (<- xreg))
+            (with-additional-imm-reg ()
+              (with-imm-target () (xreg :natural)
+                (with-imm-target (xreg) (yreg :natural)
+                  (x862-two-targeted-reg-forms seg x xreg y yreg)
+                  (! %natural- xreg yreg))
+                (<- xreg)))
             (progn
               (with-imm-target () (xreg :natural)
                 (x862-one-targeted-reg-form seg x xreg)
-                (! %natural--c xreg xreg u31y)
+                (! %natural--c xreg u31y)
                 (<- xreg))))
           (^))))))