[Openmcl-cvs-notifications] r10139 - /trunk/source/level-1/x86-trap-support.lisp

[rme at clozure.com]

Author: rme
Date: Sat Jul 19 01:10:17 2008
New Revision: 10139

Log:
x8632 and Darwin/x8632 support.

Modified:
    trunk/source/level-1/x86-trap-support.lisp

Modified: trunk/source/level-1/x86-trap-support.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/x86-trap-support.lisp (original)
+++ trunk/source/level-1/x86-trap-support.lisp Sat Jul 19 01:10:17 2008
@@ -157,42 +157,71 @@
       0                                 ;r15
       )))
 =

+#+darwinx8632-target
+(progn
+  (defconstant gp-regs-offset 0)
+  (defmacro xp-gp-regs (xp)
+    `(pref (pref ,xp :ucontext.uc_mcontext) :mcontext.ss))
+  (defun xp-mxcsr (xp)
+    (%get-unsigned-long (pref (pref xp :ucontext.uc_mcontext) :mcontext.fs=
) 32))
+  (defconstant flags-register-offset 9)
+  (defconstant eip-register-offset 10)
+  (defparameter *encoded-gpr-to-indexed-gpr*
+    #(0					;eax
+      2					;ecx
+      3					;edx
+      1					;ebx
+      7					;esp
+      6					;ebp
+      5					;esi
+      4					;edi
+      )))
+
 (defun indexed-gpr-lisp (xp igpr)
-  (%get-object (xp-gp-regs xp) (+ gp-regs-offset (ash igpr x8664::word-shi=
ft))))
+  (%get-object (xp-gp-regs xp) (+ gp-regs-offset (ash igpr target::word-sh=
ift))))
 (defun (setf indexed-gpr-lisp) (new xp igpr)
-  (%set-object (xp-gp-regs xp) (+ gp-regs-offset (ash igpr x8664::word-shi=
ft)) new))
+  (%set-object (xp-gp-regs xp) (+ gp-regs-offset (ash igpr target::word-sh=
ift)) new))
 (defun encoded-gpr-lisp (xp gpr)
   (indexed-gpr-lisp xp (aref *encoded-gpr-to-indexed-gpr* gpr)))
 (defun (setf encoded-gpr-lisp) (new xp gpr)
   (setf (indexed-gpr-lisp xp (aref *encoded-gpr-to-indexed-gpr* gpr)) new))
 (defun indexed-gpr-integer (xp igpr)
-  (%get-signed-long-long (xp-gp-regs xp) (+ gp-regs-offset (ash igpr x8664=
::word-shift))))
+  #+x8664-target
+  (%get-signed-long-long (xp-gp-regs xp) (+ gp-regs-offset (ash igpr x8664=
::word-shift)))
+  #+x8632-target
+  (%get-signed-long (xp-gp-regs xp) (+ gp-regs-offset (ash igpr x8632::wor=
d-shift))))
 (defun (setf indexed-gpr-integer) (new xp igpr)
   (setf
+   #+x8664-target
    (%get-signed-long-long (xp-gp-regs xp) (+ gp-regs-offset (ash igpr x866=
4::word-shift)))
+   #+x8632-target
+   (%get-signed-long (xp-gp-regs xp) (+ gp-regs-offset (ash igpr x8632::wo=
rd-shift)))
    new))
 (defun encoded-gpr-integer (xp gpr)
   (indexed-gpr-integer xp (aref *encoded-gpr-to-indexed-gpr* gpr)))
 (defun (setf encoded-gpr-integer) (new xp gpr)
   (setf (indexed-gpr-integer xp (aref *encoded-gpr-to-indexed-gpr* gpr)) n=
ew))
 (defun indexed-gpr-macptr (xp igpr)
-  (%get-ptr (xp-gp-regs xp) (+ gp-regs-offset (ash igpr x8664::word-shift)=
)))
+  (%get-ptr (xp-gp-regs xp) (+ gp-regs-offset (ash igpr target::word-shift=
))))
 (defun (setf indexed-gpr-macptr) (new xp igpr)
-  (setf (%get-ptr (xp-gp-regs xp) (+ gp-regs-offset (ash igpr x8664::word-=
shift))) new))
+  (setf (%get-ptr (xp-gp-regs xp) (+ gp-regs-offset (ash igpr target::word=
-shift))) new))
 (defun indexed-gpr-macptr (xp igpr)
-  (%get-ptr (xp-gp-regs xp) (+ gp-regs-offset (ash igpr x8664::word-shift)=
)))
+  (%get-ptr (xp-gp-regs xp) (+ gp-regs-offset (ash igpr target::word-shift=
))))
 (defun encoded-gpr-macptr (xp gpr)
   (indexed-gpr-macptr xp (aref *encoded-gpr-to-indexed-gpr* gpr)))
 (defun (setf encoded-gpr-macptr) (new xp gpr)
   (setf (indexed-gpr-macptr xp (aref *encoded-gpr-to-indexed-gpr* gpr)) ne=
w))
 (defun xp-flags-register (xp)
-  (%get-signed-long-long (xp-gp-regs xp) (+ gp-regs-offset (ash flags-regi=
ster-offset x8664::fixnumshift))))
+  #+x8664-target
+  (%get-signed-long-long (xp-gp-regs xp) (+ gp-regs-offset (ash flags-regi=
ster-offset x8664::fixnumshift)))
+  #+x8632-target
+  (%get-signed-long (xp-gp-regs xp) (+ gp-regs-offset (ash flags-register-=
offset x8632::fixnumshift))))
   =

 =

 =

 (defun %get-xcf-byte (xcf-ptr delta)
-  (let* ((containing-object (%get-object xcf-ptr x8664::xcf.containing-obj=
ect))
-         (byte-offset (%get-object xcf-ptr x8664::xcf.relative-pc)))
+  (let* ((containing-object (%get-object xcf-ptr target::xcf.containing-ob=
ject))
+         (byte-offset (%get-object xcf-ptr target::xcf.relative-pc)))
     (if containing-object
       (locally (declare (optimize (speed 3) (safety 0))
                         (type (simple-array (unsigned-byte 8) (*)) contain=
ing-object))