Changeset 6990 for branches

Timestamp:

Aug 2, 2007, 5:54:10 PM (17 years ago)

Author:

R. Matthew Emerson

Message:

Sprinkle target-arch-case all over the place.

File:

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

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

@@ -22 +22 @@
 (defx86lapmacro rcmp (src dest)
   `(cmp ,dest ,src))
+
+(defx86lapmacro clrl (reg)
+  `(xorl (% ,reg) (% ,reg)))
 
 (defx86lapmacro clrq (reg)
@@ -64 +67 @@
 
 
-
 (defx86lapmacro extract-lisptag (node dest)
-  `(progn
-    (movb ($ x8664::tagmask) (%b ,dest))
-    (andb (%b ,node) (%b ,dest))))
+  (target-arch-case
+   (:x8632
+    `(progn
+       (movb ($ x8632::tagmask) (%b ,dest))
+       (andb (%b ,node) (%b ,dest))))
+   (:x8664
+    `(progn
+       (movb ($ x8664::tagmask) (%b ,dest))
+       (andb (%b ,node) (%b ,dest))))))
 
 (defx86lapmacro extract-fulltag (node dest)
-  `(progn
-    (movb ($ x8664::fulltagmask) (%b ,dest))
-    (andb (%b ,node) (%b ,dest))))
+  (target-arch-case
+   (:x8632
+    `(progn
+       (movb ($ x8632::fulltagmask) (%b ,dest))
+       (andb (%b ,node) (%b ,dest))))
+   (:x8664
+    `(progn
+       (movb ($ x8664::fulltagmask) (%b ,dest))
+       (andb (%b ,node) (%b ,dest))))))
 
 (defx86lapmacro extract-subtag (node dest)
-  `(movb (@ x8664::misc-subtag-offset (% ,node)) (%b ,dest)))
+  (target-arch-case
+   (:x8632
+    `(movb (@ x8632::misc-subtag-offset (% ,node)) (%b ,dest)))
+   (:x8664
+    `(movb (@ x8664::misc-subtag-offset (% ,node)) (%b ,dest)))))
 
 (defx86lapmacro extract-typecode (node dest)
@@ -83 +101 @@
   ;;; the #xff00 byte.
   (let* ((done (gensym)))
-    `(progn
-      (extract-lisptag ,node ,dest)
-      (rcmp (%b ,dest) ($ x8664::tag-misc))
-      (jne ,done)
-      (movb (@  x8664::misc-subtag-offset (% ,node)) (%b ,dest))
-      ,done)))
+    (target-arch-case
+     (:x8632
+      `(progn
+         (extract-lisptag ,node ,dest)
+         (rcmp (%b ,dest) ($ x8632::tag-misc))
+         (jne ,done)
+         (movb (@  x8632::misc-subtag-offset (% ,node)) (%b ,dest))
+         ,done))
+     (:x8664
+      `(progn
+         (extract-lisptag ,node ,dest)
+         (rcmp (%b ,dest) ($ x8664::tag-misc))
+         (jne ,done)
+         (movb (@  x8664::misc-subtag-offset (% ,node)) (%b ,dest))
+         ,done)))))
 
 (defx86lapmacro trap-unless-typecode= (node tag &optional (immreg 'imm0))
@@ -119 +146 @@
 (defx86lapmacro trap-unless-fixnum (node)
   (let* ((ok (gensym)))
-    `(progn
-      (testb ($ x8664::tagmask) (%b ,node))
-      (je.pt ,ok)
-      (uuo-error-reg-not-fixnum (% ,node))
-      ,ok)))
+    (target-arch-case
+     (:x8632
+      `(progn
+         (testb ($ x8632::tagmask) (%b ,node))
+         (je.pt ,ok)
+         (uuo-error-reg-not-fixnum (% ,node))
+         ,ok))
+     (:x8664
+      `(progn
+         (testb ($ x8664::tagmask) (%b ,node))
+         (je.pt ,ok)
+         (uuo-error-reg-not-fixnum (% ,node))
+         ,ok)))))
 
 ;;; On x8664, NIL has its own tag, so no other lisp object can
-;;; have the same low byte as NIL.  (That probably won't be
-;;; true on x8632.)
+;;; have the same low byte as NIL.  On x8632, NIL is a just
+;;; a distiguished CONS.
 (defx86lapmacro cmp-reg-to-nil (reg)
-  `(cmpb ($ (logand #xff x8664::nil-value)) (%b ,reg)))
-
+  (target-arch-case
+   (:x8632
+    `(cmpl ($ x8632::nil-value) (%l ,reg)))
+   (:x8664
+    `(cmpb ($ (logand #xff x8664::nil-value)) (%b ,reg)))))
 
 (defx86lapmacro unbox-fixnum (src dest)
-  `(progn
-    (mov (% ,src) (% ,dest))
-    (sar ($ x8664::fixnumshift) (% ,dest))))
+  (target-arch-case
+   (:x8632
+    `(progn
+       (mov (% ,src) (% ,dest))
+       (sar ($ x8632::fixnumshift) (% ,dest))))
+   (:x8664
+    `(progn
+       (mov (% ,src) (% ,dest))
+       (sar ($ x8664::fixnumshift) (% ,dest))))))
 
 (defx86lapmacro box-fixnum (src dest)
-  `(imulq ($ x8664::fixnumone) (% ,src) (% ,dest)))
-
+  (target-arch-case
+   (:x8632
+    `(imull ($ x8632::fixnumone) (% ,src) (% ,dest)))
+   (:x8664
+    `(imulq ($ x8664::fixnumone) (% ,src) (% ,dest)))))
 
 (defx86lapmacro get-single-float (node dest)
@@ -155 +202 @@
 
 (defx86lapmacro get-double-float (src fpreg)
-  `(movsd (@ x8664::double-float.value (% ,src)) (% ,fpreg)))
+  (target-arch-case
+   (:x8632
+    `(movsd (@ x8632::double-float.value (% ,src)) (% ,fpreg)))
+   (:x8664
+    `(movsd (@ x8664::double-float.value (% ,src)) (% ,fpreg)))))
 
 (defx86lapmacro put-double-float (fpreg dest)
-  `(movsd (% ,fpreg) (@ x8664::double-float.value (% ,dest))))
-  
-
-  
+  (target-arch-case
+   (:x8632
+    `(movsd (% ,fpreg) (@ x8632::double-float.value (% ,dest))))
+   (:x8664
+    `(movsd (% ,fpreg) (@ x8664::double-float.value (% ,dest))))))
+ 
 (defx86lapmacro getvheader (src dest)
-  `(movq (@ x8664::misc-header-offset (% ,src)) (% ,dest)))
+  (target-arch-case
+   (:x8632
+    `(movl (@ x8632::misc-header-offset (% ,src)) (% ,dest)))
+   (:x8664
+    `(movq (@ x8664::misc-header-offset (% ,src)) (% ,dest)))))
 
 ;;; "Size" is unboxed element-count.  vheader and dest should
 ;;; both be immediate registers
 (defx86lapmacro header-size (vheader dest)
-  `(progn
-    (mov (% ,vheader) (% ,dest))
-    (shr ($ x8664::num-subtag-bits) (% ,dest))))
-
+  (target-arch-case
+   (:x8632
+    `(progn
+       (mov (% ,vheader) (% ,dest))
+       (shr ($ x8632::num-subtag-bits) (% ,dest))))
+   (:x8664
+    `(progn
+       (mov (% ,vheader) (% ,dest))
+       (shr ($ x8664::num-subtag-bits) (% ,dest))))))
 
 ;;; "Length" is fixnum element-count.
 (defx86lapmacro header-length (vheader dest)
-  `(progn
-    (movq ($ (lognot 255)) (% ,dest))
-    (andq (% ,vheader) (% ,dest))
-    (shr ($ (- x8664::num-subtag-bits x8664::fixnumshift)) (% ,dest))))
+  (target-arch-case
+   (:x8632
+    `(progn
+       (movl ($ (lognot 255)) (% ,dest))
+       (andl (% ,vheader) (% ,dest))
+       (shr ($ (- x8632::num-subtag-bits x8632::fixnumshift)) (% ,dest))))
+   (:x8664
+    `(progn
+       (movq ($ (lognot 255)) (% ,dest))
+       (andq (% ,vheader) (% ,dest))
+       (shr ($ (- x8664::num-subtag-bits x8664::fixnumshift)) (% ,dest))))))
 
 (defx86lapmacro header-subtag[fixnum] (vheader dest)
@@ -191 +260 @@
 
 (defx86lapmacro vector-length (vector dest)
-  `(progn
-    (movq ($ (lognot 255)) (% ,dest))
-    (andq (@ x8664::misc-header-offset (% ,vector)) (% ,dest))
-    (shr ($ (- x8664::num-subtag-bits x8664::fixnumshift)) (% ,dest))))  
-
+  (target-arch-case
+   (:x8632
+    `(progn
+       (movq ($ (lognot 255)) (% ,dest))
+       (andq (@ x8632::misc-header-offset (% ,vector)) (% ,dest))
+       (shr ($ (- x8632::num-subtag-bits x8632::fixnumshift)) (% ,dest))))
+   (:x8664
+    `(progn
+       (movq ($ (lognot 255)) (% ,dest))
+       (andq (@ x8664::misc-header-offset (% ,vector)) (% ,dest))
+       (shr ($ (- x8664::num-subtag-bits x8664::fixnumshift)) (% ,dest))))))
 
 (defx86lapmacro int-to-double (int temp double)
@@ -208 +283 @@
 
 (defx86lapmacro ref-global (global reg)
-  `(movq (@ (+ x8664::nil-value ,(x8664::%kernel-global global))) (% ,reg)))
+  (target-arch-case
+   (:x8632
+    `(movl (@ (+ x8632::nil-value ,(x8632::%kernel-global global))) (% ,reg)))
+   (:x8664
+    `(movq (@ (+ x8664::nil-value ,(x8664::%kernel-global global))) (% ,reg)))))
 
 (defx86lapmacro ref-global.l (global reg)
-  `(movl (@ (+ x8664::nil-value ,(x8664::%kernel-global global))) (%l ,reg)))
+  (target-arch-case
+   (:x8632
+    `(movl (@ (+ x8632::nil-value ,(x8632::%kernel-global global))) (%l ,reg)))
+   (:x8664
+    `(movl (@ (+ x8664::nil-value ,(x8664::%kernel-global global))) (%l ,reg)))))
 
 (defx86lapmacro set-global (reg global)
-  `(movq (% ,reg) (@ (+ x8664::nil-value ,(x8664::%kernel-global global)))))
+  (target-arch-case
+   (:x8632
+    `(movl (% ,reg) (@ (+ x8632::nil-value ,(x8632::%kernel-global global)))))
+   (:x8664
+    `(movq (% ,reg) (@ (+ x8664::nil-value ,(x8664::%kernel-global global)))))))
 
 (defx86lapmacro macptr-ptr (src dest)
-  `(movq (@ x8664::macptr.address (% ,src)) (% ,dest)))
+  (target-arch-case
+   (:x8632
+    `(movl (@ x8632::macptr.address (% ,src)) (% ,dest)))
+   (:x8664
+    `(movq (@ x8664::macptr.address (% ,src)) (% ,dest)))))
 
 ;;; CODE is unboxed char-code (in low 8 bits); CHAR needs to be boxed.
 (defx86lapmacro box-character (code char)
-  `(progn
-    (box-fixnum ,code ,char)
-    (shl ($ (- x8664::charcode-shift x8664::fixnumshift)) (% ,char))
-    (movb ($ x8664::subtag-character) (%b ,char))))
-
+  (target-arch-case
+   (:x8632
+    `(progn
+       (box-fixnum ,code ,char)
+       (shl ($ (- x8632::charcode-shift x8632::fixnumshift)) (% ,char))
+       (movb ($ x8632::subtag-character) (%b ,char))))
+   (:x8664
+    `(progn
+       (box-fixnum ,code ,char)
+       (shl ($ (- x8664::charcode-shift x8664::fixnumshift)) (% ,char))
+       (movb ($ x8664::subtag-character) (%b ,char))))))
   
 ;;; index is a constant
 (defx86lapmacro svref (vector index dest)
-  `(movq (@ (+ x8664::misc-data-offset (* ,index 8)) (% ,vector)) (% ,dest)))
+  (target-arch-case
+   (:x8632
+    `(movl (@ (+ x8632::misc-data-offset (* ,index 4)) (% ,vector)) (% ,dest)))
+   (:x8664
+    `(movq (@ (+ x8664::misc-data-offset (* ,index 8)) (% ,vector)) (% ,dest)))))
 
 ;;; Index is still a constant
 (defx86lapmacro svset (vector index new)
-  `(movq (% ,new) (@ (+ x8664::misc-data-offset (* ,index 8)) (% ,vector))))
-
+  (target-arch-case
+   (:x8632
+    `(movl (% ,new) (@ (+ x8632::misc-data-offset (* ,index 4)) (% ,vector))))
+   (:x8664
+    `(movq (% ,new) (@ (+ x8664::misc-data-offset (* ,index 8)) (% ,vector))))))
 
 
@@ -242 +346 @@
 ;;; Simple frame, since the caller didn't reserve space for it.
 (defx86lapmacro save-simple-frame ()
-  `(progn
-    (pushq (% rbp))
-    (movq (% rsp) (% rbp))))
-
+  (target-arch-case
+   (:x8632
+    `(progn
+       (pushl (% ebp))
+       (movl (% esp) (% ebp))))
+   (:x8664
+    `(progn
+       (pushq (% rbp))
+       (movq (% rsp) (% rbp))))))
+
+;;; need better understanding than just a vague notion
+;;; of what is going on here
 (defx86lapmacro save-frame-variable-arg-count ()
   (let* ((push (gensym))
          (done (gensym)))
-  `(progn
-    (movzwl (% nargs) (%l imm0))
-    (subq ($ (* $numx8664argregs x8664::node-size)) (% imm0))
-    (jle ,push)
-    (movq (% rbp) (@ 8 (% rsp) (% imm0)))
-    (leaq (@ 8 (% rsp) (% imm0)) (% rbp))
-    (popq (@ 8 (% rbp)))
-    (jmp ,done)
-    ,push
-    (save-simple-frame)
-    ,done)))
+    (target-arch-case
+     (:x8632
+      `(progn
+         (movzxwl (% nargs) (% imm0))
+         (subl ($ (* $numx8632argregs x8632::node-size)) (% imm0))
+         (jle ,push)
+         (movl (% ebp) (@ 4 (% esp) (% imm0)))
+         (leaq (@ 4 (% esp) (% imm0)) (% ebp))
+         (popl (@ (% ebp)))
+         (jmp ,done)
+         ,push
+         (save-simple-frame)
+         ,done))
+     (:x8664
+      `(progn
+         (movzwl (% nargs) (%l imm0))
+         (subq ($ (* $numx8664argregs x8664::node-size)) (% imm0))
+         (jle ,push)
+         (movq (% rbp) (@ 8 (% rsp) (% imm0)))
+         (leaq (@ 8 (% rsp) (% imm0)) (% rbp))
+         (popq (@ 8 (% rbp)))
+         (jmp ,done)
+         ,push
+         (save-simple-frame)
+         ,done)))))
 
 
@@ -266 +392 @@
     (leave)))
 
-
-
+;;; not sure about this
 (defx86lapmacro discard-reserved-frame ()
-  `(add ($ '2) (% rsp)))
+  (target-arch-case
+   (:x8632
+    `(add ($ '2) (% esp)))
+   (:x8664
+    `(add ($ '2) (% rsp)))))
 
 ;;; Return to caller.
 (defx86lapmacro single-value-return (&optional (words-to-discard 0))
-  (if (zerop words-to-discard)
-    `(ret)
-    `(ret ($ ,(* x8664::node-size words-to-discard)))))
-
+  (target-arch-case
+   (:x8632
+    (if (zerop words-to-discard)
+        `(ret)
+        `(ret ($ ,(* x8632::node-size words-to-discard)))))
+   (:x8664
+    (if (zerop words-to-discard)
+        `(ret)
+        `(ret ($ ,(* x8664::node-size words-to-discard)))))))
+
+;;; xxx add ia32 version
 ;;; Using *x8664-backend* here is wrong but expedient.
+;;; Using *x8632-backend* makes it doubly wrong, I guess.
 (defun x86-subprim-offset (name)
-  (let* ((info (find name (arch::target-subprims-table (backend-target-arch *x8664-backend*)) :test #'string-equal :key #'subprimitive-info-name))
-         (offset (when info 
-                   (subprimitive-info-offset info))))
-    (or offset      
-      (error "Unknown subprim: ~s" name))))
+  (let (info
+        offset)
+    (target-arch-case
+     (:x8632
+      (setf info (find name (arch::target-subprims-table (backend-target-arch *x8632-backend*)) :test #'string-equal :key #'subprimitive-info-name))
+      (setf offset (when info 
+                     (subprimitive-info-offset info))))
+     (:x8664
+      (setf info (find name (arch::target-subprims-table (backend-target-arch *x8664-backend*)) :test #'string-equal :key #'subprimitive-info-name))
+      (setf offset (when info
+                     (subprimitive-info-offset info))))
+      (or offset      
+          (error "Unknown subprim: ~s" name)))))
 
 (defx86lapmacro jmp-subprim (name)
   `(jmp (@ ,(x86-subprim-offset name))))
 
+(defx86lapmacro recover-fn ()
+  `(movl ($ :self) (% fn)))
+
 (defx86lapmacro call-subprim (name)
-  `(progn
-    (:talign 4)
-    (call (@ ,(x86-subprim-offset name)))
-    (recover-fn-from-rip)))
-
-     
-(defx86lapmacro %car (src dest)
-  `(movq (@ x8664::cons.car (% ,src)) (% ,dest)))
+  (target-arch-case
+   (:x8632
+    `(progn
+       (:talign x8632::fulltag-tra)
+       (call (@ ,(x86-subprim-offset name)))
+       (recover-fn)))
+   (:x8664
+    `(progn
+       (:talign 4)
+       (call (@ ,(x86-subprim-offset name)))
+       (recover-fn-from-rip)))))
+
+ (defx86lapmacro %car (src dest)
+  (target-arch-case
+   (:x8632
+    `(movl (@ x8632::cons.car (% ,src)) (% ,dest)))
+   (:x8664
+    `(movq (@ x8664::cons.car (% ,src)) (% ,dest)))))
 
 (defx86lapmacro %cdr (src dest)
-  `(movq (@ x8664::cons.cdr (% ,src)) (% ,dest)))
+  (target-arch-case
+   (:x8632
+    `(movl (@ x8632::cons.cdr (% ,src)) (% ,dest)))
+   (:x8664
+    `(movq (@ x8664::cons.cdr (% ,src)) (% ,dest)))))
 
 (defx86lapmacro stack-probe ()
-  (let* ((ok (gensym)))
-    `(progn
-      (rcmp (% rsp) (@ (% rcontext) x8664::tcr.cs-limit))
-      (jae.pt ,ok)
-      (uuo-stack-overflow)
-      ,ok)))
+  (target-arch-case
+   (:x8632
+    (let* ((ok (gensym)))
+      `(progn
+         (rcmp (% esp) (@ (% rcontext) x8632::tcr.cs-limit))
+         (jae.pt ,ok)
+         (uuo-stack-overflow)
+         ,ok)))
+   (:x8664
+    (let* ((ok (gensym)))
+      `(progn
+         (rcmp (% rsp) (@ (% rcontext) x8664::tcr.cs-limit))
+         (jae.pt ,ok)
+         (uuo-stack-overflow)
+         ,ok)))))
 
 (defx86lapmacro load-constant (constant dest &optional (fn 'fn))
-  `(movq (@ ',constant (% ,fn)) (% ,dest)))
+  (target-arch-case
+   (:x8632
+    `(movl (@ ',constant (% ,fn)) (% ,dest)))
+   (:x8664
+    `(movq (@ ',constant (% ,fn)) (% ,dest)))))
 
 (defx86lapmacro recover-fn-from-rip ()
@@ -322 +497 @@
 ;;; to return a single value.
 (defx86lapmacro call-symbol (name nargs)
-  `(progn
-    (load-constant ,name fname)
-    (set-nargs ,nargs)
-    (:talign 4)
-    (call (@ x8664::symbol.fcell (% fname)))
-    (recover-fn-from-rip)))
+  (target-arch-case
+   (:x8632
+    `(progn
+       (load-constant ,name fname)
+       (set-nargs ,nargs)
+       (:talign 5)
+       (call (@ x8632::symbol.fcell (% fname)))
+       (recover-fn)))
+   (:x8664
+    `(progn
+       (load-constant ,name fname)
+       (set-nargs ,nargs)
+       (:talign 4)
+       (call (@ x8664::symbol.fcell (% fname)))
+       (recover-fn-from-rip)))))
 
 
@@ -336 +520 @@
 ;;;  prevent the current function from being GCed halfway through
 ;;;  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)
   `(progn
     (load-constant ,name fname)
     (set-nargs ,nargs)
-    (jmp (@ x8664::symbol.fcell (% fname)))))
+    (target-arch-case
+     (:x8632
+      (jmp (@ x8632::symbol.fcell (% fname))))
+     (:x8664
+      (jmp (@ x8664::symbol.fcell (% fname)))))))
 
 (defx86lapmacro push-argregs ()
@@ -346 +538 @@
          (yz (gensym))
          (z (gensym)))
-  `(progn
-    (testw (% nargs) (% nargs))
-    (je ,done)
-    (cmpw ($ '2) (% nargs))
-    (je ,yz)
-    (jb ,z)
-    (push (% arg_x))
-    ,yz
-    (push (% arg_y))
-    ,z
-    (push (% arg_z))
-    ,done)))
+    (target-arch-case
+     (:x8632
+      `(progn
+         (testw (% nargs) (% nargs))
+         (je ,done)
+         (cmpw ($ '1) (% nargs))
+         (je ,z)
+         (push (% arg_y))
+         ,z
+         (push (% arg_z))
+         ,done))
+     (:x8664
+      `(progn
+         (testw (% nargs) (% nargs))
+         (je ,done)
+         (cmpw ($ '2) (% nargs))
+         (je ,yz)
+         (jb ,z)
+         (push (% arg_x))
+         ,yz
+         (push (% arg_y))
+         ,z
+         (push (% arg_z))
+         ,done)))))