From 1c6e1e0ccbad4cefe1984f4a1a45d81181718f65 Mon Sep 17 00:00:00 2001 From: Gabor Melis Date: Fri, 1 Jul 2005 11:00:26 +0000 Subject: [PATCH] 0.9.2.10: * threads for x86-64 --- NEWS | 1 + src/code/early-impl.lisp | 4 +-- src/code/toplevel.lisp | 4 +-- src/compiler/x86-64/c-call.lisp | 16 +++++----- src/compiler/x86-64/cell.lisp | 67 ++++++++++++++++++++------------------- src/compiler/x86-64/macros.lisp | 61 ++++++++++++++++++++++++++--------- src/compiler/x86-64/system.lisp | 6 ++-- src/compiler/x86-64/vm.lisp | 9 +++++- src/runtime/Config.x86_64-linux | 4 +++ src/runtime/interrupt.c | 29 ++++++++--------- src/runtime/thread.c | 2 +- src/runtime/x86-64-arch.h | 12 +++++-- src/runtime/x86-64-assem.S | 31 ++++++++++-------- src/runtime/x86-64-linux-os.c | 6 ++-- version.lisp-expr | 2 +- 15 files changed, 156 insertions(+), 98 deletions(-) diff --git a/NEWS b/NEWS index 3f21c9c..7257ff4 100644 --- a/NEWS +++ b/NEWS @@ -6,6 +6,7 @@ changes in sbcl-0.9.3 relative to sbcl-0.9.2: * Bug fix: OPEN no longer fails when *PRINT-READABLY* is T. (thanks to Zach Beane) * threads + ** added x86-64 support ** incompatible change: the threading api now works with thread objects instead of thread ids ** bug fix: threads are protected from signals and interruption when diff --git a/src/code/early-impl.lisp b/src/code/early-impl.lisp index 3058fcf..21e75b0 100644 --- a/src/code/early-impl.lisp +++ b/src/code/early-impl.lisp @@ -32,8 +32,8 @@ ;; :X86. (Note that non-X86 ports mention ;; pseudo-atomicity too, but they handle it without ;; messing with special variables.) - #!+x86 *pseudo-atomic-atomic* - #!+x86 *pseudo-atomic-interrupted* + #!+(or x86 x86-64) *pseudo-atomic-atomic* + #!+(or x86 x86-64) *pseudo-atomic-interrupted* sb!unix::*interrupts-enabled* sb!unix::*interrupt-pending* *free-interrupt-context-index* diff --git a/src/code/toplevel.lisp b/src/code/toplevel.lisp index d9348ab..7643a91 100644 --- a/src/code/toplevel.lisp +++ b/src/code/toplevel.lisp @@ -27,8 +27,8 @@ ;;; FIXME: These could be converted to DEFVARs. (declaim (special *gc-inhibit* *need-to-collect-garbage* *after-gc-hooks* - #!+x86 *pseudo-atomic-atomic* - #!+x86 *pseudo-atomic-interrupted* + #!+(or x86 x86-64) *pseudo-atomic-atomic* + #!+(or x86 x86-64) *pseudo-atomic-interrupted* sb!unix::*interrupts-enabled* sb!unix::*interrupt-pending* *type-system-initialized*)) diff --git a/src/compiler/x86-64/c-call.lisp b/src/compiler/x86-64/c-call.lisp index fe5502b..1d9fcaf 100644 --- a/src/compiler/x86-64/c-call.lisp +++ b/src/compiler/x86-64/c-call.lisp @@ -287,13 +287,13 @@ (unless (zerop amount) (let ((delta (logandc2 (+ amount 7) 7))) (inst mov temp - (make-ea :dword + (make-ea :qword :disp (+ nil-value (static-symbol-offset '*alien-stack*) (ash symbol-tls-index-slot word-shift) (- other-pointer-lowtag)))) - (inst fs-segment-prefix) - (inst sub (make-ea :dword :scale 1 :index temp) delta))) + (inst sub (make-ea :qword :base thread-base-tn + :scale 1 :index temp) delta))) (load-tl-symbol-value result *alien-stack*)) #!-sb-thread (:generator 0 @@ -316,13 +316,13 @@ (unless (zerop amount) (let ((delta (logandc2 (+ amount 7) 7))) (inst mov temp - (make-ea :dword - :disp (+ nil-value - (static-symbol-offset '*alien-stack*) + (make-ea :qword + :disp (+ nil-value + (static-symbol-offset '*alien-stack*) (ash symbol-tls-index-slot word-shift) (- other-pointer-lowtag)))) - (inst fs-segment-prefix) - (inst add (make-ea :dword :scale 1 :index temp) delta)))) + (inst add (make-ea :qword :base thread-base-tn :scale 1 :index temp) + delta)))) #!-sb-thread (:generator 0 (unless (zerop amount) diff --git a/src/compiler/x86-64/cell.lisp b/src/compiler/x86-64/cell.lisp index 4be9484..92f43a1 100644 --- a/src/compiler/x86-64/cell.lisp +++ b/src/compiler/x86-64/cell.lisp @@ -68,11 +68,11 @@ (loadw tls symbol symbol-tls-index-slot other-pointer-lowtag) (inst or tls tls) (inst jmp :z global-val) - (inst fs-segment-prefix) - (inst cmp (make-ea :dword :scale 1 :index tls) unbound-marker-widetag) + (inst cmp (make-ea :qword :base thread-base-tn :scale 1 :index tls) + unbound-marker-widetag) (inst jmp :z global-val) - (inst fs-segment-prefix) - (inst mov (make-ea :dword :scale 1 :index tls) value) + (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls) + value) (inst jmp done) (emit-label global-val) (storew value symbol symbol-value-slot other-pointer-lowtag) @@ -107,8 +107,8 @@ (let* ((err-lab (generate-error-code vop unbound-symbol-error object)) (ret-lab (gen-label))) (loadw value object symbol-tls-index-slot other-pointer-lowtag) - (inst fs-segment-prefix) - (inst mov value (make-ea :dword :index value :scale 1)) + (inst mov value (make-ea :qword :base thread-base-tn + :index value :scale 1)) (inst cmp value unbound-marker-widetag) (inst jmp :ne ret-lab) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -128,8 +128,8 @@ (:generator 8 (let ((ret-lab (gen-label))) (loadw value object symbol-tls-index-slot other-pointer-lowtag) - (inst fs-segment-prefix) - (inst mov value (make-ea :dword :index value :scale 1)) + (inst mov value + (make-ea :qword :base thread-base-tn :index value :scale 1)) (inst cmp value unbound-marker-widetag) (inst jmp :ne ret-lab) (loadw value object symbol-value-slot other-pointer-lowtag) @@ -169,7 +169,7 @@ (:generator 4 (move result value) (inst lock) - (inst add (make-ea :dword :base object + (inst add (make-ea :qword :base object :disp (- (* symbol-value-slot n-word-bytes) other-pointer-lowtag)) value))) @@ -189,8 +189,8 @@ (inst cmp value unbound-marker-widetag) (inst jmp :ne not-target) (loadw value object symbol-tls-index-slot other-pointer-lowtag) - (inst fs-segment-prefix) - (inst cmp (make-ea :dword :index value :scale 1) unbound-marker-widetag) + (inst cmp (make-ea :qword :base thread-base-tn + :index value :scale 1) unbound-marker-widetag) (inst jmp :e target) (emit-label not-target)) (progn @@ -198,8 +198,8 @@ (inst cmp value unbound-marker-widetag) (inst jmp :ne target) (loadw value object symbol-tls-index-slot other-pointer-lowtag) - (inst fs-segment-prefix) - (inst cmp (make-ea :dword :index value :scale 1) unbound-marker-widetag) + (inst cmp (make-ea :qword :base thread-base-tn :index value :scale 1) + unbound-marker-widetag) (inst jmp :ne target))))) #!-sb-thread @@ -301,17 +301,17 @@ (inst jmp :ne tls-index-valid) ;; allocate a new tls-index (load-symbol-value tls-index *free-tls-index*) - (inst add tls-index 4) ;XXX surely we can do this more + (inst add tls-index 8) ;XXX surely we can do this more (store-symbol-value tls-index *free-tls-index*) ;succintly - (inst sub tls-index 4) + (inst sub tls-index 8) (storew tls-index symbol symbol-tls-index-slot other-pointer-lowtag) (emit-label tls-index-valid) - (inst fs-segment-prefix) - (inst mov temp (make-ea :dword :scale 1 :index tls-index)) + (inst mov temp + (make-ea :qword :base thread-base-tn :scale 1 :index tls-index)) (storew temp bsp (- binding-value-slot binding-size)) (storew symbol bsp (- binding-symbol-slot binding-size)) - (inst fs-segment-prefix) - (inst mov (make-ea :dword :scale 1 :index tls-index) val)))) + (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index) + val)))) #!-sb-thread (define-vop (bind) @@ -338,8 +338,8 @@ (loadw value bsp (- binding-value-slot binding-size)) (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) - (inst fs-segment-prefix) - (inst mov (make-ea :dword :scale 1 :index tls-index) value) + (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index) + value) (storew 0 bsp (- binding-symbol-slot binding-size)) (inst sub bsp (* binding-size n-word-bytes)) @@ -372,12 +372,13 @@ (inst or symbol symbol) (inst jmp :z SKIP) (loadw value bsp (- binding-value-slot binding-size)) - #!-sb-thread (storew value symbol symbol-value-slot other-pointer-lowtag) - - #!+sb-thread (loadw - tls-index symbol symbol-tls-index-slot other-pointer-lowtag) - #!+sb-thread (inst fs-segment-prefix) - #!+sb-thread (inst mov (make-ea :dword :scale 1 :index tls-index) value) + #!-sb-thread + (storew value symbol symbol-value-slot other-pointer-lowtag) + #!+sb-thread + (loadw tls-index symbol symbol-tls-index-slot other-pointer-lowtag) + #!+sb-thread + (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index tls-index) + value) (storew 0 bsp (- binding-symbol-slot binding-size)) SKIP @@ -460,22 +461,22 @@ (:translate %instance-set-conditional) (:args (object :scs (descriptor-reg) :to :eval) (slot :scs (any-reg) :to :result) - (old-value :scs (descriptor-reg any-reg) :target eax) + (old-value :scs (descriptor-reg any-reg) :target rax) (new-value :scs (descriptor-reg any-reg))) (:arg-types instance positive-fixnum * *) - (:temporary (:sc descriptor-reg :offset eax-offset - :from (:argument 2) :to :result :target result) eax) + (:temporary (:sc descriptor-reg :offset rax-offset + :from (:argument 2) :to :result :target result) rax) (:results (result :scs (descriptor-reg any-reg))) ;(:guard (backend-featurep :i486)) (:policy :fast-safe) (:generator 5 - (move eax old-value) + (move rax old-value) (inst lock) - (inst cmpxchg (make-ea :dword :base object :index slot :scale 1 + (inst cmpxchg (make-ea :qword :base object :index slot :scale 1 :disp (- (* instance-slots-offset n-word-bytes) instance-pointer-lowtag)) new-value) - (move result eax))) + (move result rax))) diff --git a/src/compiler/x86-64/macros.lisp b/src/compiler/x86-64/macros.lisp index 29601b5..a3fc928 100644 --- a/src/compiler/x86-64/macros.lisp +++ b/src/compiler/x86-64/macros.lisp @@ -78,8 +78,7 @@ (static-symbol-offset ',symbol) (ash symbol-tls-index-slot word-shift) (- other-pointer-lowtag)))) - (inst fs-segment-prefix) - (inst mov ,reg (make-ea :qword :scale 1 :index ,reg)))) + (inst mov ,reg (make-ea :qword :base thread-base-tn :scale 1 :index ,reg)))) #!-sb-thread (defmacro load-tl-symbol-value (reg symbol) `(load-symbol-value ,reg ,symbol)) @@ -92,8 +91,7 @@ (static-symbol-offset ',symbol) (ash symbol-tls-index-slot word-shift) (- other-pointer-lowtag)))) - (inst fs-segment-prefix) - (inst mov (make-ea :qword :scale 1 :index ,temp) ,reg))) + (inst mov (make-ea :qword :base thread-base-tn :scale 1 :index ,temp) ,reg))) #!-sb-thread (defmacro store-tl-symbol-value (reg symbol temp) (declare (ignore temp)) @@ -153,27 +151,34 @@ (DONE (gen-label)) ;; Yuck. (in-elsewhere (eq *elsewhere* sb!assem::**current-segment**)) + ;; thread->alloc_region.free_pointer (free-pointer - (make-ea :qword :disp - #!+sb-thread (* n-word-bytes thread-alloc-region-slot) - #!-sb-thread (make-fixup "boxed_region" :foreign) - :scale 1)) ; thread->alloc_region.free_pointer + #!+sb-thread + (make-ea :qword + :base thread-base-tn :scale 1 + :disp (* n-word-bytes thread-alloc-region-slot)) + #!-sb-thread + (make-ea :qword + :scale 1 :disp + (make-fixup (extern-alien-name "boxed_region") :foreign))) + ;; thread->alloc_region.end_addr (end-addr - (make-ea :qword :disp - #!+sb-thread (* n-word-bytes (1+ thread-alloc-region-slot)) - #!-sb-thread (make-fixup "boxed_region" :foreign 8) - :scale 1))) ; thread->alloc_region.end_addr + #!+sb-thread + (make-ea :qword + :base thread-base-tn :scale 1 + :disp (* n-word-bytes (1+ thread-alloc-region-slot))) + #!-sb-thread + (make-ea :qword + :scale 1 :disp + (make-fixup (extern-alien-name "boxed_region") :foreign 8)))) (cond (in-elsewhere (allocation-tramp alloc-tn size)) (t (unless (and (tn-p size) (location= alloc-tn size)) (inst mov alloc-tn size)) - #!+sb-thread (inst fs-segment-prefix) (inst add alloc-tn free-pointer) - #!+sb-thread (inst fs-segment-prefix) (inst cmp end-addr alloc-tn) (inst jmp :be NOT-INLINE) - #!+sb-thread (inst fs-segment-prefix) (inst xchg free-pointer alloc-tn) (emit-label DONE) (assemble (*elsewhere*) @@ -275,6 +280,32 @@ (progn ,@body) (pseudo-atomic ,@body))) +#!+sb-thread +(defmacro pseudo-atomic (&rest forms) + (with-unique-names (label) + `(let ((,label (gen-label))) + (inst mov (make-ea :byte + :base thread-base-tn + :disp (* 8 thread-pseudo-atomic-interrupted-slot)) 0) + (inst mov (make-ea :byte + :base thread-base-tn + :disp (* 8 thread-pseudo-atomic-atomic-slot)) + (fixnumize 1)) + ,@forms + (inst mov (make-ea :byte + :base thread-base-tn + :disp (* 8 thread-pseudo-atomic-atomic-slot)) 0) + (inst cmp (make-ea :byte + :base thread-base-tn + :disp (* 8 thread-pseudo-atomic-interrupted-slot)) 0) + (inst jmp :eq ,label) + ;; if PAI was set, interrupts were disabled at the same + ;; time using the process signal mask. + (inst break pending-interrupt-trap) + (emit-label ,label)))) + + +#!-sb-thread (defmacro pseudo-atomic (&rest forms) (with-unique-names (label) `(let ((,label (gen-label))) diff --git a/src/compiler/x86-64/system.lisp b/src/compiler/x86-64/system.lisp index 1a8d665..81f7ebd 100644 --- a/src/compiler/x86-64/system.lisp +++ b/src/compiler/x86-64/system.lisp @@ -277,7 +277,7 @@ (inst break pending-interrupt-trap))) #!+sb-thread -(defknown current-thread-offset-sap ((unsigned-byte 32)) +(defknown current-thread-offset-sap ((unsigned-byte 64)) system-area-pointer (flushable)) #!+sb-thread @@ -289,8 +289,8 @@ (:arg-types unsigned-num) (:policy :fast-safe) (:generator 2 - (inst fs-segment-prefix) - (inst mov sap (make-ea :dword :disp 0 :index n :scale 4)))) + (inst mov sap + (make-ea :qword :base thread-base-tn :disp 0 :index n :scale 8)))) (define-vop (halt) (:generator 1 diff --git a/src/compiler/x86-64/vm.lisp b/src/compiler/x86-64/vm.lisp index 44a68b1..258ccb7 100644 --- a/src/compiler/x86-64/vm.lisp +++ b/src/compiler/x86-64/vm.lisp @@ -112,8 +112,12 @@ (defreg r13 26 :qword) (defreg r14 28 :qword) (defreg r15 30 :qword) + ;; for no good reason at the time, r12 and r13 were missed from the + ;; list of qword registers. However + ;; r13 is already used as temporary [#lisp irc 2005/01/30] + ;; and we're now going to use r12 for the struct thread* (defregset *qword-regs* rax rcx rdx rbx rsi rdi - r8 r9 r10 r11 #+nil r12 #+nil r13 r14 r15) + r8 r9 r10 r11 r14 r15) ;; floating point registers (defreg float0 0 :float) @@ -393,6 +397,9 @@ (symbol-value (symbolicate register-arg-name "-TN"))) *register-arg-names*)) +(defparameter thread-base-tn + (make-random-tn :kind :normal :sc (sc-or-lose 'unsigned-reg ) + :offset r12-offset)) (defparameter fp-single-zero-tn (make-random-tn :kind :normal diff --git a/src/runtime/Config.x86_64-linux b/src/runtime/Config.x86_64-linux index d3d49f1..b607996 100644 --- a/src/runtime/Config.x86_64-linux +++ b/src/runtime/Config.x86_64-linux @@ -30,6 +30,10 @@ OS_SRC = linux-os.c x86-64-linux-os.c LINKFLAGS += -Wl,--export-dynamic OS_LIBS = -ldl +OS_LIBS += $(shell if grep LISP_FEATURE_SB_THREAD genesis/config.h \ + > /dev/null 2>&1; \ + then echo "-lpthread"; fi) + CFLAGS += -fno-omit-frame-pointer GC_SRC = gencgc.c diff --git a/src/runtime/interrupt.c b/src/runtime/interrupt.c index 5164c30..f2e9ceb 100644 --- a/src/runtime/interrupt.c +++ b/src/runtime/interrupt.c @@ -764,20 +764,19 @@ void arrange_return_to_lisp_function(os_context_t *context, lispobj function) #elif defined(LISP_FEATURE_X86_64) u64 *sp=(u64 *)*os_context_register_addr(context,reg_RSP); - *(sp-20) = post_signal_tramp; /* return address for call_into_lisp */ - - *(sp-19)=*os_context_register_addr(context,reg_R15); - *(sp-18)=*os_context_register_addr(context,reg_R14); - *(sp-17)=*os_context_register_addr(context,reg_R13); - *(sp-16)=*os_context_register_addr(context,reg_R12); - *(sp-15)=*os_context_register_addr(context,reg_R11); - *(sp-14)=*os_context_register_addr(context,reg_R10); - *(sp-13)=*os_context_register_addr(context,reg_R9); - *(sp-12)=*os_context_register_addr(context,reg_R8); - *(sp-11)=*os_context_register_addr(context,reg_RDI); - *(sp-10)=*os_context_register_addr(context,reg_RSI); - *(sp-9)=*os_context_register_addr(context,reg_RSP)-16; - *(sp-8)=0; + *(sp-18) = post_signal_tramp; /* return address for call_into_lisp */ + + *(sp-17)=*os_context_register_addr(context,reg_R15); + *(sp-16)=*os_context_register_addr(context,reg_R14); + *(sp-15)=*os_context_register_addr(context,reg_R13); + *(sp-14)=*os_context_register_addr(context,reg_R12); + *(sp-13)=*os_context_register_addr(context,reg_R11); + *(sp-12)=*os_context_register_addr(context,reg_R10); + *(sp-11)=*os_context_register_addr(context,reg_R9); + *(sp-10)=*os_context_register_addr(context,reg_R8); + *(sp-9)=*os_context_register_addr(context,reg_RDI); + *(sp-8)=*os_context_register_addr(context,reg_RSI); + /* skip RBP and RSP */ *(sp-7)=*os_context_register_addr(context,reg_RBX); *(sp-6)=*os_context_register_addr(context,reg_RDX); *(sp-5)=*os_context_register_addr(context,reg_RCX); @@ -807,7 +806,7 @@ void arrange_return_to_lisp_function(os_context_t *context, lispobj function) *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-20; + *os_context_register_addr(context,reg_RSP) = sp-18; #else /* this much of the calling convention is common to all non-x86 ports */ diff --git a/src/runtime/thread.c b/src/runtime/thread.c index 6e3e978..4b39120 100644 --- a/src/runtime/thread.c +++ b/src/runtime/thread.c @@ -169,7 +169,7 @@ struct thread * create_thread_struct(lispobj initial_function) { STATIC_TLS_INIT(CONTROL_STACK_START,control_stack_start); STATIC_TLS_INIT(CONTROL_STACK_END,control_stack_end); STATIC_TLS_INIT(ALIEN_STACK,alien_stack_pointer); -#ifdef LISP_FEATURE_X86 +#if defined(LISP_FEATURE_X86) || defined (LISP_FEATURE_X86_64) STATIC_TLS_INIT(PSEUDO_ATOMIC_ATOMIC,pseudo_atomic_atomic); STATIC_TLS_INIT(PSEUDO_ATOMIC_INTERRUPTED,pseudo_atomic_interrupted); #endif diff --git a/src/runtime/x86-64-arch.h b/src/runtime/x86-64-arch.h index 4e3a18d..83e08fb 100644 --- a/src/runtime/x86-64-arch.h +++ b/src/runtime/x86-64-arch.h @@ -5,6 +5,10 @@ #ifndef _X86_64_ARCH_H #define _X86_64_ARCH_H +#ifndef SBCL_GENESIS_CONFIG +#error genesis/config.h (or sbcl.h) must be included before this file +#endif + #define ARCH_HAS_STACK_POINTER /* FIXME: Do we also want @@ -12,11 +16,15 @@ * here? (The answer wasn't obvious to me when merging the * architecture-abstracting patches for CSR's SPARC port. -- WHN 2002-02-15) */ +extern never_returns lose(char *fmt, ...); + static inline void -get_spinlock(lispobj *word,long value) +get_spinlock(volatile lispobj *word,long value) { #ifdef LISP_FEATURE_SB_THREAD u64 rax=0; + if(*word==value) + lose("recursive get_spinlock: 0x%x,%ld\n",word,value); do { asm ("xor %0,%0\n\ lock cmpxchg %1,%2" @@ -30,7 +38,7 @@ get_spinlock(lispobj *word,long value) } static inline void -release_spinlock(lispobj *word) +release_spinlock(volatile lispobj *word) { *word=0; } diff --git a/src/runtime/x86-64-assem.S b/src/runtime/x86-64-assem.S index 9642978..c654861 100644 --- a/src/runtime/x86-64-assem.S +++ b/src/runtime/x86-64-assem.S @@ -117,20 +117,26 @@ GNAME(call_into_lisp): mov %rsp,%rbp # Establish new frame. Lstack: /* FIXME x86 saves FPU state here */ - push %rbx - push %r12 - push %r13 - push %r14 - push %r15 - + push %rbx # these regs are callee-saved according to C + push %r12 # so must be preserved and restored when + push %r13 # the lisp function returns + push %r14 # + push %r15 # mov %rsp,%rbx # remember current stack push %rbx # Save entry stack on (maybe) new stack. - /* Establish Lisp args. */ - mov %rdi,%rax # lexenv? - mov %rsi,%rbx # address of arg vec - mov %rdx,%rcx # num args + push %rdi # args from C + push %rsi # + push %rdx # +#ifdef LISP_FEATURE_SB_THREAD + mov specials,%rdi + call pthread_getspecific + mov %rax,%r12 +#endif + pop %rcx # num args + pop %rbx # arg vector + pop %rax # function ptr/lexenv xor %rdx,%rdx # clear any descriptor registers xor %rdi,%rdi # that we can't be sure we'll @@ -328,10 +334,9 @@ GNAME(post_signal_tramp): popq %r8 popq %rdi popq %rsi - addq $8, %rsp - popq %rsp - popq %rdx + /* skip RBP and RSP */ popq %rbx + popq %rdx popq %rcx popq %rax popfq diff --git a/src/runtime/x86-64-linux-os.c b/src/runtime/x86-64-linux-os.c index 130d0c4..0579730 100644 --- a/src/runtime/x86-64-linux-os.c +++ b/src/runtime/x86-64-linux-os.c @@ -56,7 +56,7 @@ size_t os_vm_page_size; int arch_os_thread_init(struct thread *thread) { stack_t sigstack; #ifdef LISP_FEATURE_SB_THREAD -#error Threads are not supported on x86-64 in this SBCL version + pthread_setspecific(specials,thread); #endif #ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK /* Signal handlers are run on the control stack, so if it is exhausted @@ -65,7 +65,9 @@ int arch_os_thread_init(struct thread *thread) { sigstack.ss_sp=((void *) thread)+dynamic_values_bytes; sigstack.ss_flags=0; sigstack.ss_size = 32*SIGSTKSZ; - sigaltstack(&sigstack,0); + if(sigaltstack(&sigstack,0)<0) { + lose("Cannot sigaltstack: %s\n",strerror(errno)); + } #endif return 1; } diff --git a/version.lisp-expr b/version.lisp-expr index aa8ebd2..6268046 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.9.2.9" +"0.9.2.10" -- 1.7.10.4