From: Juho S. <js...@us...> - 2004-12-14 02:31:47
|
Update of /cvsroot/sbcl/sbcl/src/compiler/generic In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3641/src/compiler/generic Modified Files: Tag: x86-64-again-branch objdef.lisp primtype.lisp Log Message: 0.8.15.14.x86-64-again-branch.34: * Fix some probable 32-bit Alpha problems that were introduced earlier during the port in primtype, sb-sprof and run-program. * Use a more space-efficient boxed presentation for double-floats and complex double-floats. * Add VOP for non-constant modular left shifts (added to other archs after the AMD64 port was originally started). * Add a REX-prefix for XCHG. * Implement inline allocation. * More int -> long in gencgc. * Only scan pages up to last_free_page instead of NUM_PAGES in update_x86_dynamic_space_free_pointer() (otherwise GC is ridiculously slow with large dynamic spaces). Index: objdef.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/objdef.lisp,v retrieving revision 1.29.6.3 retrieving revision 1.29.6.4 diff -u -d -r1.29.6.3 -r1.29.6.4 --- objdef.lisp 20 Oct 2004 20:21:04 -0000 1.29.6.3 +++ objdef.lisp 14 Dec 2004 02:31:36 -0000 1.29.6.4 @@ -72,8 +72,8 @@ (define-primitive-object (double-float :lowtag other-pointer-lowtag :widetag double-float-widetag) - (filler) - (value :c-type "double" :length 2)) + #!-x86-64 (filler) + (value :c-type "double" :length #!-x86-64 2 #!+x86-64 1)) #!+long-float (define-primitive-object (long-float :lowtag other-pointer-lowtag @@ -350,9 +350,9 @@ (define-primitive-object (complex-double-float :lowtag other-pointer-lowtag :widetag complex-double-float-widetag) - (filler) - (real :c-type "double" :length 2) - (imag :c-type "double" :length 2)) + #!-x86-64 (filler) + (real :c-type "double" :length #!-x86-64 2 #!+x86-64 1) + (imag :c-type "double" :length #!-x86-64 2 #!+x86-64 1)) ;;; this isn't actually a lisp object at all, it's a c structure that lives ;;; in c-land. However, we need sight of so many parts of it from Lisp that Index: primtype.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/generic/primtype.lisp,v retrieving revision 1.14.4.2 retrieving revision 1.14.4.3 diff -u -d -r1.14.4.2 -r1.14.4.3 --- primtype.lisp 26 Nov 2004 20:27:01 -0000 1.14.4.2 +++ primtype.lisp 14 Dec 2004 02:31:36 -0000 1.14.4.3 @@ -25,26 +25,27 @@ (!def-primitive-type positive-fixnum (any-reg signed-reg unsigned-reg) :type (unsigned-byte #.sb!vm:n-positive-fixnum-bits)) (/show0 "primtype.lisp 27") -#!-x86-64 +#!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 32) '(and) '(or)) (!def-primitive-type unsigned-byte-31 (signed-reg unsigned-reg descriptor-reg) :type (unsigned-byte 31)) (/show0 "primtype.lisp 31") -#!-x86-64 +#!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 32) '(and) '(or)) (!def-primitive-type unsigned-byte-32 (unsigned-reg descriptor-reg) :type (unsigned-byte 32)) (/show0 "primtype.lisp 35") -#!+x86-64 +#!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or)) (!def-primitive-type unsigned-byte-63 (signed-reg unsigned-reg descriptor-reg) :type (unsigned-byte 63)) -#!+x86-64 +#!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or)) (!def-primitive-type unsigned-byte-64 (unsigned-reg descriptor-reg) :type (unsigned-byte 64)) (!def-primitive-type fixnum (any-reg signed-reg) :type (signed-byte #.(1+ sb!vm:n-positive-fixnum-bits))) -; #!-x86-64 +;; x86-64 needs a signed-byte-32 for proper handling of c-call return values. +#!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or x86-64)) (!def-primitive-type signed-byte-32 (signed-reg descriptor-reg) :type (signed-byte 32)) -#!+x86-64 +#!+#.(cl:if (cl:= sb!vm::n-machine-word-bits 64) '(and) '(or)) (!def-primitive-type signed-byte-64 (signed-reg descriptor-reg) :type (signed-byte 64)) @@ -157,32 +158,48 @@ (case t1-name (positive-fixnum (if (or (eq t2-name 'fixnum) - (eq t2-name #!-x86-64 'signed-byte-32 - #!+x86-64 'signed-byte-64) - (eq t2-name #!-x86-64 'unsigned-byte-31 - #!+x86-64 'unsigned-byte-63) - (eq t2-name #!-x86-64 'unsigned-byte-32 - #!+x86-64 'unsigned-byte-64)) + (eq t2-name + (ecase sb!vm::n-machine-word-bits + (32 'signed-byte-32) + (64 'signed-byte-64))) + (eq t2-name + (ecase sb!vm::n-machine-word-bits + (32 'unsigned-byte-31) + (64 'unsigned-byte-63))) + (eq t2-name + (ecase sb!vm::n-machine-word-bits + (32 'unsigned-byte-32) + (64 'unsigned-byte-64)))) t2)) (fixnum (case t2-name - (#!-x86-64 signed-byte-32 - #!+x86-64 signed-byte-64 t2) - (#!-x86-64 unsigned-byte-31 - #!+x86-64 unsigned-byte-63 - (primitive-type-or-lose - #!-x86-64 'signed-byte-32 - #!+x86-64 'signed-byte-64)))) - (#!-x86-64 signed-byte-32 - #!+x86-64 signed-byte-64 - (if (eq t2-name #!-x86-64 'unsigned-byte-31 - #!+x86-64 'unsigned-byte-63) + (#.(ecase sb!vm::n-machine-word-bits + (32 'signed-byte-32) + (64 'signed-byte-64)) + t2) + (#.(ecase sb!vm::n-machine-word-bits + (32 'unsigned-byte-31) + (64 'unsigned-byte-63)) + (primitive-type-or-lose + (ecase sb!vm::n-machine-word-bits + (32 'signed-byte-32) + (64 'signed-byte-64)))))) + (#.(ecase sb!vm::n-machine-word-bits + (32 'signed-byte-32) + (64 'signed-byte-64)) + (if (eq t2-name + (ecase sb!vm::n-machine-word-bits + (32 'unsigned-byte-31) + (64 'unsigned-byte-63))) t1)) - (#!-x86-64 unsigned-byte-31 - #!+x86-64 unsigned-byte-63 - (if (eq t2-name #!-x86-64 'unsigned-byte-32 - #!+x86-64 'unsigned-byte-64) - t2)))))) + (#.(ecase sb!vm::n-machine-word-bits + (32 'unsigned-byte-31) + (64 'unsigned-byte-63)) + (if (eq t2-name + (ecase sb!vm::n-machine-word-bits + (32 'unsigned-byte-32) + (64 'unsigned-byte-64))) + t2)))))) (etypecase type (numeric-type (let ((lo (numeric-type-low type)) @@ -194,22 +211,26 @@ (cond ((and hi lo) (dolist (spec `((positive-fixnum 0 ,sb!xc:most-positive-fixnum) - #!-x86-64 - (unsigned-byte-31 0 ,(1- (ash 1 31))) - #!-x86-64 - (unsigned-byte-32 0 ,(1- (ash 1 32))) - #!+x86-64 - (unsigned-byte-63 0 ,(1- (ash 1 63))) - #!+x86-64 - (unsigned-byte-64 0 ,(1- (ash 1 64))) + ,@(ecase sb!vm::n-machine-word-bits + (32 + `((unsigned-byte-31 + 0 ,(1- (ash 1 31))) + (unsigned-byte-32 + 0 ,(1- (ash 1 32))))) + (64 + `((unsigned-byte-63 + 0 ,(1- (ash 1 63))) + (unsigned-byte-64 + 0 ,(1- (ash 1 64)))))) (fixnum ,sb!xc:most-negative-fixnum ,sb!xc:most-positive-fixnum) - #!-x86-64 - (signed-byte-32 ,(ash -1 31) - ,(1- (ash 1 31))) - #!+x86-64 - (signed-byte-64 ,(ash -1 63) - ,(1- (ash 1 63)))) + ,(ecase sb!vm::n-machine-word-bits + (32 + `(signed-byte-32 ,(ash -1 31) + ,(1- (ash 1 31)))) + (64 + `(signed-byte-64 ,(ash -1 63) + ,(1- (ash 1 63)))))) (if (or (< hi sb!xc:most-negative-fixnum) (> lo sb!xc:most-positive-fixnum)) (part-of bignum) |