CMUCL commit: src (6 files)
Raymond Toy
rtoy at common-lisp.net
Tue Jun 22 17:35:23 CEST 2010
Date: Tuesday, June 22, 2010 @ 11:35:23
Author: rtoy
Path: /project/cmucl/cvsroot/src
Added: bootfiles/20a/boot-2010-06-cross-x86.lisp
Modified: code/x86-vm.lisp compiler/x86/sse2-c-call.lisp compiler/x86/vm.lisp
lisp/Darwin-os.c lisp/Linux-os.c
Revert the previous change to fix debug:arg/trace issue. Instead, use
Carl's suggestion and define new SC numbers for the xmm registers
instead of overloading the x87 fpu registers and the xmm register
SC's.
bootfiles/20a/boot-2010-06-cross-x86.lisp:
o New file needed for cross-compiling this change.
code/x86-vm.lisp:
o Revert previous change.
compiler/x86/sse2-c-call.lisp:
o Use xmm0-tn instead of fr0-tn. No functional change, but makes the
code more readable.
compiler/x86/vm.lisp:
o Increase the number of float registers from 8 to 16 (8 more for SSE2
registers).
o Define new xmm<n> registers
o Update the locations with the new sse2 SC locations for single-reg,
double-reg, double-double-reg, complex-single-reg,
complex-double-reg, and complex-double-double-reg storage classes.
lisp/Darwin-os.c:
o Revert previous change.
o Update os_sigcontext_fpu_reg to support the xmm registers.
lisp/Linux-os.c:
o Update os_sigcontext_fpu_reg to support the xmm registers.
-------------------------------------------+
bootfiles/20a/boot-2010-06-cross-x86.lisp | 2 +
code/x86-vm.lisp | 13 --------
compiler/x86/sse2-c-call.lisp | 6 +--
compiler/x86/vm.lisp | 44 +++++++++++++++++++---------
lisp/Darwin-os.c | 28 +++++------------
lisp/Linux-os.c | 20 ++++++++----
6 files changed, 60 insertions(+), 53 deletions(-)
Index: src/bootfiles/20a/boot-2010-06-cross-x86.lisp
diff -u /dev/null src/bootfiles/20a/boot-2010-06-cross-x86.lisp:1.1
--- /dev/null Tue Jun 22 11:35:23 2010
+++ src/bootfiles/20a/boot-2010-06-cross-x86.lisp Tue Jun 22 11:35:23 2010
@@ -0,0 +1,2 @@
+#+x86
+(load "target:tools/cross-scripts/cross-x86-x86")
Index: src/code/x86-vm.lisp
diff -u src/code/x86-vm.lisp:1.36 src/code/x86-vm.lisp:1.37
--- src/code/x86-vm.lisp:1.36 Mon Jun 21 23:24:49 2010
+++ src/code/x86-vm.lisp Tue Jun 22 11:35:23 2010
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group at cs.cmu.edu.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/code/x86-vm.lisp,v 1.36 2010-06-22 03:24:49 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/code/x86-vm.lisp,v 1.37 2010-06-22 15:35:23 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -250,7 +250,6 @@
;;; Like SIGCONTEXT-REGISTER, but returns the value of a float register.
;;; Format is the type of float to return.
;;;
-#-(and sse2 (or darwin))
(defun sigcontext-float-register (scp index format)
(declare (type (alien (* sigcontext)) scp))
(let ((fn (extern-alien "os_sigcontext_fpu_reg"
@@ -259,16 +258,6 @@
(integer 32)))))
(coerce (sap-ref-long (alien-funcall fn scp index) 0) format)))
-#+(and sse2 (or darwin))
-(defun sigcontext-float-register (scp index format)
- (declare (type (alien (* sigcontext)) scp))
- (let ((fn (extern-alien "os_sigcontext_fpu_reg_sse2"
- (function system-area-pointer
- (* sigcontext)
- (integer 32)))))
- (if (eq format 'double-float)
- (coerce (sap-ref-double (alien-funcall fn scp index) 0) format)
- (coerce (sap-ref-single (alien-funcall fn scp index) 0) format))))
;;;
(defun %set-sigcontext-float-register (scp index format new)
(declare (type (alien (* sigcontext)) scp))
Index: src/compiler/x86/sse2-c-call.lisp
diff -u src/compiler/x86/sse2-c-call.lisp:1.3 src/compiler/x86/sse2-c-call.lisp:1.4
--- src/compiler/x86/sse2-c-call.lisp:1.3 Fri Mar 19 11:19:01 2010
+++ src/compiler/x86/sse2-c-call.lisp Tue Jun 22 11:35:23 2010
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group at cs.cmu.edu.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/x86/sse2-c-call.lisp,v 1.3 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/x86/sse2-c-call.lisp,v 1.4 2010-06-22 15:35:23 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -49,7 +49,7 @@
;; call_into_c as arranged for ST(0) to contain the result.
;; Move it to XMM0.
(inst fstd (ea-for-df-stack temp))
- (inst movsd fr0-tn (ea-for-df-stack temp))))
+ (inst movsd xmm0-tn (ea-for-df-stack temp))))
(t
;; Setup the NPX for C; all the FP registers need to be
;; empty; pop them all.
@@ -72,7 +72,7 @@
(inst fxch fr7-tn) ; move the result back to fr0
;; Move the result into xmm0.
(inst fstd (ea-for-df-stack temp))
- (inst movsd fr0-tn (ea-for-df-stack temp)))
+ (inst movsd xmm0-tn (ea-for-df-stack temp)))
(t
;; Fill up the last x87 register
(inst fldz)))))))
Index: src/compiler/x86/vm.lisp
diff -u src/compiler/x86/vm.lisp:1.15 src/compiler/x86/vm.lisp:1.16
--- src/compiler/x86/vm.lisp:1.15 Fri Mar 19 11:19:01 2010
+++ src/compiler/x86/vm.lisp Tue Jun 22 11:35:23 2010
@@ -7,7 +7,7 @@
;;; Scott Fahlman or slisp-group at cs.cmu.edu.
;;;
(ext:file-comment
- "$Header: /project/cmucl/cvsroot/src/compiler/x86/vm.lisp,v 1.15 2010-03-19 15:19:01 rtoy Exp $")
+ "$Header: /project/cmucl/cvsroot/src/compiler/x86/vm.lisp,v 1.16 2010-06-22 15:35:23 rtoy Exp $")
;;;
;;; **********************************************************************
;;;
@@ -96,7 +96,7 @@
;;; added by jrd
(eval-when (compile load eval)
- (defvar *float-register-names* (make-array 8 :initial-element nil)))
+ (defvar *float-register-names* (make-array #-sse2 8 #+sse2 16 :initial-element nil)))
(defreg fr0 0 :float)
(defreg fr1 1 :float)
(defreg fr2 2 :float)
@@ -105,7 +105,17 @@
(defreg fr5 5 :float)
(defreg fr6 6 :float)
(defreg fr7 7 :float)
-(defregset float-regs fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7)
+(defreg xmm0 8 :float)
+(defreg xmm1 9 :float)
+(defreg xmm2 10 :float)
+(defreg xmm3 11 :float)
+(defreg xmm4 12 :float)
+(defreg xmm5 13 :float)
+(defreg xmm6 14 :float)
+(defreg xmm7 15 :float)
+(defregset float-regs
+ fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7
+ xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7)
;;;; SB definitions.
@@ -124,7 +134,7 @@
;;; sense to use the 387's idea of a stack. 8 separate registers is easier
;;; to deal with.
;;; (define-storage-base float-registers :finite :size 1)
-(define-storage-base float-registers :finite :size 8)
+(define-storage-base float-registers :finite :size #-sse2 8 #+sse2 16)
(define-storage-base stack :unbounded :size 8)
(define-storage-base constant :non-packed)
@@ -258,14 +268,14 @@
;; Non-Descriptor single-floats.
(single-reg float-registers
- :locations (0 1 2 3 4 5 6 7)
+ :locations #-sse2 (0 1 2 3 4 5 6 7) #+sse2 (8 9 10 11 12 13 14 15)
:constant-scs (fp-constant)
:save-p t
:alternate-scs (single-stack))
;; Non-Descriptor double-floats.
(double-reg float-registers
- :locations (0 1 2 3 4 5 6 7)
+ :locations #-sse2 (0 1 2 3 4 5 6 7) #+sse2 (8 9 10 11 12 13 14 15)
:constant-scs (fp-constant)
:save-p t
:alternate-scs (double-stack))
@@ -280,21 +290,21 @@
#+double-double
(double-double-reg float-registers
- :locations (0 2 4 6)
+ :locations #-sse2 (0 2 4 6) #+sse2 (8 10 12 14)
:element-size 2
:constant-scs ()
:save-p t
:alternate-scs (double-double-stack))
(complex-single-reg float-registers
- :locations #-sse2 (0 2 4 6) #+sse2 (0 1 2 3 4 5 6 7)
+ :locations #-sse2 (0 2 4 6) #+sse2 (8 9 10 11 12 13 14 15)
:element-size #-sse2 2 #+sse2 1
:constant-scs ()
:save-p t
:alternate-scs (complex-single-stack))
(complex-double-reg float-registers
- :locations #-sse2 (0 2 4 6) #+sse2 (0 1 2 3 4 5 6 7)
+ :locations #-sse2 (0 2 4 6) #+sse2 (8 9 10 11 12 13 14 15)
:element-size #-sse2 2 #+sse2 1
:constant-scs ()
:save-p t
@@ -309,7 +319,7 @@
:alternate-scs (complex-long-stack))
#+double-double
(complex-double-double-reg float-registers
- :locations (0 4)
+ :locations #-sse2 (0 4) #+sse2 (8 12)
:element-size 4
:constant-scs ()
:save-p t
@@ -359,7 +369,9 @@
(def-random-reg-tns byte-reg al ah bl bh cl ch dl dh)
;; added by jrd
-(def-random-reg-tns single-reg fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7)
+(def-random-reg-tns single-reg
+ fr0 fr1 fr2 fr3 fr4 fr5 fr6 fr7
+ xmm0 xmm1 xmm2 xmm3 xmm4 xmm5 xmm6 xmm7)
;; Added by pw.
@@ -454,8 +466,14 @@
(< -1 offset (length name-vec))
(svref name-vec offset))
(format nil "<Unknown Reg: off=~D, sc=~A>" offset sc-name))))
- (float-registers (format nil #-sse2 "FR~D" #+sse2 "XMM~D"
- offset))
+ (float-registers
+ #-sse2
+ (format nil "FR~D" offset)
+ #+sse2
+ (format nil (if (< offset 8)
+ "FR~D"
+ "XMM~D")
+ offset))
(stack (format nil "S~D" offset))
(constant (format nil "Const~D" offset))
(immediate-constant "Immed")
Index: src/lisp/Darwin-os.c
diff -u src/lisp/Darwin-os.c:1.28 src/lisp/Darwin-os.c:1.29
--- src/lisp/Darwin-os.c:1.28 Mon Jun 21 23:24:49 2010
+++ src/lisp/Darwin-os.c Tue Jun 22 11:35:23 2010
@@ -14,7 +14,7 @@
* Frobbed for OpenBSD by Pierre R. Mai, 2001.
* Frobbed for Darwin by Pierre R. Mai, 2003.
*
- * $Header: /project/cmucl/cvsroot/src/lisp/Darwin-os.c,v 1.28 2010-06-22 03:24:49 rtoy Exp $
+ * $Header: /project/cmucl/cvsroot/src/lisp/Darwin-os.c,v 1.29 2010-06-22 15:35:23 rtoy Exp $
*
*/
@@ -285,35 +285,25 @@
return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_stmm6;
case 7:
return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_stmm7;
- }
- return NULL;
-}
-
-#ifdef FEATURE_SSE2
-unsigned char *
-os_sigcontext_fpu_reg_sse2(ucontext_t *scp, int index)
-{
- switch (index) {
- case 0:
+ case 8:
return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm0;
- case 1:
+ case 9:
return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm1;
- case 2:
+ case 10:
return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm2;
- case 3:
+ case 11:
return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm3;
- case 4:
+ case 12:
return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm4;
- case 5:
+ case 13:
return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm5;
- case 6:
+ case 14:
return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_xmm6;
- case 7:
+ case 15:
return (unsigned char *) &scp->uc_mcontext->__fs.__fpu_stmm7;
}
return NULL;
}
-#endif
unsigned int
os_sigcontext_fpu_modes(ucontext_t *scp)
Index: src/lisp/Linux-os.c
diff -u src/lisp/Linux-os.c:1.48 src/lisp/Linux-os.c:1.49
--- src/lisp/Linux-os.c:1.48 Mon Feb 1 11:04:43 2010
+++ src/lisp/Linux-os.c Tue Jun 22 11:35:23 2010
@@ -15,7 +15,7 @@
* GENCGC support by Douglas Crosher, 1996, 1997.
* Alpha support by Julian Dolby, 1999.
*
- * $Header: /project/cmucl/cvsroot/src/lisp/Linux-os.c,v 1.48 2010-02-01 16:04:43 rtoy Exp $
+ * $Header: /project/cmucl/cvsroot/src/lisp/Linux-os.c,v 1.49 2010-06-22 15:35:23 rtoy Exp $
*
*/
@@ -185,12 +185,20 @@
os_sigcontext_fpu_reg(ucontext_t *scp, int offset)
{
fpregset_t fpregs = scp->uc_mcontext.fpregs;
-
- if (fpregs == NULL) {
- return NULL;
- } else {
- return (unsigned char *) &fpregs->_st[offset];
+ unsigned char *reg = NULL;
+
+ if (fpregs) {
+ if (offset < 8) {
+ reg = (unsigned char *) &fpregs->_st[offset];
+ } else {
+ struct _fpstate *fpstate;
+ fpstate = (struct _fpstate*) scp->uc_mcontext.fpregs;
+ if (fpstate->magic != 0xffff) {
+ reg = (unsigned char *) &fpstate->_xmm[offset - 8];
+ }
+ }
}
+ return reg;
}
unsigned int
More information about the cmucl-commit
mailing list