From c3334d2307b721cfcea29e6abcd33e48487fb1ea Mon Sep 17 00:00:00 2001 From: Juho Snellman Date: Wed, 19 Jan 2005 21:11:00 +0000 Subject: [PATCH] 0.8.18.36: x86-64 fixes: * Implement arrange_return_to_lisp_function to make stack exhaustion detection work. * Fix select on fds > 32 on 64-bit platforms (patch by Cheuksan Edward Wang). * Copy apd's x86 fix for DATA-VECTOR-SET-C overflow from 0.8.18.35. * Use -fPIC for building shared libraries in tests/foreign.test.sh on x86-64. * Remove i586_bzero from x86-64-assem.S. --- src/code/unix.lisp | 39 +++++++++++++++++++------------- src/compiler/x86-64/array.lisp | 3 ++- src/runtime/interrupt.c | 31 +++++++++++++++++++++++++- src/runtime/x86-64-assem.S | 48 +++++++++++++++++++++------------------- tests/foreign.test.sh | 7 ++++-- version.lisp-expr | 2 +- 6 files changed, 87 insertions(+), 43 deletions(-) diff --git a/src/code/unix.lisp b/src/code/unix.lisp index b011c9e..39b23eb 100644 --- a/src/code/unix.lisp +++ b/src/code/unix.lisp @@ -123,7 +123,8 @@ (define-alien-type nil (struct fd-set - (fds-bits (array fd-mask #.(/ fd-setsize 32))))) + (fds-bits (array fd-mask #.(/ fd-setsize + sb!vm:n-machine-word-bits))))) (/show0 "unix.lisp 304") @@ -489,19 +490,24 @@ `(if (fixnump ,num) (progn (setf (deref (slot ,fdset 'fds-bits) 0) ,num) - ,@(loop for index upfrom 1 below (/ fd-setsize 32) + ,@(loop for index upfrom 1 below (/ fd-setsize + sb!vm:n-machine-word-bits) collect `(setf (deref (slot ,fdset 'fds-bits) ,index) 0))) (progn - ,@(loop for index upfrom 0 below (/ fd-setsize 32) + ,@(loop for index upfrom 0 below (/ fd-setsize + sb!vm:n-machine-word-bits) collect `(setf (deref (slot ,fdset 'fds-bits) ,index) - (ldb (byte 32 ,(* index 32)) ,num)))))) + (ldb (byte sb!vm:n-machine-word-bits + ,(* index sb!vm:n-machine-word-bits)) + ,num)))))) (defmacro fd-set-to-num (nfds fdset) - `(if (<= ,nfds 32) + `(if (<= ,nfds sb!vm:n-machine-word-bits) (deref (slot ,fdset 'fds-bits) 0) - (+ ,@(loop for index upfrom 0 below (/ fd-setsize 32) + (+ ,@(loop for index upfrom 0 below (/ fd-setsize + sb!vm:n-machine-word-bits) collect `(ash (deref (slot ,fdset 'fds-bits) ,index) - ,(* index 32)))))) + ,(* index sb!vm:n-machine-word-bits)))))) ;;; Examine the sets of descriptors passed as arguments to see whether ;;; they are ready for reading and writing. See the UNIX Programmer's @@ -957,34 +963,37 @@ previous timer after the body has finished executing" (defmacro fd-set (offset fd-set) (let ((word (gensym)) (bit (gensym))) - `(multiple-value-bind (,word ,bit) (floor ,offset 32) + `(multiple-value-bind (,word ,bit) (floor ,offset + sb!vm:n-machine-word-bits) (setf (deref (slot ,fd-set 'fds-bits) ,word) - (logior (truly-the (unsigned-byte 32) (ash 1 ,bit)) + (logior (truly-the (unsigned-byte #.sb!vm:n-machine-word-bits) + (ash 1 ,bit)) (deref (slot ,fd-set 'fds-bits) ,word)))))) ;;; not checked for linux... (defmacro fd-clr (offset fd-set) (let ((word (gensym)) (bit (gensym))) - `(multiple-value-bind (,word ,bit) (floor ,offset 32) + `(multiple-value-bind (,word ,bit) (floor ,offset + sb!vm:n-machine-word-bits) (setf (deref (slot ,fd-set 'fds-bits) ,word) (logand (deref (slot ,fd-set 'fds-bits) ,word) - ;; FIXME: This may not be quite right for 64-bit - ;; ports of SBCL. --njf, 2004-08-04 (sb!kernel:word-logical-not - (truly-the (unsigned-byte 32) (ash 1 ,bit)))))))) + (truly-the (unsigned-byte #.sb!vm:n-machine-word-bits) + (ash 1 ,bit)))))))) ;;; not checked for linux... (defmacro fd-isset (offset fd-set) (let ((word (gensym)) (bit (gensym))) - `(multiple-value-bind (,word ,bit) (floor ,offset 32) + `(multiple-value-bind (,word ,bit) (floor ,offset + sb!vm:n-machine-word-bits) (logbitp ,bit (deref (slot ,fd-set 'fds-bits) ,word))))) ;;; not checked for linux... (defmacro fd-zero (fd-set) `(progn - ,@(loop for index upfrom 0 below (/ fd-setsize 32) + ,@(loop for index upfrom 0 below (/ fd-setsize sb!vm:n-machine-word-bits) collect `(setf (deref (slot ,fd-set 'fds-bits) ,index) 0)))) diff --git a/src/compiler/x86-64/array.lisp b/src/compiler/x86-64/array.lisp index 725b457..6a8aebd 100644 --- a/src/compiler/x86-64/array.lisp +++ b/src/compiler/x86-64/array.lisp @@ -269,7 +269,8 @@ (mask ,(1- (ash 1 bits))) (shift (* extra ,bits))) (unless (= value mask) - (inst mov mask-tn (lognot (ash mask shift))) + (inst mov mask-tn (ldb (byte 64 0) + (lognot (ash mask shift)))) (inst and old mask-tn)) (unless (zerop value) (inst mov mask-tn (ash value shift)) diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index 8a5a20f..9071cae 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -670,6 +670,32 @@ void arrange_return_to_lisp_function(os_context_t *context, lispobj function) *(sp-2)=*os_context_register_addr(context,reg_EBP); *(sp-1)=*os_context_pc_addr(context); +#elif defined(LISP_FEATURE_X86_64) + u64 *sp=(u64 *)*os_context_register_addr(context,reg_RSP); + *(sp-19) = post_signal_tramp; /* return address for call_into_lisp */ + + *(sp-18)=*os_context_register_addr(context,reg_R15); + *(sp-17)=*os_context_register_addr(context,reg_R14); + *(sp-16)=*os_context_register_addr(context,reg_R13); + *(sp-15)=*os_context_register_addr(context,reg_R12); + *(sp-14)=*os_context_register_addr(context,reg_R11); + *(sp-13)=*os_context_register_addr(context,reg_R10); + *(sp-12)=*os_context_register_addr(context,reg_R9); + *(sp-11)=*os_context_register_addr(context,reg_R8); + *(sp-10)=*os_context_register_addr(context,reg_RDI); + *(sp-9)=*os_context_register_addr(context,reg_RSI); + *(sp-8)=*os_context_register_addr(context,reg_RSP)-16; + *(sp-7)=0; + *(sp-6)=*os_context_register_addr(context,reg_RBX); + *(sp-5)=*os_context_register_addr(context,reg_RDX); + *(sp-4)=*os_context_register_addr(context,reg_RCX); + *(sp-3)=*os_context_register_addr(context,reg_RAX); + *(sp-2)=*os_context_register_addr(context,reg_RBP); + *(sp-1)=*os_context_pc_addr(context); + + *os_context_register_addr(context,reg_RDI) = function; /* function */ + *os_context_register_addr(context,reg_RSI) = 0; /* arg. array */ + *os_context_register_addr(context,reg_RDX) = 0; /* no. args */ #else struct thread *th=arch_os_get_current_thread(); build_fake_control_stack_frames(th,context); @@ -685,7 +711,10 @@ void arrange_return_to_lisp_function(os_context_t *context, lispobj function) *os_context_register_addr(context,reg_ESP) = sp-14; #endif #elif defined(LISP_FEATURE_X86_64) - lose("deferred gubbins still needs to be written"); + *os_context_pc_addr(context) = call_into_lisp; + *os_context_register_addr(context,reg_RCX) = 0; + *os_context_register_addr(context,reg_RBP) = sp-2; + *os_context_register_addr(context,reg_RSP) = sp-19; #else /* this much of the calling convention is common to all non-x86 ports */ diff --git a/src/runtime/x86-64-assem.S b/src/runtime/x86-64-assem.S index 47916c2..4f69372 100644 --- a/src/runtime/x86-64-assem.S +++ b/src/runtime/x86-64-assem.S @@ -306,30 +306,32 @@ GNAME(do_pending_interrupt): ret .size GNAME(do_pending_interrupt),.-GNAME(do_pending_interrupt) -#ifdef LISP_FEATURE_GENCGC -/* This is a fast bzero using the FPU. The first argument is the start - * address which needs to be aligned on an 8 byte boundary, the second - * argument is the number of bytes, which must be a nonzero multiple - * of 8 bytes. */ -/* FIXME whether this is still faster than using the OS's bzero or - * equivalent, we don't know */ - .text - .globl GNAME(i586_bzero) - .type GNAME(i586_bzero),@function + .globl GNAME(post_signal_tramp) + .type GNAME(post_signal_tramp),@function .align align_4byte,0x90 -GNAME(i586_bzero): - mov 4(%rsp),%rdx # Load the start address. - mov 8(%rsp),%rax # Load the number of bytes. - fldz -l1: fstl 0(%rdx) - add $8,%rdx - sub $8,%rax - jnz l1 - fstp %st(0) +GNAME(post_signal_tramp): + /* this is notionally the second half of a function whose first half + * doesn't exist. This is where call_into_lisp returns when called + * using return_to_lisp_function */ + addq $24,%rsp /* clear call_into_lisp args from stack */ + popq %r15 + popq %r14 + popq %r13 + popq %r12 + popq %r11 + popq %r10 + popq %r9 + popq %r8 + popq %rdi + popq %rsi + popq %rbp + popq %rsp + popq %rdx + popq %rbx + popq %rcx + popq %rax + leave ret - .size GNAME(i586_bzero),.-GNAME(i586_bzero) -#endif + .size GNAME(post_signal_tramp),.-GNAME(post_signal_tramp) - - .end diff --git a/tests/foreign.test.sh b/tests/foreign.test.sh index 7d207b4..bd91bfe 100644 --- a/tests/foreign.test.sh +++ b/tests/foreign.test.sh @@ -26,8 +26,11 @@ testfilestem=${TMPDIR:-/tmp}/sbcl-foreign-test-$$ ## Make a little shared object files to test with. build_so() { - echo building $1.so - cc -c $1.c -o $1.o + echo building $1.so + if [ $(uname -p) = x86_64 ]; then + CFLAGS="$CFLAGS -fPIC" + fi + cc -c $1.c -o $1.o $CFLAGS ld -shared -o $1.so $1.o } diff --git a/version.lisp-expr b/version.lisp-expr index 4dc871a..597e388 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.8.18.35" +"0.8.18.36" -- 1.7.10.4