X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Fx86-64-vm.lisp;h=a5a025b816df4a5eb471cbff9eacde019cbb5266;hb=5d04a95274c9ddaebbcd6ddffc5d646e2c25598c;hp=6eacf4846fe2e486f6da5c091ed1c5d7f1ecbd0b;hpb=4898ef32c639b1c7f4ee13a5ba566ce6debd03e6;p=sbcl.git diff --git a/src/code/x86-64-vm.lisp b/src/code/x86-64-vm.lisp index 6eacf48..a5a025b 100644 --- a/src/code/x86-64-vm.lisp +++ b/src/code/x86-64-vm.lisp @@ -107,8 +107,8 @@ (sb!sys:without-gcing (let* ((sap (truly-the system-area-pointer (sb!kernel:code-instructions code))) - (obj-start-addr (logand (sb!kernel:get-lisp-obj-address code) - #xfffffffffffffff8)) + (obj-start-addr (logandc2 (sb!kernel:get-lisp-obj-address code) + sb!vm:lowtag-mask)) (code-start-addr (sb!sys:sap-int (sb!kernel:code-instructions code))) (ncode-words (sb!kernel:code-header-ref code 1)) @@ -175,8 +175,7 @@ (let* ((sap (truly-the system-area-pointer (sb!kernel:code-instructions code))) (obj-start-addr - ;; FIXME: looks like (LOGANDC2 foo typebits) - (logand (sb!kernel:get-lisp-obj-address code) #xfffffffffffffff8)) + (logandc2 (sb!kernel:get-lisp-obj-address code) sb!vm:lowtag-mask)) (code-start-addr (sb!sys:sap-int (sb!kernel:code-instructions code))) (ncode-words (sb!kernel:code-header-ref code 1)) @@ -209,18 +208,21 @@ ;;;; and internal error handling) the extra runtime cost should be ;;;; negligible. +(declaim (inline context-pc-addr)) (define-alien-routine ("os_context_pc_addr" context-pc-addr) (* unsigned-long) ;; (Note: Just as in CONTEXT-REGISTER-ADDR, we intentionally use an ;; 'unsigned *' interpretation for the 32-bit word passed to us by ;; the C code, even though the C code may think it's an 'int *'.) (context (* os-context-t))) +(declaim (inline context-pc)) (defun context-pc (context) (declare (type (alien (* os-context-t)) context)) (let ((addr (context-pc-addr context))) (declare (type (alien (* unsigned-long)) addr)) (int-sap (deref addr)))) +(declaim (inline context-register-addr)) (define-alien-routine ("os_context_register_addr" context-register-addr) (* unsigned-long) ;; (Note the mismatch here between the 'int *' value that the C code @@ -232,6 +234,7 @@ (context (* os-context-t)) (index int)) +(declaim (inline context-register)) (defun context-register (context index) (declare (type (alien (* os-context-t)) context)) (let ((addr (context-register-addr context index)))