diff --git a/code/bit-bash.lisp b/code/bit-bash.lisp index 0d36bc35686b926968932f6f901130cc00eea72c..6bc6360c901366428b79970f182ec4b84e22caa8 100644 --- a/code/bit-bash.lisp +++ b/code/bit-bash.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bit-bash.lisp,v 1.21 2001/03/04 20:12:29 pw Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/bit-bash.lisp,v 1.22 2004/06/01 23:07:30 cwang Exp $") ;;; ;;; ********************************************************************** ;;; @@ -80,7 +80,7 @@ (defun shift-towards-start (number count) "Shift NUMBER by COUNT bits, adding zero bits at the ``end'' and removing bits from the ``start.'' On big-endian machines this is a left-shift and - on little-endian machines this is a right-shift. Note: only the low 5 bits + on little-endian machines this is a right-shift. Note: only the low 5/6 bits of count are significant." (declare (type unit number) (fixnum count)) (let ((count (ldb (byte (1- (integer-length unit-bits)) 0) count))) @@ -124,26 +124,29 @@ (type index offset) (values system-area-pointer index)) (let ((address (sap-int sap))) - (values (int-sap #-alpha (32bit-logical-andc2 address 3) - #+alpha (ash (ash address -2) 2)) - (+ (* (logand address 3) byte-bits) offset)))) + (values (int-sap #-(or alpha amd64) (32bit-logical-andc2 address 3) + #+alpha (ash (ash address -2) 2) + #+amd64 (ash (ash address -3) 3)) + (+ (* (logand address #+amd64 7 #-amd64 3) byte-bits) offset)))) (declaim (inline word-sap-ref %set-word-sap-ref)) ;;; (defun word-sap-ref (sap offset) (declare (type system-area-pointer sap) (type index offset) - (values (unsigned-byte 32)) + (values (unsigned-byte #+amd64 64 #-amd64 32)) (optimize (speed 3) (safety 0) (inhibit-warnings 3))) - (sap-ref-32 sap (the index (ash offset 2)))) + #+amd64 (sap-ref-64 sap (the index (ash offset 3))) + #-amd64 (sap-ref-32 sap (the index (ash offset 2)))) ;;; (defun %set-word-sap-ref (sap offset value) (declare (type system-area-pointer sap) (type index offset) - (type (unsigned-byte 32) value) - (values (unsigned-byte 32)) + (type (unsigned-byte #+amd64 64 #-amd64 32) value) + (values (unsigned-byte #+amd64 64 #-amd64 32)) (optimize (speed 3) (safety 0) (inhibit-warnings 3))) - (setf (sap-ref-32 sap (the index (ash offset 2))) value)) + (setf #+amd64 (sap-ref-64 sap (the index (ash offset 3))) + #-amd64 (sap-ref-32 sap (the index (ash offset 2))) value)) ;;; (defsetf word-sap-ref %set-word-sap-ref) diff --git a/code/debug-int.lisp b/code/debug-int.lisp index 86f287a51f392dd2b3d0458bfe0c2b23dcc14c1a..6dae2e5eead0efd6c2a31bd5f3926264965def7d 100644 --- a/code/debug-int.lisp +++ b/code/debug-int.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.108 2004/04/01 17:06:27 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/debug-int.lisp,v 1.109 2004/06/01 23:09:27 cwang Exp $") ;;; ;;; ********************************************************************** ;;; @@ -876,9 +876,9 @@ (logior (system:sap-int component-ptr) vm:other-pointer-type))) -;;;; X86 support. +;;;; X86 and amd64 support. -#+x86 +#+(or x86 amd64) (progn ;;; Note this function should be called with garbage collect inhibited. @@ -1049,12 +1049,12 @@ (bogus-debug-function (let ((fp (frame-pointer real))) (when (cstack-pointer-valid-p fp) - #+x86 + #+(or x86 amd64) (multiple-value-bind (ra ofp) (x86-call-context fp) (when (and ra ofp) (compute-calling-frame ofp ra frame))) - #-x86 + #-(or x86 amd64) (compute-calling-frame #-alpha (system:sap-ref-sap fp (* vm::ocfp-save-offset @@ -1317,7 +1317,7 @@ (if up-frame (1+ (frame-number up-frame)) 0) escaped))))) -#-(or gengc x86) +#-(or gengc x86 amd64) (defun find-escaped-frame (frame-pointer) (declare (type system:system-area-pointer frame-pointer)) (dotimes (index lisp::*free-interrupt-context-index* (values nil 0 nil)) @@ -1361,7 +1361,7 @@ (kernel:get-header-data real-lra) nil)) (values code pc-offset scp))))))))))) -#+x86 +#+(or x86 amd64) (defun find-escaped-frame (frame-pointer) (declare (type system:system-area-pointer frame-pointer)) (dotimes (index lisp::*free-interrupt-context-index* (values nil 0 nil)) @@ -2995,7 +2995,7 @@ ;;; SUB-ACCESS-DEBUG-VAR-SLOT -- Internal. ;;; -#-x86 +#-(or x86 amd64) (defun sub-access-debug-var-slot (fp sc-offset &optional escaped) (macrolet ((with-escaped-value ((var) &body forms) `(if escaped @@ -3138,7 +3138,7 @@ (system:sap-ref-sap nfp (* (c:sc-offset-offset sc-offset) vm:word-bytes))))))) -#+x86 +#+(or x86 amd64) (defun sub-access-debug-var-slot (fp sc-offset &optional escaped) (declare (type system:system-area-pointer fp)) (macrolet ((with-escaped-value ((var) &body forms) @@ -3315,7 +3315,7 @@ ;;; SUB-SET-DEBUG-VAR-SLOT -- Internal. ;;; -#-x86 +#-(or x86 amd64) (defun sub-set-debug-var-slot (fp sc-offset value &optional escaped) (macrolet ((set-escaped-value (val) `(if escaped @@ -3471,7 +3471,7 @@ vm:word-bytes)) (the system:system-area-pointer value))))))) -#+x86 +#+(or x86 amd64) (defun sub-set-debug-var-slot (fp sc-offset value &optional escaped) (macrolet ((set-escaped-value (val) `(if escaped diff --git a/code/exports.lisp b/code/exports.lisp index 3f173057edfd0b0fa2baa162a3ab699f4804361f..b59c9930ca3d2cdbaa879900773f708589001c87 100644 --- a/code/exports.lisp +++ b/code/exports.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.231 2004/05/18 13:20:54 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/exports.lisp,v 1.232 2004/06/01 23:10:55 cwang Exp $") ;;; ;;; ********************************************************************** ;;; @@ -60,6 +60,10 @@ (if (find-package "X86") (rename-package "X86" "X86" '("VM")) (make-package "X86" :nicknames '("VM") :use nil)) +#+amd64 +(if (find-package "AMD64") + (rename-package "AMD64" "AMD64" '("VM")) + (make-package "AMD64" :nicknames '("VM") :use nil)) #+hppa (if (find-package "HPPA") (rename-package "HPPA" "HPPA" '("VM")) @@ -864,6 +868,7 @@ #+sparc "SPARC" #+ibmrt "RT" #+x86 "X86" + #+amd64 "AMD64" #+hppa "HPPA" #+alpha "ALPHA" #+sgi "SGI" diff --git a/code/lispinit.lisp b/code/lispinit.lisp index 3f2d2fb08189c4d170c214e639eff74b65875ea8..5c4c122caecbafd0bd98d98a496344845bf721d8 100644 --- a/code/lispinit.lisp +++ b/code/lispinit.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.73 2003/10/24 02:56:59 toy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/lispinit.lisp,v 1.74 2004/06/01 23:12:33 cwang Exp $") ;;; ;;; ********************************************************************** ;;; @@ -359,12 +359,13 @@ (funcall (second fun)))) (:load-time-value-fixup #-gengc - (setf (sap-ref-32 (second fun) 0) + (setf (#+amd64 sap-ref-64 + #-amd64 sap-ref-32 (second fun) 0) (get-lisp-obj-address (svref *load-time-values* (third fun)))) #+gengc (do-load-time-value-fixup (second fun) (third fun) (fourth fun))) - #+(and x86 gencgc) + #+(and (or x86 amd64) gencgc) (:load-time-code-fixup (vm::do-load-time-code-fixup (second fun) (third fun) (fourth fun) (fifth fun))) @@ -398,7 +399,7 @@ (set-floating-point-modes :traps '(:overflow :invalid :divide-by-zero)) ;; This is necessary because some of the initial top level forms might - ;; have changed the compliation policy in strange ways. + ;; have changed the compilation policy in strange ways. (print-and-call c::proclaim-init) (print-and-call kernel::class-finalize) @@ -517,7 +518,7 @@ ;;; Scrub-control-stack. ;;; -#-x86 +#-(or x86 amd64) (defun %scrub-control-stack () "Zero the unused portion of the control stack so that old objects are not kept alive because of uninitialized stack variables." @@ -554,7 +555,7 @@ ;;; Scrub-control-stack. ;;; -;;; On the x86 port the stack grows downwards, and to support grow on +;;; On the x86 and amd64 port the stack grows downwards, and to support grow on ;;; demand stacks the stack must be decreased as it is scrubbed. ;;; (defun scrub-control-stack () @@ -567,7 +568,7 @@ (%scrub-control-stack) #+stack-checking (os-guard-control-stack 0 1)) -#+x86 +#+(or x86 amd64) (defun %scrub-control-stack () (%scrub-control-stack)) diff --git a/code/load.lisp b/code/load.lisp index 9c9f183ca554fd5278edcca0639551aa66de358d..e257a006a6da9395c7a94f1cf3c20592beff9b4b 100644 --- a/code/load.lisp +++ b/code/load.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.86 2003/06/02 16:00:03 emarsden Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/load.lisp,v 1.87 2004/06/01 23:14:26 cwang Exp $") ;;; ;;; ********************************************************************** ;;; @@ -1149,7 +1149,7 @@ ;;; Load-Code loads a code object. NItems objects are popped off the stack for ;;; the boxed storage section, then Size bytes of code are read in. ;;; -#-x86 +#-(or x86 amd64) (defun load-code (box-num code-length) (declare (fixnum box-num code-length)) (with-fop-stack t @@ -1196,7 +1196,7 @@ (defvar *load-code-verbose* nil) (defvar *enable-dynamic-space-code* #-gencgc nil #+gencgc t) -#+x86 +#+(or x86 amd64) (defun load-code (box-num code-length) (declare (fixnum box-num code-length)) (with-fop-stack t diff --git a/code/unix-glibc2.lisp b/code/unix-glibc2.lisp index 9ca7463586a4e4800d4e256ccd56cae9c6a1ecc9..9509e5e8e0699c32329b5ab12c69bb3913e78ee7 100644 --- a/code/unix-glibc2.lisp +++ b/code/unix-glibc2.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix-glibc2.lisp,v 1.30 2003/08/31 10:50:15 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/unix-glibc2.lisp,v 1.31 2004/06/01 23:16:00 cwang Exp $") ;;; ;;; ********************************************************************** ;;; @@ -398,13 +398,13 @@ (def-alien-type u-int64-t (unsigned 64)) (def-alien-type register-t #-alpha int #+alpha long) -(def-alien-type dev-t uquad-t) +(def-alien-type dev-t #-amd64 uquad-t #+amd64 u-int64-t) (def-alien-type uid-t unsigned-int) (def-alien-type gid-t unsigned-int) -(def-alien-type ino-t u-int32-t) +(def-alien-type ino-t #-amd64 u-int32-t #+amd64 u-int64-t) (def-alien-type ino64-t u-int64-t) (def-alien-type mode-t u-int32-t) -(def-alien-type nlink-t unsigned-int) +(def-alien-type nlink-t #-amd64 unsigned-int #+amd64 u-int64-t) (def-alien-type off-t int64-t) (def-alien-type blkcnt-t u-int64-t) (def-alien-type fsblkcnt-t u-int64-t) @@ -1492,11 +1492,12 @@ length LEN and type TYPE." (def-alien-type nil (struct stat (st-dev dev-t) - #-alpha (st-pad1 unsigned-short) + #-(or alpha amd64) (st-pad1 unsigned-short) (st-ino ino-t) #+alpha (st-pad1 unsigned-int) - (st-mode mode-t) + #-amd64 (st-mode mode-t) (st-nlink nlink-t) + #+amd64 (st-mode mode-t) (st-uid uid-t) (st-gid gid-t) (st-rdev dev-t) @@ -2734,9 +2735,9 @@ in at a time in poll.") (defmacro extract-stat-results (buf) `(values T - #+alpha + #+(or alpha amd64) (slot ,buf 'st-dev) - #-alpha + #-(or alpha amd64) (+ (deref (slot ,buf 'st-dev) 0) (* (+ +max-u-long+ 1) (deref (slot ,buf 'st-dev) 1))) ;;; let's hope this works.. @@ -2745,9 +2746,9 @@ in at a time in poll.") (slot ,buf 'st-nlink) (slot ,buf 'st-uid) (slot ,buf 'st-gid) - #+alpha + #+(or alpha amd64) (slot ,buf 'st-rdev) - #-alpha + #-(or alpha amd64) (+ (deref (slot ,buf 'st-rdev) 0) (* (+ +max-u-long+ 1) (deref (slot ,buf 'st-rdev) 1))) ;;; let's hope this works..