(defstruct (mutex (:include waitqueue))
(value nil))
-#+nil
-(defun wait-on-queue (queue &optional lock)
- (let ((pid (current-thread-id)))
- ;; FIXME what should happen if we get interrupted when we've blocked
- ;; the sigcont? For that matter, can we get interrupted?
- (block-sigcont)
- (when lock (release-mutex lock))
- (get-spinlock queue 2 pid)
- (pushnew pid (waitqueue-data queue))
- (setf (waitqueue-lock queue) 0)
- (unblock-sigcont-and-sleep)))
-
-#+nil
-(defun dequeue (queue)
- (let ((pid (current-thread-id)))
- (get-spinlock queue 2 pid)
- (setf (waitqueue-data queue)
- (delete pid (waitqueue-data queue)))
- (setf (waitqueue-lock queue) 0)))
-
-#+nil
-(defun signal-queue-head (queue)
- (let ((pid (current-thread-id)))
- (get-spinlock queue 2 pid)
- (let ((h (car (waitqueue-data queue))))
- (setf (waitqueue-lock queue) 0)
- (when h
- (sb!unix:unix-kill h sb!unix:sigcont)))))
-
;;;; mutex
-#+nil
-(defun get-mutex (lock &optional new-value (wait-p t))
- (declare (type mutex lock))
- (let ((pid (current-thread-id)))
- (unless new-value (setf new-value pid))
- (assert (not (eql new-value (mutex-value lock))))
- (loop
- (unless
- ;; args are object slot-num old-value new-value
- (sb!vm::%instance-set-conditional lock 4 nil new-value)
- (dequeue lock)
- (return t))
- (unless wait-p (return nil))
- (wait-on-queue lock nil))))
-
-#+nil
-(defun release-mutex (lock &optional (new-value nil))
- (declare (type mutex lock))
- (let ((old-value (mutex-value lock))
- (t1 nil))
- (loop
- (unless
- ;; args are object slot-num old-value new-value
- (eql old-value
- (setf t1
- (sb!vm::%instance-set-conditional lock 4 old-value new-value)))
- (signal-queue-head lock)
- (return t))
- (setf old-value t1))))
-
(defun get-mutex (lock &optional new-value (wait-p t))
(declare (type mutex lock))
(let ((old-value (mutex-value lock)))
(declare (type mutex lock))
(setf (mutex-value lock) nil))
-;;; what's the best thing to do with these on unithread? commented
-;;; functions are the thread versions, just to remind me what they do
-;;; there
-#+nil
-(defun condition-wait (queue lock)
- "Atomically release LOCK and enqueue ourselves on QUEUE. Another
-thread may subsequently notify us using CONDITION-NOTIFY, at which
-time we reacquire LOCK and return to the caller."
- (unwind-protect
- (wait-on-queue queue lock)
- ;; If we are interrupted while waiting, we should do these things
- ;; before returning. Ideally, in the case of an unhandled signal,
- ;; we should do them before entering the debugger, but this is
- ;; better than nothing.
- (dequeue queue)
- (get-mutex lock)))
-
-#+nil
-(defun condition-notify (queue)
- "Notify one of the processes waiting on QUEUE"
- (signal-queue-head queue))
+
+;; FIXME need suitable stub or ERROR-signaling definitions for
+;; condition-wait (queue lock)
+;; condition-notify (queue)
;;;; job control
free=fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,th));
for(i=free-1;i>=0;i--) {
os_context_t *c=th->interrupt_contexts[i];
- esp1 = (void **) *os_context_register_addr(c,reg_ESP);
+ esp1 = (void **) *os_context_register_addr(c,reg_SP);
if(esp1>=th->control_stack_start&& esp1<th->control_stack_end){
if(esp1<esp) esp=esp1;
for(ptr = (void **)(c+1); ptr>=(void **)c; ptr--) {
#endif
#ifdef LISP_FEATURE_SB_THREAD
-pid_t parent_pid;
boolean stop_the_world=0;
#endif
/* Set foreign function call active. */
foreign_function_call_active = 1;
-#ifdef LISP_FEATURE_SB_THREAD
- parent_pid=getpid();
-#endif
}
#endif
extern lispobj *current_dynamic_space;
-extern pid_t parent_pid;
extern boolean stop_the_world;
extern void globals_init(void);
* mask ought to be clear anyway most of the time, but may be non-zero
* if we were interrupted e.g. while waiting for a queue. */
-#if 1
void reset_signal_mask ()
{
sigset_t new;
sigemptyset(&new);
sigprocmask(SIG_SETMASK,&new,0);
}
-#else
-void reset_signal_mask ()
-{
- sigset_t new,old;
- int i;
- int wrong=0;
- sigemptyset(&new);
- sigprocmask(SIG_SETMASK,&new,&old);
- for(i=1; i<NSIG; i++) {
- if(sigismember(&old,i)) {
- fprintf(stderr,
- "Warning: signal %d is masked: this is unexpected\n",i);
- wrong=1;
- }
- }
- if(wrong)
- fprintf(stderr,"If this version of SBCL is less than three months old, please report this.\nOtherwise, please try a newer version first\n. Reset signal mask.\n");
-}
-#endif
extern void post_signal_tramp(void);
void arrange_return_to_lisp_function(os_context_t *context, lispobj function)
{
-#ifndef LISP_FEATURE_X86
+#if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64))
void * fun=native_pointer(function);
void *code = &(((struct simple_fun *) fun)->code);
#endif
if(th==0) return 0;
kid_pid=clone(new_thread_trampoline,
(((void*)th->control_stack_start)+
- THREAD_CONTROL_STACK_SIZE-4),
+ THREAD_CONTROL_STACK_SIZE-16),
CLONE_FILES|SIG_THREAD_EXIT|CLONE_VM,th);
if(kid_pid>0) {
}
#endif
-/* unused */
-void destroy_thread (struct thread *th)
-{
- /* precondition: the unix task has already been killed and exited.
- * This is called by the parent or some other thread */
-#ifdef LISP_FEATURE_GENCGC
- gc_alloc_update_page_tables(0, &th->alloc_region);
-#endif
- get_spinlock(&all_threads_lock,th->pid);
- th->unbound_marker=0; /* for debugging */
- if(th==all_threads)
- all_threads=th->next;
- else {
- struct thread *th1=all_threads;
- while(th1 && th1->next!=th) th1=th1->next;
- if(th1) th1->next=th->next; /* unlink */
- }
- release_spinlock(&all_threads_lock);
- if(th && th->tls_cookie>=0) arch_os_thread_cleanup(th);
- os_invalidate((os_vm_address_t) th->control_stack_start,
- ((sizeof (lispobj))
- * (th->control_stack_end-th->control_stack_start)) +
- BINDING_STACK_SIZE+ALIEN_STACK_SIZE+dynamic_values_bytes+
- 32*SIGSTKSZ);
-}
-
struct thread *find_thread_by_pid(pid_t pid)
{
struct thread *th;
* reserved for the system libraries? If so, it would be tidy to
* rename flags like _X86_ARCH_H so their names are in a part of the
* namespace that we control. */
-#ifndef _X86_ARCH_H
-#define _X86_ARCH_H
+#ifndef _X86_64_ARCH_H
+#define _X86_64_ARCH_H
#define ARCH_HAS_STACK_POINTER
static inline void
get_spinlock(lispobj *word,long value)
{
-#if 0
- u32 eax=0;
+#ifdef LISP_FEATURE_SB_THREAD
+ u64 rax=0;
do {
asm ("xor %0,%0\n\
lock cmpxchg %1,%2"
- : "=a" (eax)
+ : "=a" (rax)
: "r" (value), "m" (*word)
: "memory", "cc");
- } while(eax!=0);
+ } while(rax!=0);
#else
*word=value;
#endif
*word=0;
}
-#endif /* _X86_ARCH_H */
+#endif /* _X86_64_ARCH_H */
mov THREAD_CONTROL_STACK_START_OFFSET(%rax) ,%rsp
/* don't think too hard about what happens if we get interrupted
* here */
- add $THREAD_CONTROL_STACK_SIZE-8,%rsp
+ add $THREAD_CONTROL_STACK_SIZE-16,%rsp
jmp Lstack
\f
.text
pop %rbx
/* FIXME Restore the NPX state. */
- pop %rbp # c-sp
+
/* return value is already in rax where lisp expects it */
+ leave
ret
.size GNAME(call_into_lisp), . - GNAME(call_into_lisp)
\f
/*
- * The x86 Linux incarnation of arch-dependent OS-dependent routines.
- * See also "linux-os.c".
+ * The x86-64 Linux incarnation of arch-dependent OS-dependent
+ * routines. See also "linux-os.c".
*/
/*
#include <linux/version.h>
#include "thread.h" /* dynamic_values_bytes */
-#if LINUX_VERSION_CODE < KERNEL_VERSION(2,6,0)
-#define user_desc modify_ldt_ldt_s
-#endif
-
-_syscall3(int, modify_ldt, int, func, void *, ptr, unsigned long, bytecount );
-
#include "validate.h"
size_t os_vm_page_size;
-u32 local_ldt_copy[LDT_ENTRIES*LDT_ENTRY_SIZE/sizeof(u32)];
-
-/* This is never actually called, but it's great for calling from gdb when
- * users have thread-related problems that maintainers can't duplicate */
-
-void debug_get_ldt()
-{
- int n=modify_ldt (0, local_ldt_copy, sizeof local_ldt_copy);
- printf("%d bytes in ldt: print/x local_ldt_copy\n", n);
-}
-
-lispobj modify_ldt_lock; /* protect all calls to modify_ldt */
-
int arch_os_thread_init(struct thread *thread) {
stack_t sigstack;
#ifdef LISP_FEATURE_SB_THREAD
- /* this must be called from a function that has an exclusive lock
- * on all_threads
- */
- struct user_desc ldt_entry = {
- 1, 0, 0, /* index, address, length filled in later */
- 1, MODIFY_LDT_CONTENTS_DATA, 0, 0, 0, 1
- };
- int n;
- get_spinlock(&modify_ldt_lock,thread);
- n=modify_ldt(0,local_ldt_copy,sizeof local_ldt_copy);
- /* get next free ldt entry */
-
- if(n) {
- u32 *p;
- for(n=0,p=local_ldt_copy;*p;p+=LDT_ENTRY_SIZE/sizeof(u32))
- n++;
- }
- ldt_entry.entry_number=n;
- ldt_entry.base_addr=(unsigned long) thread;
- ldt_entry.limit=dynamic_values_bytes;
- ldt_entry.limit_in_pages=0;
- if (modify_ldt (1, &ldt_entry, sizeof (ldt_entry)) != 0) {
- modify_ldt_lock=0;
- /* modify_ldt call failed: something magical is not happening */
- return -1;
- }
- __asm__ __volatile__ ("movw %w0, %%fs" : : "q"
- ((n << 3) /* selector number */
- + (1 << 2) /* TI set = LDT */
- + 3)); /* privilege level */
- thread->tls_cookie=n;
- modify_ldt_lock=0;
-
- if(n<0) return 0;
+#error Threads are not supported on x86-64 in this SBCL version
#endif
#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
/* Signal handlers are run on the control stack, so if it is exhausted
return 1;
}
-struct thread *debug_get_fs() {
- register u32 fs;
- __asm__ __volatile__ ("movl %%fs,%0" : "=r" (fs) : );
- return fs;
-}
-
/* free any arch/os-specific resources used by thread, which is now
* defunct. Not called on live threads
*/
int arch_os_thread_cleanup(struct thread *thread) {
- struct user_desc ldt_entry = {
- 0, 0, 0,
- 0, MODIFY_LDT_CONTENTS_DATA, 0, 0, 0, 0
- };
-
- ldt_entry.entry_number=thread->tls_cookie;
- get_spinlock(&modify_ldt_lock,thread);
- if (modify_ldt (1, &ldt_entry, sizeof (ldt_entry)) != 0) {
- modify_ldt_lock=0;
- /* modify_ldt call failed: something magical is not happening */
- return 0;
- }
- modify_ldt_lock=0;
return 1;
}
-#ifndef _X86_LINUX_OS_H
-#define _X86_LINUX_OS_H
+#ifndef _X86_64_LINUX_OS_H
+#define _X86_64_LINUX_OS_H
typedef struct ucontext os_context_t;
typedef long os_context_register_t;
unsigned long os_context_fp_control(os_context_t *context);
void os_restore_fp_control(os_context_t *context);
-#endif /* _X86_LINUX_OS_H */
+#endif /* _X86_64_LINUX_OS_H */
;;; 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.21.40"
+"0.8.21.41"
projects / sbcl.git / commitdiff