Changeset 8076

Timestamp:

Jan 15, 2008, 3:13:22 AM (12 years ago)

Author:

rme

Message:

Several changes and additions for IA-32, including mark-as-imm/mark-as-node
macros that alter bits in the TCR to indicate to the GC whether a register
contains a node or an immediate.

File:

• branches/ia32/compiler/X86/x86-lapmacros.lisp (modified) (8 diffs)

branches/ia32/compiler/X86/x86-lapmacros.lisp

@@ -70 +70 @@
   (target-arch-case
    (:x8632
-    (assert (x86-acc-reg-p dest) () "dest reg must be accumulator")
-    `(progn
-       (movb ($ x8632::tagmask) (%b ,dest))
-       (andl (%l ,node) (%l ,dest))))
+    (if (x86-byte-reg-p dest)
+      `(progn
+         (movb ($ x8632::tagmask) (%b ,dest))
+         (andl (%l ,node) (%l ,dest)))
+      `(progn
+         (movl ($ x8632::tagmask) (% ,dest))
+         (andl (%l ,node) (%l ,dest)))))
    (:x8664
     `(progn
@@ -152 +155 @@
      (:x8632
       `(progn
-         (testb ($ x8632::tagmask) (%b ,node))
+         (test ($ x8632::tagmask) (% ,node))
          (je.pt ,ok)
          (uuo-error-reg-not-fixnum (% ,node))
@@ -192 +195 @@
 
 (defx86lapmacro get-single-float (node dest)
-  `(progn
-    (movd (% ,node) (% ,dest))
-    (psrlq ($ 32) (% ,dest))))
-
-
-;;; Note that this modifies the src argument.
+  (target-arch-case
+   (:x8632
+    `(movss (@ x8632::single-float.value (% ,node)) (% ,dest)))
+   (:x8664
+    `(progn
+       (movd (% ,node) (% ,dest))
+       (psrlq ($ 32) (% ,dest))))))
+
+;;; Note that this modifies the src argument in the x8664 case.
 (defx86lapmacro put-single-float (src node)
-  `(progn
-    (psllq ($ 32) (% ,src))
-    (movd (% ,src) (% ,node))
-    (movb ($ x8664::tag-single-float) (%b ,node))))
+  (target-arch-case
+   (:x8632
+    `(movss (% ,src) (@ x8632::single-float.value (% ,node))))
+   (:x8664
+    `(progn
+       (psllq ($ 32) (% ,src))
+       (movd (% ,src) (% ,node))
+       (movb ($ x8664::tag-single-float) (%b ,node))))))
 
 (defx86lapmacro get-double-float (src fpreg)
@@ -266 +276 @@
    (:x8632
     `(progn
-       (movq ($ (lognot 255)) (% ,dest))
-       (andq (@ x8632::misc-header-offset (% ,vector)) (% ,dest))
+       (movl ($ (lognot 255)) (% ,dest))
+       (andl (@ x8632::misc-header-offset (% ,vector)) (% ,dest))
        (shr ($ (- x8632::num-subtag-bits x8632::fixnumshift)) (% ,dest))))
    (:x8664
@@ -276 +286 @@
 
 (defx86lapmacro int-to-double (int temp double)
-  `(progn
-    (unbox-fixnum  ,int ,temp)
-    (cvtsi2sdq (% ,temp) (% ,double))))
+  (target-arch-case
+   (:x8632
+    `(progn
+       (unbox-fixnum  ,int ,temp)
+       (cvtsi2sdl (% ,temp) (% ,double))))
+   (:x8664
+    `(progn
+       (unbox-fixnum  ,int ,temp)
+       (cvtsi2sdq (% ,temp) (% ,double))))))
 
 (defx86lapmacro int-to-single (int temp single)
-  `(progn
-    (unbox-fixnum ,int ,temp)
-    (cvtsi2ssq (% ,temp) (% ,single))))
+  (target-arch-case
+   (:x8632
+    `(progn
+       (unbox-fixnum ,int ,temp)
+       (cvtsi2ssl (% ,temp) (% ,single))))
+   (:x8664
+    `(progn
+       (unbox-fixnum ,int ,temp)
+       (cvtsi2ssq (% ,temp) (% ,single))))))
 
 (defx86lapmacro ref-global (global reg)
@@ -367 +389 @@
      (:x8632
       `(progn
-         (movzxwl (% nargs) (% imm0))
+         (movzwl (% nargs) (% imm0))
          (subl ($ (* $numx8632argregs x8632::node-size)) (% imm0))
          (jle ,push)
          (movl (% ebp) (@ 4 (% esp) (% imm0)))
-         (leaq (@ 4 (% esp) (% imm0)) (% ebp))
+         (leal (@ 4 (% esp) (% imm0)) (% ebp))
          (popl (@ (% ebp)))
          (jmp ,done)
@@ -512 +534 @@
 ;;;  those couple of instructions.
 
-;;; The above comment appears to be stale.
-;;; %fn (which is distinct from %fname) will be pointing to
-;;; the current function, so it won't get GCed out from under us.
 (defx86lapmacro jump-symbol (name nargs)
   (target-arch-case
@@ -556 +575 @@
          (push (% arg_z))
          ,done)))))
-    
+
+;;; clears reg
+(defx86lapmacro mark-as-node (reg)
+  (let* ((regnum (logand #x7 (x86::gpr-ordinal (string reg))))
+         (bit (ash 1 regnum)))
+    `(progn
+       (xorl (% ,reg) (% ,reg))
+       (orb ($ ,bit) (@ (% :rcontext) x8632::tcr.node-regs-mask)))))
+
+(defx86lapmacro mark-as-imm (reg)
+  (let* ((regnum (logand #x7 (x86::gpr-ordinal (string reg))))
+         (bit (ash 1 regnum)))
+    `(progn
+       (andb ($ (lognot ,bit)) (@ (% :rcontext) x8632::tcr.node-regs-mask)))))
+