From 83312cce6ee1c74fe99805831afb5cfbcb4248bd Mon Sep 17 00:00:00 2001 From: Daniel Barlow Date: Sun, 3 Oct 2004 00:57:13 +0000 Subject: [PATCH] 0.8.15.7 Threading fixes : - bind *restart-clusters* *handler-clusters* *condition-restarts* at thread entry: inter-thread restarts don't work (nor is it clear what they'd do if they did) - threads exit when their initial function returns, no need to call unix-exit (which may do interesting things with file buffers that we'd rather didn't happen) arrange_return_to_lisp_function wasn't restoring esp properly. Not sure it ever makes a difference in practice, but fix it anyway. --- doc/internals-notes/threading-specials | 12 ++++++------ src/code/target-thread.lisp | 18 +++++++++-------- src/runtime/interrupt.c | 33 ++++++++++++++++++++++++++------ src/runtime/x86-assem.S | 2 +- version.lisp-expr | 2 +- 5 files changed, 45 insertions(+), 22 deletions(-) diff --git a/doc/internals-notes/threading-specials b/doc/internals-notes/threading-specials index ff04e16..67cacf1 100644 --- a/doc/internals-notes/threading-specials +++ b/doc/internals-notes/threading-specials @@ -821,13 +821,13 @@ SB-FASL::FOP-LIST*-3 SB-VM:*STATIC-SPACE-FREE-POINTER* SB-VM:*INITIAL-DYNAMIC-SPACE-FREE-POINTER* -SB-VM:*CURRENT-CATCH-BLOCK* +SB-VM:*CURRENT-CATCH-BLOCK* ; bound at thread entry (in C) SB-VM:*STATIC-SYMBOLS* SB-VM:*CONTROL-STACK-START* ; safe, bound at thread entry SB-VM:*READ-ONLY-SPACE-FREE-POINTER* SB-VM:*BINDING-STACK-START* ; safe, bound at thread entry SB-VM:*CONTROL-STACK-END* ; safe, bound at thread entry -SB-VM::*CURRENT-UNWIND-PROTECT-BLOCK* +SB-VM::*CURRENT-UNWIND-PROTECT-BLOCK* ; bound at thread entry (in C) SB-VM::*FREE-TLS-INDEX* SB-VM::*BINDING-STACK-POINTER* SB-VM::*ALLOCATION-POINTER* ; may be mostly unused ? @@ -842,7 +842,7 @@ SB-KERNEL::*GC-TRIGGER* ; I think this is dead, check SB-IMPL::*CURRENT-UNWIND-PROTECT-BLOCK* SB-IMPL::*CURRENT-CATCH-BLOCK* SB-IMPL::*READ-ONLY-SPACE-FREE-POINTER* -SB-VM::*ALIEN-STACK* +SB-VM::*ALIEN-STACK* ; bound in create_thread_struct() SB-IMPL::*OBJECTS-PENDING-FINALIZATION* ; needs locking for writers @@ -965,12 +965,12 @@ SB-KERNEL:*CURRENT-LEVEL-IN-PRINT* SB-KERNEL:*UNIVERSAL-FUN-TYPE* SB-KERNEL:*COLD-INIT-COMPLETE-P* SB-KERNEL:*UNIVERSAL-TYPE* ; readonly -SB-KERNEL:*HANDLER-CLUSTERS* +SB-KERNEL:*HANDLER-CLUSTERS* ; bound per-thread SB-KERNEL:*EMPTY-TYPE* ; readonly SB-KERNEL:*MAXIMUM-ERROR-DEPTH* -SB-KERNEL:*CONDITION-RESTARTS* +SB-KERNEL:*CONDITION-RESTARTS* ; bound per-thread SB-KERNEL:*TYPE-SYSTEM-INITIALIZED* -SB-KERNEL:*RESTART-CLUSTERS* +SB-KERNEL:*RESTART-CLUSTERS* ; bound per-thread SB-KERNEL::*MAKE-VALUES-TYPE-CACHED-CACHE-VECTOR* SB-KERNEL::*BUILT-IN-CLASS-CODES* ; readonly SB-KERNEL::*DEF!STRUCT-TYPE-MAKE-LOAD-FORM-FUN* diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp index b2fe232..62c7b03 100644 --- a/src/code/target-thread.lisp +++ b/src/code/target-thread.lisp @@ -265,20 +265,22 @@ time we reacquire LOCK and return to the caller." ;; in time we'll move some of the binding presently done in C ;; here too (let ((sb!kernel::*restart-clusters* nil) + (sb!kernel::*handler-clusters* nil) + (sb!kernel::*condition-restarts* nil) (sb!impl::*descriptor-handlers* nil) ; serve-event (sb!impl::*available-buffers* nil)) ;for fd-stream ;; can't use handling-end-of-the-world, because that flushes ;; output streams, and we don't necessarily have any (or we ;; could be sharing them) (sb!sys:enable-interrupt sb!unix:sigint :ignore) - (sb!unix:unix-exit - (catch 'sb!impl::%end-of-the-world - (with-simple-restart - (destroy-thread - (format nil "~~@" - (current-thread-id))) - (funcall real-function)) - 0)))))))) + (catch 'sb!impl::%end-of-the-world + (with-simple-restart + (destroy-thread + (format nil "~~@" + (current-thread-id))) + (funcall real-function)) + 0)) + (values)))))) (with-mutex ((session-lock *session*)) (pushnew tid (session-threads *session*))) tid)) diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index 6e6c4a7..6bd4351 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -625,10 +625,31 @@ void arrange_return_to_lisp_function(os_context_t *context, lispobj function) #ifdef LISP_FEATURE_X86 /* Suppose the existence of some function that saved all * registers, called call_into_lisp, then restored GP registers and - * returned. We shortcut this: fake the stack that call_into_lisp - * would see, then arrange to have it called directly. post_signal_tramp - * is the second half of this function + * returned. It would look something like this: + + push ebp + mov ebp esp + pushad + push $0 + push $0 + pushl {address of function to call} + call 0x8058db0 + addl $12,%esp + popa + leave + ret + + * What we do here is set up the stack that call_into_lisp would + * expect to see if it had been called by this code, and frob the + * signal context so that signal return goes directly to call_into_lisp, + * and when that function (and the lisp function it invoked) returns, + * it returns to the second half of this imaginary function which + * restores all registers and returns to C + + * For this to work, the latter part of the imaginary function + * must obviously exist in reality. That would be post_signal_tramp */ + u32 *sp=(u32 *)*os_context_register_addr(context,reg_ESP); *(sp-14) = post_signal_tramp; /* return address for call_into_lisp */ @@ -638,9 +659,9 @@ void arrange_return_to_lisp_function(os_context_t *context, lispobj function) /* this order matches that used in POPAD */ *(sp-10)=*os_context_register_addr(context,reg_EDI); *(sp-9)=*os_context_register_addr(context,reg_ESI); - /* this gets overwritten again before it's used, anyway */ - *(sp-8)=*os_context_register_addr(context,reg_EBP); - *(sp-7)=0 ; /* POPAD doesn't set ESP, but expects a gap for it anyway */ + + *(sp-8)=*os_context_register_addr(context,reg_ESP)-8; + *(sp-7)=0; *(sp-6)=*os_context_register_addr(context,reg_EBX); *(sp-5)=*os_context_register_addr(context,reg_EDX); diff --git a/src/runtime/x86-assem.S b/src/runtime/x86-assem.S index c145d53..3dfb53b 100644 --- a/src/runtime/x86-assem.S +++ b/src/runtime/x86-assem.S @@ -801,7 +801,7 @@ GNAME(post_signal_tramp): * using return_to_lisp_function */ addl $12,%esp /* clear call_into_lisp args from stack */ popa /* restore registers */ - popl %ebp + leave ret .size GNAME(post_signal_tramp),.-GNAME(post_signal_tramp) diff --git a/version.lisp-expr b/version.lisp-expr index 2b325b1..bb153b6 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.15.6" +"0.8.15.7" -- 1.7.10.4