From: Thiemo Seufer <ths@networkno.de>
Date: Sun, 11 Sep 2005 09:53:43 +0000 (+0000)
Subject: 0.9.4.60:
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;ds=sidebyside;h=6ee1bc3f01760f7d95da156ff3863fe8fed491eb;p=sbcl.git

0.9.4.60:
	Define LONG-LONG/UNSIGNED-LONG-LONG as 64bit integer alien
	types and use them for the mips port.
---

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 76c7b45..0e993bd 100644
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -58,13 +58,13 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
              "FREE-ALIEN"
              "GET-ERRNO"
              "INT"
-             "LOAD-1-FOREIGN" "LOAD-FOREIGN" "LOAD-SHARED-OBJECT" "LONG"
+             "LOAD-1-FOREIGN" "LOAD-FOREIGN" "LOAD-SHARED-OBJECT" "LONG" "LONG-LONG"
              "MAKE-ALIEN"
              "NULL-ALIEN"
              "SAP-ALIEN" "SHORT" "SIGNED" "SLOT" "STRUCT"
              "UNDEFINED-ALIEN-ERROR"
              "UNSIGNED"
-             "UNSIGNED-CHAR" "UNSIGNED-INT" "UNSIGNED-LONG" "UNSIGNED-SHORT"
+             "UNSIGNED-CHAR" "UNSIGNED-INT" "UNSIGNED-LONG" "UNSIGNED-LONG-LONG" "UNSIGNED-SHORT"
              "UTF8-STRING"
              "VOID"
              "WITH-ALIEN"))
diff --git a/src/code/mips-vm.lisp b/src/code/mips-vm.lisp
index ec9f919..d3dfa6c 100644
--- a/src/code/mips-vm.lisp
+++ b/src/code/mips-vm.lisp
@@ -45,52 +45,64 @@
               (ldb (byte 16 0) value)))))))
 
 
-(define-alien-routine ("os_context_pc_addr" context-pc-addr) (* unsigned-int)
+(define-alien-routine ("os_context_pc_addr" context-pc-addr)
+    (* unsigned-long-long)
   (context (* os-context-t)))
 
 (defun context-pc (context)
   (declare (type (alien (* os-context-t)) context))
-  ;; KLUDGE: this sucks, and furthermore will break on either of (a)
-  ;; porting back to IRIX or (b) running on proper 64-bit support.
-  ;; Linux on the MIPS defines its registers in the sigcontext as
-  ;; 64-bit quantities ("unsigned long long"), presumably to be
-  ;; binary-compatible with 64-bit mode.  Since there appears not to
-  ;; be ALIEN support for 64-bit return values, we have to do the
-  ;; hacky pointer arithmetic thing.  -- CSR, 2002-09-01
-  (int-sap (deref (context-pc-addr context)
-                  #!-little-endian 1
-                  #!+little-endian 0)))
+  (int-sap (deref (context-pc-addr context))))
 
 (define-alien-routine ("os_context_register_addr" context-register-addr)
-  (* unsigned-int)
+    (* unsigned-long-long)
   (context (* os-context-t))
   (index int))
 
 (define-alien-routine ("os_context_bd_cause" context-bd-cause-int)
-    (unsigned 32)
+    unsigned-int
   (context (* os-context-t)))
 
 ;;; 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))
-  (deref (context-register-addr context index)
-         #!-little-endian 1
-         #!+little-endian 0))
+  (let ((addr (context-register-addr context index)))
+    (declare (type (alien (* unsigned-long-long)) addr))
+    (deref addr)))
 
 (defun %set-context-register (context index new)
   (declare (type (alien (* os-context-t)) context))
-  (setf (deref (context-register-addr context index)
-               #!-little-endian 1
-               #!+little-endian 0)
-        new))
-
-#!+linux
-;;; For now.
-(defun context-floating-point-modes (context)
-  (declare (ignore context))
-  (warn "stub CONTEXT-FLOATING-POINT-MODES")
-  0)
+  (let ((addr (context-register-addr context index)))
+    (declare (type (alien (* unsigned-long-long)) addr))
+    (setf (deref addr) new)))
+
+;;; This is like CONTEXT-REGISTER, but returns the value of a float
+;;; register. FORMAT is the type of float to return.
+
+;;; 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)
+  (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))
+    (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))
+    (setf (deref addr) (coerce new format))))
+
+;;; Given a signal context, return the floating point modes word in
+;;; the same format as returned by FLOATING-POINT-MODES.
+(define-alien-routine ("os_context_fp_control" context-floating-point-modes)
+    unsigned-int
+  (context (* os-context-t)))
 
 ;;;; Internal-error-arguments.
 
diff --git a/src/code/target-c-call.lisp b/src/code/target-c-call.lisp
index 2d21d6d..cc3eef7 100644
--- a/src/code/target-c-call.lisp
+++ b/src/code/target-c-call.lisp
@@ -23,11 +23,13 @@
 (define-alien-type short (integer 16))
 (define-alien-type int (integer 32))
 (define-alien-type long (integer #.sb!vm::n-machine-word-bits))
+(define-alien-type long-long (integer 64))
 
 (define-alien-type unsigned-char (unsigned 8))
 (define-alien-type unsigned-short (unsigned 16))
 (define-alien-type unsigned-int (unsigned 32))
 (define-alien-type unsigned-long (unsigned #.sb!vm::n-machine-word-bits))
+(define-alien-type unsigned-long-long (unsigned 64))
 
 (define-alien-type float single-float)
 (define-alien-type double double-float)
diff --git a/version.lisp-expr b/version.lisp-expr
index d7346b4..3fe911e 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.4.59"
+"0.9.4.60"