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

gb at clozure.com gb at clozure.com
Sat Sep 27 02:53:59 EDT 2008


Author: gb
Date: Sat Sep 27 02:53:58 2008
New Revision: 10898

Log:
Win32 XP hacking stuff.

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 Sep 27 02:53:58 2008
@@ -223,6 +223,27 @@
       #$REG_EBP                         ;ebp
       #$REG_ESI                         ;esi
       #$REG_EDI                         ;edi
+      )))
+
+#+win32-target
+(progn
+  (defconstant gp-regs-offset 0)
+  (defmacro xp-gp-regs (xp)
+    `,xp)
+  (defun xp-mxcsr (xp)
+    (%get-unsigned-long (pref xp #>CONTEXT.ExtendedRegisters) 24))
+  (defconstant flags-register-offset 192)
+  (defconstant eip-register-offset 180)
+  (defparameter *encoded-gpr-to-indexed-gpr*
+    #(
+     176                                ;eax
+     172                                ;ecx
+     168                                ;edx
+     164                                ;ebx
+     196                                ;esp
+     180                                ;ebp
+     160                                ;esi
+     156                                ;edi
       )))
 =

 (defun indexed-gpr-lisp (xp igpr)
@@ -364,7 +385,7 @@
                (ff-call (%kernel-import target::kernel-import-restore-soft=
-stack-limit)
                         :unsigned-fullword code
                         :void))))
-          ((=3D signal #$SIGBUS)
+          ((=3D signal #+win32-target 10 #-win32-target #$SIGBUS)
            (%error (make-condition 'invalid-memory-access
                     :address addr
                     :write-p (not (zerop code)))



More information about the Openmcl-cvs-notifications mailing list