From 2ffb42cdf6d95801c24460084e8b486c71b767c2 Mon Sep 17 00:00:00 2001
From: Thiemo Seufer <ths@networkno.de>
Date: Fri, 26 May 2006 17:54:10 +0000
Subject: [PATCH 1/1] 0.9.12.31: 	- Clean up endianness dependency. 
 - Use an explicit alien type for context register.

---
 src/code/mips-vm.lisp |   34 +++++++++++++++-------------------
 version.lisp-expr     |    2 +-
 2 files changed, 16 insertions(+), 20 deletions(-)

diff --git a/src/code/mips-vm.lisp b/src/code/mips-vm.lisp
index a6dbef6..987dc6b 100644
--- a/src/code/mips-vm.lisp
+++ b/src/code/mips-vm.lisp
@@ -4,6 +4,7 @@
 
 
 (define-alien-type os-context-t (struct os-context-t-struct))
+(define-alien-type os-context-register-t unsigned-long-long)
 
 
 ;;;; MACHINE-TYPE and MACHINE-VERSION
@@ -33,47 +34,42 @@
         (setf (ldb (byte 26 0) (sap-ref-32 sap offset))
               (ash value -2)))
        (:lui
-        (setf (sap-ref-16 sap
-                          #!+little-endian offset
-                          #!-little-endian (+ offset 2))
-              (+ (ash value -16)
-                 (if (logbitp 15 value) 1 0))))
+        (setf (ldb (byte 16 0) (sap-ref-32 sap offset))
+              (ash (1+ (ash value -15)) -1)))
        (:addi
-        (setf (sap-ref-16 sap
-                          #!+little-endian offset
-                          #!-little-endian (+ offset 2))
+        (setf (ldb (byte 16 0) (sap-ref-32 sap offset))
               (ldb (byte 16 0) value)))))))
 
 
 (define-alien-routine ("os_context_pc_addr" context-pc-addr)
-    (* unsigned-long-long)
-  (context (* os-context-t)))
+    (* os-context-register-t)
+  (context (* os-context-t) :in))
 
 (defun context-pc (context)
   (declare (type (alien (* os-context-t)) context))
   (int-sap (deref (context-pc-addr context))))
 
 (define-alien-routine ("os_context_register_addr" context-register-addr)
-    (* unsigned-long-long)
-  (context (* os-context-t))
-  (index int))
+    (* os-context-register-t)
+  (context (* os-context-t) :in)
+  (index int :in))
 
 (define-alien-routine ("os_context_bd_cause" context-bd-cause-int)
     unsigned-int
-  (context (* os-context-t)))
+  (context (* os-context-t) :in))
 
 ;;; FIXME: Should this and CONTEXT-PC be INLINE to reduce consing?
 ;;; (Are they used in anything time-critical, or just the debugger?)
 (defun context-register (context index)
   (declare (type (alien (* os-context-t)) context))
   (let ((addr (context-register-addr context index)))
-    (declare (type (alien (* unsigned-long-long)) addr))
+    (declare (type (alien (* os-context-register-t)) addr))
     (deref addr)))
 
 (defun %set-context-register (context index new)
   (declare (type (alien (* os-context-t)) context))
   (let ((addr (context-register-addr context index)))
-    (declare (type (alien (* unsigned-long-long)) addr))
+    (declare (type (alien (* os-context-register-t)) addr))
     (setf (deref addr) new)))
 
 ;;; This is like CONTEXT-REGISTER, but returns the value of a float
@@ -82,20 +78,20 @@
 ;;; FIXME: Whether COERCE actually knows how to make a float out of a
 ;;; long is another question. This stuff still needs testing.
 (define-alien-routine ("os_context_fpregister_addr" context-float-register-addr)
-    (* unsigned-long-long)
+    (* os-context-register-t)
   (context (* os-context-t))
   (index int))
 
 (defun context-float-register (context index format)
   (declare (type (alien (* os-context-t)) context))
   (let ((addr (context-float-register-addr context index)))
-    (declare (type (alien (* unsigned-long-long)) addr))
+    (declare (type (alien (* os-context-register-t)) addr))
     (coerce (deref addr) format)))
 
 (defun %set-context-float-register (context index format new)
   (declare (type (alien (* os-context-t)) context))
   (let ((addr (context-float-register-addr context index)))
-    (declare (type (alien (* unsigned-long-long)) addr))
+    (declare (type (alien (* os-context-register-t)) addr))
     (setf (deref addr) (coerce new format))))
 
 ;;; Given a signal context, return the floating point modes word in
diff --git a/version.lisp-expr b/version.lisp-expr
index 796b46a..ac6159a 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"0.9.12.30"
+"0.9.12.31"
-- 
1.7.10.4