Update of /cvsroot/sbcl/sbcl/src/runtime
In directory sc8-pr-cvs1:/tmp/cvs-serv9747/src/runtime
Modified Files:
GNUmakefile alloc.c backtrace.c breakpoint.c coreparse.c
dynbind.c dynbind.h gc.h gencgc.c gencgc.h globals.c globals.h
interrupt.c interrupt.h ldso-stubs.S linux-os.c monitor.c
parse.c print.c purify.c runtime.c runtime.h save.c search.c
thread.c thread.h validate.c validate.h x86-arch.c x86-assem.S
x86-linux-os.c x86-linux-os.h
Log Message:
0.pre8.28
=== Threads merge, 100 metres ===
This is the first commit of experimental native threads for
SBCL. Note that thread support is by default not compiled in
- you need to add :sb-thread to target features. Note also
that non-x86 probably doesn't build in this version - that
will be fixed imminently
See log messages for dan_native_threads_branch,
dan_native_threads_2_branch, dan_native_threads_3_branch for
more information. I'm not going to type it all in again
Index: GNUmakefile
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/GNUmakefile,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- GNUmakefile 27 Feb 2003 00:49:59 -0000 1.15
+++ GNUmakefile 2 Apr 2003 11:15:20 -0000 1.16
@@ -39,7 +39,7 @@
dynbind.c gc-common.c globals.c interr.c interrupt.c \
monitor.c parse.c print.c purify.c \
regnames.c run-program.c runtime.c save.c search.c \
- time.c util.c validate.c vars.c wrap.c
+ thread.c time.c util.c validate.c vars.c wrap.c
SRCS= $(C_SRCS) ${ARCH_SRC} ${ASSEM_SRC} ${OS_SRC} ${GC_SRC}
Index: alloc.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/alloc.c,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- alloc.c 27 Feb 2003 00:50:00 -0000 1.14
+++ alloc.c 2 Apr 2003 11:15:20 -0000 1.15
@@ -23,12 +23,11 @@
#include "alloc.h"
#include "globals.h"
#include "gc.h"
-#include "genesis/static-symbols.h"
+#include "thread.h"
#include "genesis/vector.h"
#include "genesis/cons.h"
#include "genesis/bignum.h"
#include "genesis/sap.h"
-#include "genesis/symbol.h"
#define GET_FREE_POINTER() dynamic_space_free_pointer
#define SET_FREE_POINTER(new_value) \
@@ -45,11 +44,12 @@
pa_alloc(int bytes)
{
lispobj *result=0;
- SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0));
- SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1));
+ struct thread *th=arch_os_get_current_thread();
+ SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0),th);
+ SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1),th);
result=alloc(bytes);
- SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0));
- if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED))
+ SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0),th);
+ if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED,th))
/* even if we gc at this point, the new allocation will be
* protected from being moved, because result is on the c stack
* and points to it */
Index: backtrace.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/backtrace.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- backtrace.c 27 Feb 2003 15:19:48 -0000 1.10
+++ backtrace.c 2 Apr 2003 11:15:20 -0000 1.11
@@ -21,6 +21,9 @@
#include "os.h"
#include "interrupt.h"
#include "lispregs.h"
+#ifdef LISP_FEATURE_GENCGC
+#include "gencgc-alloc-region.h"
+#endif
#include "genesis/static-symbols.h"
#include "genesis/primitive-objects.h"
@@ -148,6 +151,7 @@
previous_info(struct call_info *info)
{
struct call_frame *this_frame;
+ struct thread *thread=arch_os_get_current_thread();
int free;
if (!cs_valid_pointer_p(info->frame)) {
@@ -165,10 +169,10 @@
if (info->lra == NIL) {
/* We were interrupted. Find the correct signal context. */
- free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
+ free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)>>2;
while (free-- > 0) {
os_context_t *context =
- lisp_interrupt_contexts[free];
+ thread->interrupt_contexts[free];
if ((struct call_frame *)(*os_context_register_addr(context,
reg_CFP))
== info->frame) {
Index: breakpoint.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/breakpoint.c,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- breakpoint.c 27 Feb 2003 00:50:00 -0000 1.11
+++ breakpoint.c 2 Apr 2003 11:15:20 -0000 1.12
@@ -21,10 +21,9 @@
#include "globals.h"
#include "alloc.h"
#include "breakpoint.h"
+#include "thread.h"
#include "genesis/code.h"
#include "genesis/fdefn.h"
-#include "genesis/symbol.h"
-#include "genesis/static-symbols.h"
#define REAL_LRA_SLOT 0
#ifndef __i386__
Index: coreparse.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/coreparse.c,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- coreparse.c 27 Feb 2003 00:50:00 -0000 1.18
+++ coreparse.c 2 Apr 2003 11:15:20 -0000 1.19
@@ -33,8 +33,7 @@
#include "arch.h"
#include "interr.h"
#include "sbcl.h"
-#include "genesis/symbol.h"
-#include "genesis/static-symbols.h"
+#include "thread.h"
unsigned char build_id[] =
#include "../../output/build-id.tmp"
@@ -94,7 +93,7 @@
* defined(__i386__)
* ? */
#if defined(LISP_FEATURE_X86)
- SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer);
+ SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer,0);
#else
dynamic_space_free_pointer = free_pointer;
#endif
Index: dynbind.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/dynbind.c,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- dynbind.c 27 Feb 2003 00:50:00 -0000 1.6
+++ dynbind.c 2 Apr 2003 11:15:21 -0000 1.7
@@ -17,35 +17,44 @@
#include "sbcl.h"
#include "globals.h"
#include "dynbind.h"
+#include "thread.h"
#include "genesis/symbol.h"
#include "genesis/binding.h"
-#include "genesis/static-symbols.h"
+#include "genesis/thread.h"
#if defined(__i386__)
-#define GetBSP() ((struct binding *)SymbolValue(BINDING_STACK_POINTER))
-#define SetBSP(value) SetSymbolValue(BINDING_STACK_POINTER, (lispobj)(value))
+#define GetBSP() ((struct binding *)SymbolValue(BINDING_STACK_POINTER,thread))
+#define SetBSP(value) SetSymbolValue(BINDING_STACK_POINTER, (lispobj)(value),thread)
#else
#define GetBSP() ((struct binding *)current_binding_stack_pointer)
#define SetBSP(value) (current_binding_stack_pointer=(lispobj *)(value))
#endif
-void bind_variable(lispobj symbol, lispobj value)
+void bind_variable(lispobj symbol, lispobj value, void *th)
{
- lispobj old_value;
+ lispobj old_tl_value;
struct binding *binding;
-
- old_value = SymbolValue(symbol);
+ struct thread *thread=(struct thread *)th;
+ struct symbol *sym=(struct symbol *)native_pointer(symbol);
binding = GetBSP();
SetBSP(binding+1);
-
- binding->value = old_value;
+#ifdef LISP_FEATURE_SB_THREAD
+ if(!sym->tls_index) {
+ sym->tls_index=SymbolValue(FREE_TLS_INDEX,0);
+ SetSymbolValue(FREE_TLS_INDEX,
+ make_fixnum(fixnum_value(sym->tls_index)+1),0);
+ }
+#endif
+ old_tl_value=SymbolTlValue(symbol,thread);
+ binding->value = old_tl_value;
binding->symbol = symbol;
- SetSymbolValue(symbol, value);
+ SetTlSymbolValue(symbol, value,thread);
}
void
-unbind(void)
+unbind(void *th)
{
+ struct thread *thread=(struct thread *)th;
struct binding *binding;
lispobj symbol;
@@ -53,7 +62,7 @@
symbol = binding->symbol;
- SetSymbolValue(symbol, binding->value);
+ SetTlSymbolValue(symbol, binding->value,thread);
binding->symbol = 0;
@@ -61,8 +70,9 @@
}
void
-unbind_to_here(lispobj *bsp)
+unbind_to_here(lispobj *bsp,void *th)
{
+ struct thread *thread=(struct thread *)th;
struct binding *target = (struct binding *)bsp;
struct binding *binding = GetBSP();
lispobj symbol;
@@ -71,12 +81,10 @@
binding--;
symbol = binding->symbol;
-
if (symbol) {
- SetSymbolValue(symbol, binding->value);
+ SetTlSymbolValue(symbol, binding->value,thread);
binding->symbol = 0;
}
-
}
SetBSP(binding);
}
Index: dynbind.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/dynbind.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- dynbind.h 20 Oct 2000 23:30:35 -0000 1.2
+++ dynbind.h 2 Apr 2003 11:15:21 -0000 1.3
@@ -12,8 +12,8 @@
#ifndef _DYNBIND_H_
#define _DYNBIND_H_
-extern void bind_variable(lispobj symbol, lispobj value);
-extern void unbind(void);
-extern void unbind_to_here(lispobj *bsp);
+extern void bind_variable(lispobj symbol, lispobj value,void *thread);
+extern void unbind(void *thread);
+extern void unbind_to_here(lispobj *bsp,void *thread);
#endif
Index: gc.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/gc.h,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- gc.h 27 Feb 2003 00:50:00 -0000 1.6
+++ gc.h 2 Apr 2003 11:15:21 -0000 1.7
@@ -25,5 +25,6 @@
extern void set_auto_gc_trigger(os_vm_size_t usage);
extern void clear_auto_gc_trigger(void);
-extern boolean maybe_gc_pending;
+extern int maybe_gc_pending;
+extern int gc_thread_pid;
#endif /* _GC_H_ */
Index: gencgc.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/gencgc.c,v
retrieving revision 1.27
retrieving revision 1.28
diff -u -d -r1.27 -r1.28
--- gencgc.c 10 Mar 2003 14:54:30 -0000 1.27
+++ gencgc.c 2 Apr 2003 11:15:21 -0000 1.28
@@ -38,11 +38,10 @@
#include "arch.h"
#include "gc.h"
#include "gc-internal.h"
+#include "thread.h"
#include "genesis/vector.h"
#include "genesis/weak-pointer.h"
#include "genesis/simple-fun.h"
-#include "genesis/static-symbols.h"
-#include "genesis/symbol.h"
/* assembly language stub that executes trap_PendingInterrupt */
void do_pending_interrupt(void);
@@ -247,6 +246,13 @@
* integrated with the Lisp code. */
static int last_free_page;
+/* This lock is to prevent multiple threads from simultaneously
+ * allocating new regions which overlap each other. Note that the
+ * majority of GC is single-threaded, but alloc() may be called
+ * from >1 thread at a time and must be thread-safe */
+static lispobj free_pages_lock=0;
+
+
/*
* miscellaneous heap functions
*/
@@ -490,7 +496,7 @@
gc_assert((alloc_region->first_page == 0)
&& (alloc_region->last_page == -1)
&& (alloc_region->free_pointer == alloc_region->end_addr));
-
+ get_spinlock(&free_pages_lock,alloc_region);
if (unboxed) {
first_page =
generations[gc_alloc_generation].alloc_unboxed_start_page;
@@ -510,20 +516,6 @@
alloc_region->free_pointer = alloc_region->start_addr;
alloc_region->end_addr = alloc_region->start_addr + bytes_found;
- if (gencgc_zero_check) {
- int *p;
- for (p = (int *)alloc_region->start_addr;
- p < (int *)alloc_region->end_addr; p++) {
- if (*p != 0) {
- /* KLUDGE: It would be nice to use %lx and explicit casts
- * (long) in code like this, so that it is less likely to
- * break randomly when running on a machine with different
- * word sizes. -- WHN 19991129 */
- lose("The new region at %x is not zero.", p);
- }
- }
- }
-
/* Set up the pages. */
/* The first page may have already been in use. */
@@ -559,15 +551,32 @@
alloc_region->start_addr - page_address(i);
page_table[i].allocated |= OPEN_REGION_PAGE ;
}
-
/* Bump up last_free_page. */
if (last_page+1 > last_free_page) {
last_free_page = last_page+1;
SetSymbolValue(ALLOCATION_POINTER,
- (lispobj)(((char *)heap_base) + last_free_page*4096));
+ (lispobj)(((char *)heap_base) + last_free_page*4096),
+ 0);
+ }
+ free_pages_lock=0;
+
+ /* we can do this after releasing free_pages_lock */
+ if (gencgc_zero_check) {
+ int *p;
+ for (p = (int *)alloc_region->start_addr;
+ p < (int *)alloc_region->end_addr; p++) {
+ if (*p != 0) {
+ /* KLUDGE: It would be nice to use %lx and explicit casts
+ * (long) in code like this, so that it is less likely to
+ * break randomly when running on a machine with different
+ * word sizes. -- WHN 19991129 */
+ lose("The new region at %x is not zero.", p);
+ }
}
}
+}
+
/* If the record_new_objects flag is 2 then all new regions created
* are recorded.
*
@@ -836,6 +845,8 @@
index ahead of the current region and bumped up here to save a
lot of re-scanning. */
+ get_spinlock(&free_pages_lock,alloc_region);
+
if (unboxed) {
first_page =
generations[gc_alloc_generation].alloc_large_unboxed_start_page;
@@ -932,8 +943,9 @@
if (last_page+1 > last_free_page) {
last_free_page = last_page+1;
SetSymbolValue(ALLOCATION_POINTER,
- (lispobj)(((char *)heap_base) + last_free_page*4096));
+ (lispobj)(((char *)heap_base) + last_free_page*4096),0);
}
+ free_pages_lock=0;
return((void *)(page_address(first_page)+orig_first_page_bytes_used));
}
@@ -951,6 +963,7 @@
int num_pages;
int large = !alloc_region && (nbytes >= large_object_size);
+ gc_assert(free_pages_lock);
/* Search for a contiguous free space of at least nbytes. If it's a
large object then align it on a page boundary by searching for a
free page. */
@@ -2088,7 +2101,7 @@
search_read_only_space(lispobj *pointer)
{
lispobj* start = (lispobj*)READ_ONLY_SPACE_START;
- lispobj* end = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER);
+ lispobj* end = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0);
if ((pointer < start) || (pointer >= end))
return NULL;
return (search_space(start, (pointer+2)-start, pointer));
@@ -2098,7 +2111,7 @@
search_static_space(lispobj *pointer)
{
lispobj* start = (lispobj*)STATIC_SPACE_START;
- lispobj* end = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER);
+ lispobj* end = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER,0);
if ((pointer < start) || (pointer >= end))
return NULL;
return (search_space(start, (pointer+2)-start, pointer));
@@ -2163,7 +2176,10 @@
* (2) Perhaps find some other hack to protect against this, e.g.
* recording the result of the last call to allocate-lisp-memory,
* and returning true from this function when *pointer is
- * a reference to that result. */
+ * a reference to that result.
+ *
+ * (surely pseudo-atomic is supposed to be used for exactly this?)
+ */
switch (lowtag_of((lispobj)pointer)) {
case FUN_POINTER_LOWTAG:
/* Start_addr should be the enclosing code object, or a closure
@@ -3231,7 +3247,7 @@
int is_in_dynamic_space = (find_page_index((void*)start) != -1);
int is_in_readonly_space =
(READ_ONLY_SPACE_START <= (unsigned)start &&
- (unsigned)start < SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
+ (unsigned)start < SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0));
while (words > 0) {
size_t count = 1;
@@ -3241,10 +3257,10 @@
int page_index = find_page_index((void*)thing);
int to_readonly_space =
(READ_ONLY_SPACE_START <= thing &&
- thing < SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
+ thing < SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0));
int to_static_space =
(STATIC_SPACE_START <= thing &&
- thing < SymbolValue(STATIC_SPACE_FREE_POINTER));
+ thing < SymbolValue(STATIC_SPACE_FREE_POINTER,0));
/* Does it point to the dynamic space? */
if (page_index != -1) {
@@ -3439,18 +3455,20 @@
* to grep for all foo_size and rename the appropriate ones to
* foo_count. */
int read_only_space_size =
- (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER)
+ (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0)
- (lispobj*)READ_ONLY_SPACE_START;
int static_space_size =
- (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER)
+ (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER,0)
- (lispobj*)STATIC_SPACE_START;
+ struct thread *th;
+ for_each_thread(th) {
int binding_stack_size =
- (lispobj*)SymbolValue(BINDING_STACK_POINTER)
- - (lispobj*)BINDING_STACK_START;
-
+ (lispobj*)SymbolValue(BINDING_STACK_POINTER,th)
+ - (lispobj*)th->binding_stack_start;
+ verify_space(th->binding_stack_start, binding_stack_size);
+ }
verify_space((lispobj*)READ_ONLY_SPACE_START, read_only_space_size);
verify_space((lispobj*)STATIC_SPACE_START , static_space_size);
- verify_space((lispobj*)BINDING_STACK_START , binding_stack_size);
}
static void
@@ -3588,7 +3606,7 @@
unsigned long bytes_freed;
unsigned long i;
unsigned long static_space_size;
-
+ struct thread *th;
gc_assert(generation <= (NUM_GENERATIONS-1));
/* The oldest generation can't be raised. */
@@ -3630,11 +3648,33 @@
* be un-protected anyway before unmapping later. */
unprotect_oldspace();
- /* Scavenge the stack's conservative roots. */
- {
+ /* Scavenge the stacks' conservative roots. */
+ for_each_thread(th) {
void **ptr;
- for (ptr = (void **)CONTROL_STACK_END - 1;
+#ifdef LISP_FEATURE_SB_THREAD
+ struct user_regs_struct regs;
+ if(ptrace(PTRACE_GETREGS,th->pid,0,®s)){
+ /* probably doesn't exist any more. */
+ fprintf(stderr,"child pid %d, %s\n",th->pid,strerror(errno));
+ perror("PTRACE_GETREGS");
+ }
+ preserve_pointer(regs.ebx);
+ preserve_pointer(regs.ecx);
+ preserve_pointer(regs.edx);
+ preserve_pointer(regs.esi);
+ preserve_pointer(regs.edi);
+ preserve_pointer(regs.ebp);
+ preserve_pointer(regs.eax);
+#endif
+ for (ptr = ((void **)
+ ((void *)th->control_stack_start
+ + THREAD_CONTROL_STACK_SIZE)
+ -1);
+#ifdef LISP_FEATURE_SB_THREAD
+ ptr > regs.esp;
+#else
ptr > (void **)&raise;
+#endif
ptr--) {
preserve_pointer(*ptr);
}
@@ -3656,18 +3696,31 @@
/* Scavenge the Lisp functions of the interrupt handlers, taking
* care to avoid SIG_DFL and SIG_IGN. */
+ for_each_thread(th) {
+ struct interrupt_data *data=th->interrupt_data;
for (i = 0; i < NSIG; i++) {
- union interrupt_handler handler = interrupt_handlers[i];
+ union interrupt_handler handler = data->interrupt_handlers[i];
if (!ARE_SAME_HANDLER(handler.c, SIG_IGN) &&
!ARE_SAME_HANDLER(handler.c, SIG_DFL)) {
- scavenge((lispobj *)(interrupt_handlers + i), 1);
+ scavenge((lispobj *)(data->interrupt_handlers + i), 1);
+ }
+ }
+ }
+ /* Scavenge the binding stacks. */
+ {
+ struct thread *th;
+ for_each_thread(th) {
+ long len= (lispobj *)SymbolValue(BINDING_STACK_POINTER,th) -
+ th->binding_stack_start;
+ scavenge((lispobj *) th->binding_stack_start,len);
+#ifdef LISP_FEATURE_SB_THREAD
+ /* do the tls as well */
+ len=fixnum_value(SymbolValue(FREE_TLS_INDEX,0)) -
+ (sizeof (struct thread))/(sizeof (lispobj));
+ scavenge((lispobj *) (th+1),len);
+#endif
}
}
-
- /* Scavenge the binding stack. */
- scavenge((lispobj *) BINDING_STACK_START,
- (lispobj *)SymbolValue(BINDING_STACK_POINTER) -
- (lispobj *)BINDING_STACK_START);
/* The original CMU CL code had scavenge-read-only-space code
* controlled by the Lisp-level variable
@@ -3690,7 +3743,7 @@
/* Scavenge static space. */
static_space_size =
- (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER) -
+ (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0) -
(lispobj *)STATIC_SPACE_START;
if (gencgc_verbose > 1) {
FSHOW((stderr,
@@ -3801,7 +3854,7 @@
last_free_page = last_page+1;
SetSymbolValue(ALLOCATION_POINTER,
- (lispobj)(((char *)heap_base) + last_free_page*4096));
+ (lispobj)(((char *)heap_base) + last_free_page*4096),0);
return 0; /* dummy value: return something ... */
}
@@ -4005,7 +4058,7 @@
gc_set_region_empty(&unboxed_region);
last_free_page = 0;
- SetSymbolValue(ALLOCATION_POINTER, (lispobj)((char *)heap_base));
+ SetSymbolValue(ALLOCATION_POINTER, (lispobj)((char *)heap_base),0);
if (verify_after_free_heap) {
/* Check whether purify has left any bad pointers. */
@@ -4076,7 +4129,7 @@
{
int page = 0;
int addr = DYNAMIC_SPACE_START;
- int alloc_ptr = SymbolValue(ALLOCATION_POINTER);
+ int alloc_ptr = SymbolValue(ALLOCATION_POINTER,0);
/* Initialize the first region. */
do {
@@ -4120,18 +4173,20 @@
char *
alloc(int nbytes)
{
- struct alloc_region *region= &boxed_region;
+ struct thread *th=arch_os_get_current_thread();
+ struct alloc_region *region=
+ th ? &(th->alloc_region) : &boxed_region;
void *new_obj;
void *new_free_pointer;
/* Check for alignment allocation problems. */
gc_assert((((unsigned)region->free_pointer & 0x7) == 0)
&& ((nbytes & 0x7) == 0));
- /* At this point we should either be in pseudo-atomic, or early
- * enough in cold initn that interrupts are not yet enabled anyway.
- * It would be nice to assert same.
- */
- gc_assert(SymbolValue(PSEUDO_ATOMIC_ATOMIC));
+ if(all_threads)
+ /* there are a few places in the C code that allocate data in the
+ * heap before Lisp starts. This is before interrupts are enabled,
+ * so we don't need to check for pseudo-atomic */
+ gc_assert(SymbolValue(PSEUDO_ATOMIC_ATOMIC,th));
/* maybe we can do this quickly ... */
new_free_pointer = region->free_pointer + nbytes;
@@ -4149,7 +4204,7 @@
/* set things up so that GC happens when we finish the PA
* section. */
maybe_gc_pending=1;
- SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1));
+ SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1),th);
}
new_obj = gc_alloc_with_region(nbytes,0,region,0);
return (new_obj);
@@ -4260,6 +4315,9 @@
gc_alloc_update_all_page_tables(void)
{
/* Flush the alloc regions updating the tables. */
+ struct thread *th;
+ for_each_thread(th)
+ gc_alloc_update_page_tables(0, &th->alloc_region);
gc_alloc_update_page_tables(1, &unboxed_region);
gc_alloc_update_page_tables(0, &boxed_region);
}
Index: gencgc.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/gencgc.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- gencgc.h 6 Aug 2002 11:46:33 -0000 1.5
+++ gencgc.h 2 Apr 2003 11:15:21 -0000 1.6
@@ -16,6 +16,8 @@
#ifndef _GENCGC_H_
#define _GENCGC_H_
+#include "genesis/code.h"
+
void gc_free_heap(void);
inline int find_page_index(void *);
inline void *page_address(int);
@@ -81,22 +83,6 @@
#define NUM_PAGES ((DYNAMIC_SPACE_SIZE+4095)/4096)
extern struct page page_table[NUM_PAGES];
-/* Abstract out the data for an allocation region allowing a single
- * routine to be used for allocation and closing. */
-struct alloc_region {
-
- /* These two are needed for quick allocation. */
- void *free_pointer;
- void *end_addr; /* pointer to the byte after the last usable byte */
-
- /* These are needed when closing the region. */
- int first_page;
- int last_page;
- void *start_addr;
-};
-
-extern struct alloc_region boxed_region;
-extern struct alloc_region unboxed_region;
void gencgc_pickup_dynamic(void);
@@ -105,5 +91,6 @@
int update_x86_dynamic_space_free_pointer(void);
void gc_alloc_update_page_tables(int unboxed,
struct alloc_region *alloc_region);
-
+void gc_alloc_update_all_page_tables(void);
+void gc_set_region_empty(struct alloc_region *region);
#endif _GENCGC_H_
Index: globals.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/globals.c,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- globals.c 27 Feb 2003 15:19:52 -0000 1.12
+++ globals.c 2 Apr 2003 11:15:21 -0000 1.13
@@ -59,16 +59,7 @@
/* Set foreign function call active. */
foreign_function_call_active = 1;
-
- /* Initialize the current Lisp state. */
-#ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD
- current_control_stack_pointer = (lispobj *)CONTROL_STACK_END;
-#else
- current_control_stack_pointer = (lispobj *)CONTROL_STACK_START;
-#endif
-
- current_control_frame_pointer = (lispobj *)0;
-#ifndef BINDING_STACK_POINTER
- current_binding_stack_pointer = native_pointer(BINDING_STACK_START);
+#ifdef LISP_FEATURE_SB_THREAD
+ parent_pid=getpid();
#endif
}
Index: globals.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/globals.h,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- globals.h 7 Jun 2002 01:54:42 -0000 1.13
+++ globals.h 2 Apr 2003 11:15:21 -0000 1.14
@@ -14,9 +14,12 @@
#ifndef LANGUAGE_ASSEMBLY
+#include <sys/types.h>
+#include <unistd.h>
#include "runtime.h"
extern int foreign_function_call_active;
+extern boolean stop_the_world;
extern lispobj *current_control_stack_pointer;
extern lispobj *current_control_frame_pointer;
@@ -31,6 +34,7 @@
#endif
extern lispobj *current_dynamic_space;
+extern pid_t parent_pid;
extern void globals_init(void);
Index: interrupt.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/interrupt.c,v
retrieving revision 1.33
retrieving revision 1.34
diff -u -d -r1.33 -r1.34
--- interrupt.c 27 Feb 2003 00:50:01 -0000 1.33
+++ interrupt.c 2 Apr 2003 11:15:21 -0000 1.34
@@ -31,10 +31,8 @@
#include "alloc.h"
#include "dynbind.h"
#include "interr.h"
-#include "genesis/simple-fun.h"
#include "genesis/fdefn.h"
-#include "genesis/symbol.h"
-#include "genesis/static-symbols.h"
+#include "genesis/simple-fun.h"
void sigaddset_blockable(sigset_t *s)
{
@@ -64,7 +62,7 @@
* becomes 'yes'.) */
boolean internal_errors_enabled = 0;
-os_context_t *lisp_interrupt_contexts[MAX_INTERRUPTS];
+struct interrupt_data * global_interrupt_data;
/* As far as I can tell, what's going on here is:
*
@@ -93,16 +91,6 @@
* - WHN 20000728, dan 20010128 */
-void (*interrupt_low_level_handlers[NSIG]) (int, siginfo_t*, void*) = {0};
-union interrupt_handler interrupt_handlers[NSIG];
-
-/* signal number, siginfo_t, and old mask information for pending signal
- *
- * pending_signal=0 when there is no pending signal. */
-static int pending_signal = 0;
-static siginfo_t pending_info;
-static sigset_t pending_mask;
-
boolean maybe_gc_pending = 0;
/*
@@ -110,7 +98,7 @@
*/
void
-build_fake_control_stack_frames(os_context_t *context)
+build_fake_control_stack_frames(struct thread *th,os_context_t *context)
{
#ifndef LISP_FEATURE_X86
@@ -164,6 +152,7 @@
fake_foreign_function_call(os_context_t *context)
{
int context_index;
+ struct thread *thread=arch_os_get_current_thread();
/* Get current Lisp state from context. */
#ifdef reg_ALLOC
@@ -180,24 +169,21 @@
(lispobj *)(*os_context_register_addr(context, reg_BSP));
#endif
- build_fake_control_stack_frames(context);
+ build_fake_control_stack_frames(thread,context);
/* Do dynamic binding of the active interrupt context index
* and save the context in the context array. */
- context_index = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
- /* FIXME: Ick! Why use abstract "make_fixnum" in some places if
- * you're going to convert from fixnum by bare >>2 in other
- * places? Use fixnum_value(..) here, and look for other places
- * which do bare >> and << for fixnum_value and make_fixnum. */
-
+ context_index =
+ fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread));
+
if (context_index >= MAX_INTERRUPTS) {
lose("maximum interrupt nesting depth (%d) exceeded", MAX_INTERRUPTS);
}
bind_variable(FREE_INTERRUPT_CONTEXT_INDEX,
- make_fixnum(context_index + 1));
+ make_fixnum(context_index + 1),thread);
- lisp_interrupt_contexts[context_index] = context;
+ thread->interrupt_contexts[context_index] = context;
/* no longer in Lisp now */
foreign_function_call_active = 1;
@@ -206,6 +192,7 @@
void
undo_fake_foreign_function_call(os_context_t *context)
{
+ struct thread *thread=arch_os_get_current_thread();
/* Block all blockable signals. */
sigset_t block;
sigemptyset(&block);
@@ -222,7 +209,7 @@
* perhaps yes, unbind_to_here() really would be clearer and less
* fragile.. */
/* dan (2001.08.10) thinks the above supposition is probably correct */
- unbind();
+ unbind(thread);
#ifdef reg_ALLOC
/* Put the dynamic space free pointer back into the context. */
@@ -281,14 +268,20 @@
void
interrupt_handle_pending(os_context_t *context)
{
+ struct thread *thread;
+ struct interrupt_data *data;
+
#ifndef __i386__
boolean were_in_lisp = !foreign_function_call_active;
#endif
-
- SetSymbolValue(INTERRUPT_PENDING, NIL);
+#ifdef LISP_FEATURE_SB_THREAD
+ while(stop_the_world) kill(getpid(),SIGSTOP);
+#endif
+ thread=arch_os_get_current_thread();
+ data=thread->interrupt_data;
+ SetSymbolValue(INTERRUPT_PENDING, NIL,thread);
if (maybe_gc_pending) {
- maybe_gc_pending = 0;
#ifndef __i386__
if (were_in_lisp)
#endif
@@ -332,12 +325,12 @@
memcpy(os_context_sigmask_addr(context), &pending_mask,
4 /* sizeof(sigset_t) */ );
#endif
- sigemptyset(&pending_mask);
- if (pending_signal) {
- int signal = pending_signal;
+ sigemptyset(&data->pending_mask);
+ if (data->pending_signal) {
+ int signal = data->pending_signal;
siginfo_t info;
- memcpy(&info, &pending_info, sizeof(siginfo_t));
- pending_signal = 0;
+ memcpy(&info, &data->pending_info, sizeof(siginfo_t));
+ data->pending_signal = 0;
interrupt_handle_now(signal, &info, context);
}
}
@@ -361,6 +354,7 @@
interrupt_handle_now(int signal, siginfo_t *info, void *void_context)
{
os_context_t *context = (os_context_t*)void_context;
+ struct thread *thread=arch_os_get_current_thread();
#ifndef __i386__
boolean were_in_lisp;
#endif
@@ -372,7 +366,7 @@
delivered we appear to have a null FPU control word. */
os_restore_fp_control(context);
#endif
- handler = interrupt_handlers[signal];
+ handler = thread->interrupt_data->interrupt_handlers[signal];
if (ARE_SAME_HANDLER(handler.c, SIG_IGN)) {
return;
@@ -445,50 +439,40 @@
}
static void
+store_signal_data_for_later (struct interrupt_data *data, int signal,
+ siginfo_t *info, os_context_t *context)
+{
+ data->pending_signal = signal;
+ memcpy(&(data->pending_info), info, sizeof(siginfo_t));
+ memcpy(&(data->pending_mask),
+ os_context_sigmask_addr(context),
+ sizeof(sigset_t));
+ sigaddset_blockable(os_context_sigmask_addr(context));
+}
+
+
+static void
maybe_now_maybe_later(int signal, siginfo_t *info, void *void_context)
{
os_context_t *context = arch_os_get_context(&void_context);
-
+ struct thread *thread=arch_os_get_current_thread();
+ struct interrupt_data *data=thread->interrupt_data;
#ifdef LISP_FEATURE_LINUX
os_restore_fp_control(context);
#endif
-
/* see comments at top of code/signal.lisp for what's going on here
* with INTERRUPTS_ENABLED/INTERRUPT_HANDLE_NOW
*/
- if (SymbolValue(INTERRUPTS_ENABLED) == NIL) {
-
- /* FIXME: This code is exactly the same as the code in the
- * other leg of the if(..), and should be factored out into
- * a shared function. */
- pending_signal = signal;
- memcpy(&pending_info, info, sizeof(siginfo_t));
- memcpy(&pending_mask,
- os_context_sigmask_addr(context),
- sizeof(sigset_t));
- sigaddset_blockable(os_context_sigmask_addr(context));
- SetSymbolValue(INTERRUPT_PENDING, T);
-
+ if (SymbolValue(INTERRUPTS_ENABLED,thread) == NIL) {
+ store_signal_data_for_later(data,signal,info,context);
+ SetSymbolValue(INTERRUPT_PENDING, T,thread);
} else if (
#ifndef __i386__
(!foreign_function_call_active) &&
#endif
arch_pseudo_atomic_atomic(context)) {
-
- /* FIXME: It would probably be good to replace these bare
- * memcpy(..) calls with calls to cpy_siginfo_t and
- * cpy_sigset_t, so that we only have to get the sizeof
- * expressions right in one place, and after that static type
- * checking takes over. */
- pending_signal = signal;
- memcpy(&pending_info, info, sizeof(siginfo_t));
- memcpy(&pending_mask,
- os_context_sigmask_addr(context),
- sizeof(sigset_t));
- sigaddset_blockable(os_context_sigmask_addr(context));
-
+ store_signal_data_for_later(data,signal,info,context);
arch_set_pseudo_atomic_interrupted(context);
-
} else {
interrupt_handle_now(signal, info, context);
}
@@ -525,16 +509,17 @@
boolean handle_control_stack_guard_triggered(os_context_t *context,void *addr)
{
+ struct thread *th=arch_os_get_current_thread();
/* note the os_context hackery here. When the signal handler returns,
* it won't go back to what it was doing ... */
- if(addr>=(void *)CONTROL_STACK_GUARD_PAGE &&
- addr<(void *)(CONTROL_STACK_GUARD_PAGE+os_vm_page_size)) {
+ if(addr>=(void *)CONTROL_STACK_GUARD_PAGE(th) &&
+ addr<(void *)(CONTROL_STACK_GUARD_PAGE(th)+os_vm_page_size)) {
void *fun;
void *code;
-
+ /* fprintf(stderr, "hit end of control stack\n"); */
/* we hit the end of the control stack. disable protection
* temporarily so the error handler has some headroom */
- protect_control_stack_guard_page(0);
+ protect_control_stack_guard_page(th->pid,0L);
fun = (void *)
native_pointer((lispobj) SymbolFunction(CONTROL_STACK_EXHAUSTED_ERROR));
@@ -542,7 +527,7 @@
/* Build a stack frame showing `interrupted' so that the
* user's backtrace makes (as much) sense (as usual) */
- build_fake_control_stack_frames(context);
+ build_fake_control_stack_frames(th,context);
/* signal handler will "return" to this error-causing function */
*os_context_pc_addr(context) = code;
#ifdef LISP_FEATURE_X86
@@ -640,46 +625,29 @@
* noise to install handlers
*/
-/*
- * what low-level signal handlers looked like before
- * undoably_install_low_level_interrupt_handler() got involved
- */
-struct low_level_signal_handler_state {
- int was_modified;
- void (*handler)(int, siginfo_t*, void*);
-} old_low_level_signal_handler_states[NSIG];
+/* SBCL used to have code to restore signal handlers on exit, which
+ * has been removed from the threaded version until we decide: exit of
+ * _what_ ? */
+
+/* SBCL comment: The "undoably" aspect is because we also arrange with
+ * atexit() for the handler to be restored to its old value. This is
+ * for tidiness: it shouldn't matter much ordinarily, but it does
+ * remove a window where e.g. memory fault signals (SIGSEGV or SIGBUS,
+ * which in ordinary operation of SBCL are sent to the generational
+ * garbage collector, then possibly onward to Lisp code) or SIGINT
+ * (which is ordinarily passed to Lisp code) could otherwise be
+ * handled bizarrely/brokenly because the Lisp code would try to deal
+ * with them using machinery (like stream output buffers) which has
+ * already been dismantled. */
+
+/* I'm not sure (a) whether this is a real concern, (b) how it helps
+ anyway */
void
uninstall_low_level_interrupt_handlers_atexit(void)
{
- int signal;
- for (signal = 0; signal < NSIG; ++signal) {
- struct low_level_signal_handler_state
- *old_low_level_signal_handler_state =
- old_low_level_signal_handler_states + signal;
- if (old_low_level_signal_handler_state->was_modified) {
- struct sigaction sa;
- sa.sa_sigaction = old_low_level_signal_handler_state->handler;
- sigemptyset(&sa.sa_mask);
- sa.sa_flags = SA_SIGINFO | SA_RESTART;
- sigaction(signal, &sa, NULL);
- }
- }
}
-/* Undoably install a special low-level handler for signal; or if
- * handler is SIG_DFL, remove any special handling for signal.
- *
- * The "undoably" aspect is because we also arrange with atexit() for
- * the handler to be restored to its old value. This is for tidiness:
- * it shouldn't matter much ordinarily, but it does remove a window
- * where e.g. memory fault signals (SIGSEGV or SIGBUS, which in
- * ordinary operation of SBCL are sent to the generational garbage
- * collector, then possibly onward to Lisp code) or SIGINT (which is
- * ordinarily passed to Lisp code) could otherwise be handled
- * bizarrely/brokenly because the Lisp code would try to deal with
- * them using machinery (like stream output buffers) which has already
- * been dismantled. */
void
undoably_install_low_level_interrupt_handler (int signal,
void handler(int,
@@ -687,8 +655,9 @@
void*))
{
struct sigaction sa;
- struct low_level_signal_handler_state *old_low_level_signal_handler_state =
- old_low_level_signal_handler_states + signal;
+ struct thread *th=arch_os_get_current_thread();
+ struct interrupt_data *data=
+ th ? th->interrupt_data : global_interrupt_data;
if (0 > signal || signal >= NSIG) {
lose("bad signal number %d", signal);
@@ -699,31 +668,11 @@
sigaddset_blockable(&sa.sa_mask);
sa.sa_flags = SA_SIGINFO | SA_RESTART;
#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
- /* Signal handlers are run on the control stack, so if it is exhausted
- * we had better use an alternate stack for whatever signal tells us
- * we've exhausted it */
- if(signal==SIG_MEMORY_FAULT) {
- stack_t sigstack;
- sigstack.ss_sp=(void *) ALTERNATE_SIGNAL_STACK_START;
- sigstack.ss_flags=0;
- sigstack.ss_size = SIGSTKSZ;
- sigaltstack(&sigstack,0);
- sa.sa_flags|=SA_ONSTACK;
- }
+ if(signal==SIG_MEMORY_FAULT) sa.sa_flags|= SA_ONSTACK;
#endif
- /* In the case of interrupt handlers which are modified more than
- * once, we only save the original unmodified copy. */
- if (!old_low_level_signal_handler_state->was_modified) {
- struct sigaction *old_handler =
- (struct sigaction*) &old_low_level_signal_handler_state->handler;
- old_low_level_signal_handler_state->was_modified = 1;
- sigaction(signal, &sa, old_handler);
- } else {
sigaction(signal, &sa, NULL);
- }
-
- interrupt_low_level_handlers[signal] =
+ data->interrupt_low_level_handlers[signal] =
(ARE_SAME_HANDLER(handler, SIG_DFL) ? 0 : handler);
}
@@ -734,6 +683,9 @@
struct sigaction sa;
sigset_t old, new;
union interrupt_handler oldhandler;
+ struct thread *th=arch_os_get_current_thread();
+ struct interrupt_data *data=
+ th ? th->interrupt_data : global_interrupt_data;
FSHOW((stderr, "/entering POSIX install_handler(%d, ..)\n", signal));
@@ -746,7 +698,7 @@
FSHOW((stderr, "/interrupt_low_level_handlers[signal]=%d\n",
interrupt_low_level_handlers[signal]));
- if (interrupt_low_level_handlers[signal]==0) {
+ if (data->interrupt_low_level_handlers[signal]==0) {
if (ARE_SAME_HANDLER(handler, SIG_DFL) ||
ARE_SAME_HANDLER(handler, SIG_IGN)) {
sa.sa_sigaction = handler;
@@ -759,12 +711,11 @@
sigemptyset(&sa.sa_mask);
sigaddset_blockable(&sa.sa_mask);
sa.sa_flags = SA_SIGINFO | SA_RESTART;
-
sigaction(signal, &sa, NULL);
}
- oldhandler = interrupt_handlers[signal];
- interrupt_handlers[signal].c = handler;
+ oldhandler = data->interrupt_handlers[signal];
+ data->interrupt_handlers[signal].c = handler;
sigprocmask(SIG_SETMASK, &old, 0);
@@ -774,18 +725,15 @@
}
void
-interrupt_init(void)
+interrupt_init()
{
int i;
-
SHOW("entering interrupt_init()");
-
- /* Set up for recovery from any installed low-level handlers. */
- atexit(&uninstall_low_level_interrupt_handlers_atexit);
+ global_interrupt_data=calloc(sizeof(struct interrupt_data), 1);
/* Set up high level handler information. */
for (i = 0; i < NSIG; i++) {
- interrupt_handlers[i].c =
+ global_interrupt_data->interrupt_handlers[i].c =
/* (The cast here blasts away the distinction between
* SA_SIGACTION-style three-argument handlers and
* signal(..)-style one-argument handlers, which is OK
Index: interrupt.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/interrupt.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- interrupt.h 23 Jul 2002 17:22:37 -0000 1.5
+++ interrupt.h 2 Apr 2003 11:15:21 -0000 1.6
@@ -19,16 +19,26 @@
* Note: In CMU CL, this was 4096, but there was no explanation given,
* and it's hard to see why we'd need that many nested interrupts, so
* I've scaled it back to see what happens. -- WHN 20000730 */
-#define MAX_INTERRUPTS 256
-
-extern os_context_t *lisp_interrupt_contexts[MAX_INTERRUPTS];
+#define MAX_INTERRUPTS 8
union interrupt_handler {
lispobj lisp;
void (*c)(int, siginfo_t*, void*);
};
-extern void interrupt_init(void);
+struct interrupt_data {
+ void (*interrupt_low_level_handlers[NSIG]) (int, siginfo_t*, void*) ;
+ union interrupt_handler interrupt_handlers[NSIG];
+
+ /* signal number, siginfo_t, and old mask information for pending
+ * signal. pending_signal=0 when there is no pending signal. */
+ int pending_signal ;
+ siginfo_t pending_info;
+ sigset_t pending_mask;
+};
+
+
+extern void interrupt_init();
extern void fake_foreign_function_call(os_context_t* context);
extern void undo_fake_foreign_function_call(os_context_t* context);
extern void interrupt_handle_now(int, siginfo_t*, void*);
Index: ldso-stubs.S
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/ldso-stubs.S,v
retrieving revision 1.16
retrieving revision 1.17
diff -u -d -r1.16 -r1.17
--- ldso-stubs.S 7 Jun 2002 12:14:56 -0000 1.16
+++ ldso-stubs.S 2 Apr 2003 11:15:21 -0000 1.17
@@ -165,6 +165,7 @@
LDSO_STUBIFY(send)
LDSO_STUBIFY(setitimer)
LDSO_STUBIFY(setpgrp)
+ LDSO_STUBIFY(setsid)
#if !defined(SVR4)
LDSO_STUBIFY(sigsetmask)
#endif
Index: linux-os.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/linux-os.c,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -d -r1.17 -r1.18
--- linux-os.c 6 Aug 2002 11:46:33 -0000 1.17
+++ linux-os.c 2 Apr 2003 11:15:21 -0000 1.18
@@ -42,6 +42,7 @@
#include <unistd.h>
#include "validate.h"
+#include "thread.h"
size_t os_vm_page_size;
#include "gc.h"
@@ -228,12 +229,19 @@
boolean
is_valid_lisp_addr(os_vm_address_t addr)
{
- return
- in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) ||
+ struct thread *th;
+ if(in_range_p(addr, READ_ONLY_SPACE_START, READ_ONLY_SPACE_SIZE) ||
in_range_p(addr, STATIC_SPACE_START , STATIC_SPACE_SIZE) ||
- in_range_p(addr, DYNAMIC_SPACE_START , DYNAMIC_SPACE_SIZE) ||
- in_range_p(addr, CONTROL_STACK_START , CONTROL_STACK_SIZE) ||
- in_range_p(addr, BINDING_STACK_START , BINDING_STACK_SIZE);
+ in_range_p(addr, DYNAMIC_SPACE_START , DYNAMIC_SPACE_SIZE))
+ return 1;
+ for_each_thread(th) {
+ if(in_range_p(addr, th->control_stack_start,
+ THREAD_CONTROL_STACK_SIZE) ||
+ in_range_p(addr, th->binding_stack_start,
+ BINDING_STACK_SIZE))
+ return 1;
+ }
+ return 0;
}
/*
@@ -289,10 +297,19 @@
}
#endif
+void sigcont_handler(int signal, siginfo_t *info, void *void_context)
+{
+ /* we need to have a handler installed for this signal so that
+ * sigwaitinfo() for it actually returns at the appropriate time
+ */
+}
+
void
os_install_interrupt_handlers(void)
{
undoably_install_low_level_interrupt_handler(SIG_MEMORY_FAULT,
sigsegv_handler);
+ undoably_install_low_level_interrupt_handler(SIGCONT,
+ sigcont_handler);
}
Index: monitor.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/monitor.c,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -d -r1.19 -r1.20
--- monitor.c 15 Mar 2003 19:01:35 -0000 1.19
+++ monitor.c 2 Apr 2003 11:15:22 -0000 1.20
@@ -33,6 +33,7 @@
#include "globals.h"
#include "lispregs.h"
#include "interrupt.h"
+#include "thread.h"
#include "genesis/static-symbols.h"
#include "genesis/primitive-objects.h"
@@ -178,6 +179,7 @@
#if !defined(__i386__)
printf("BSP\t=\t0x%08X\n", (unsigned long)current_binding_stack_pointer);
#endif
+#if 0
#ifdef __i386__
printf("BSP\t=\t0x%08lx\n",
(unsigned long)SymbolValue(BINDING_STACK_POINTER));
@@ -196,7 +198,7 @@
(unsigned long)SymbolValue(STATIC_SPACE_FREE_POINTER));
printf("RDONLY\t=\t0x%08lx\n",
(unsigned long)SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
-
+#endif /* 0 */
#ifdef MIPS
printf("FLAGS\t=\t0x%08x\n", current_flags_register);
#endif
@@ -332,8 +334,9 @@
print_context_cmd(char **ptr)
{
int free;
+ struct thread *thread=arch_os_get_current_thread();
- free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
+ free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)>>2;
if (more_p(ptr)) {
int index;
@@ -343,7 +346,7 @@
if ((index >= 0) && (index < free)) {
printf("There are %d interrupt contexts.\n", free);
printf("printing context %d\n", index);
- print_context(lisp_interrupt_contexts[index]);
+ print_context(thread->interrupt_contexts[index]);
} else {
printf("There aren't that many/few contexts.\n");
printf("There are %d interrupt contexts.\n", free);
@@ -354,7 +357,7 @@
else {
printf("There are %d interrupt contexts.\n", free);
printf("printing context %d\n", free - 1);
- print_context(lisp_interrupt_contexts[free - 1]);
+ print_context(thread->interrupt_contexts[free - 1]);
}
}
}
@@ -378,8 +381,9 @@
catchers_cmd(char **ptr)
{
struct catch_block *catch;
+ struct thread *thread=arch_os_get_current_thread();
- catch = (struct catch_block *)SymbolValue(CURRENT_CATCH_BLOCK);
+ catch = (struct catch_block *)SymbolValue(CURRENT_CATCH_BLOCK,thread);
if (catch == NULL)
printf("There are no active catchers!\n");
Index: parse.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/parse.c,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- parse.c 27 Feb 2003 00:50:02 -0000 1.10
+++ parse.c 2 Apr 2003 11:15:22 -0000 1.11
@@ -29,6 +29,7 @@
#include "monitor.h"
#include "arch.h"
#include "search.h"
+#include "thread.h"
#include "genesis/simple-fun.h"
#include "genesis/fdefn.h"
@@ -248,7 +249,7 @@
/* Search static space. */
headerptr = (lispobj *)STATIC_SPACE_START;
count =
- (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER) -
+ (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0) -
(lispobj *)STATIC_SPACE_START;
if (search_for_symbol(name, &headerptr, &count)) {
*result = make_lispobj(headerptr,OTHER_POINTER_LOWTAG);
@@ -263,7 +264,7 @@
(lispobj *)DYNAMIC_SPACE_START;
#else
count =
- (lispobj *)SymbolValue(ALLOCATION_POINTER) -
+ (lispobj *)SymbolValue(ALLOCATION_POINTER,0) -
(lispobj *)DYNAMIC_SPACE_START;
#endif
if (search_for_symbol(name, &headerptr, &count)) {
@@ -307,6 +308,7 @@
lispobj parse_lispobj(ptr)
char **ptr;
{
+ struct thread *thread=arch_os_get_current_thread();
char *token = parse_token(ptr);
long pointer;
lispobj result;
@@ -320,14 +322,14 @@
int regnum;
os_context_t *context;
- free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2;
+ free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)>>2;
if (free == 0) {
printf("Variable ``%s'' is not valid -- there is no current interrupt context.\n", token);
throw_to_monitor();
}
- context = lisp_interrupt_contexts[free - 1];
+ context = thread->interrupt_contexts[free - 1];
regnum = parse_regnum(token);
if (regnum < 0) {
Index: print.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/print.c,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -d -r1.14 -r1.15
--- print.c 27 Feb 2003 15:19:53 -0000 1.14
+++ print.c 2 Apr 2003 11:15:22 -0000 1.15
@@ -30,9 +30,14 @@
#include "monitor.h"
#include "vars.h"
#include "os.h"
+#include "gencgc-alloc-region.h" /* genesis/thread.h needs this */
#include "genesis/static-symbols.h"
#include "genesis/primitive-objects.h"
+#include "genesis/static-symbols.h"
+
+
+
static int max_lines = 20, cur_lines = 0;
static int max_depth = 5, brief_depth = 2, cur_depth = 0;
static int max_length = 5;
@@ -413,7 +418,11 @@
* on the values in sbcl.h (or perhaps be generated automatically
* by GENESIS as part of sbcl.h). */
static char *symbol_slots[] = {"value: ", "unused: ",
- "plist: ", "name: ", "package: ", NULL};
+ "plist: ", "name: ", "package: ",
+#ifdef LISP_FEATURE_SB_THREAD
+ "tls-index: " ,
+#endif
+ NULL};
static char *ratio_slots[] = {"numer: ", "denom: ", NULL};
static char *complex_slots[] = {"real: ", "imag: ", NULL};
static char *code_slots[] = {"words: ", "entry: ", "debug: ", NULL};
Index: purify.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/purify.c,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -d -r1.22 -r1.23
--- purify.c 27 Feb 2003 15:19:53 -0000 1.22
+++ purify.c 2 Apr 2003 11:15:22 -0000 1.23
@@ -17,6 +17,9 @@
#include <sys/types.h>
#include <stdlib.h>
#include <strings.h>
+#include <sys/ptrace.h>
+#include <linux/user.h>
+#include <errno.h>
#include "runtime.h"
#include "os.h"
@@ -28,6 +31,7 @@
#include "interr.h"
#include "gc.h"
#include "gc-internal.h"
+#include "thread.h"
#include "genesis/primitive-objects.h"
#include "genesis/static-symbols.h"
@@ -1301,7 +1305,7 @@
lispobj *clean;
int count, i;
struct later *laters, *next;
-
+ struct thread *thread;
#ifdef PRINTNOISE
printf("[doing purification:");
@@ -1310,7 +1314,8 @@
#ifdef LISP_FEATURE_GENCGC
gc_alloc_update_all_page_tables();
#endif
- if (fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)) != 0) {
+ for_each_thread(thread)
+ if (fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)) != 0) {
/* FIXME: 1. What does this mean? 2. It shouldn't be reporting
* its error simply by a. printing a string b. to stdout instead
* of stderr. */
@@ -1321,23 +1326,42 @@
#if defined(__i386__)
dynamic_space_free_pointer =
- (lispobj*)SymbolValue(ALLOCATION_POINTER);
+ (lispobj*)SymbolValue(ALLOCATION_POINTER,0);
#endif
read_only_end = read_only_free =
- (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER);
+ (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0);
static_end = static_free =
- (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER);
+ (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0);
#ifdef PRINTNOISE
printf(" roots");
fflush(stdout);
#endif
+#if 0
+ /* can't do this unless the threads in question are suspended with
+ * ptrace
+ */
#if (defined(LISP_FEATURE_GENCGC) && defined(LISP_FEATURE_X86))
- gc_assert((lispobj *)CONTROL_STACK_END > ((&read_only_roots)+1));
- setup_i386_stack_scav(((&static_roots)-2), (lispobj *)CONTROL_STACK_END);
+ for_each_thread(thread) {
+ void **ptr;
+ struct user_regs_struct regs;
+ if(ptrace(PTRACE_GETREGS,thread->pid,0,®s)){
+ fprintf(stderr,"child pid %d, %s\n",thread->pid,strerror(errno));
+ lose("PTRACE_GETREGS");
+ }
+ setup_i386_stack_scav(regs.ebp,
+ ((void *)thread->control_stack_start)
+ +THREAD_CONTROL_STACK_SIZE);
+ }
+#endif
#endif
+ setup_i386_stack_scav(((&static_roots)-2),
+ ((void *)all_threads->control_stack_start)
+ +THREAD_CONTROL_STACK_SIZE);
+
+
pscav(&static_roots, 1, 0);
pscav(&read_only_roots, 1, 1);
@@ -1346,8 +1370,9 @@
printf(" handlers");
fflush(stdout);
#endif
- pscav((lispobj *) interrupt_handlers,
- sizeof(interrupt_handlers) / sizeof(lispobj),
+ pscav((lispobj *) all_threads->interrupt_data->interrupt_handlers,
+ sizeof(all_threads->interrupt_data->interrupt_handlers)
+ / sizeof(lispobj),
0);
#ifdef PRINTNOISE
@@ -1373,10 +1398,18 @@
(lispobj *)current_binding_stack_pointer - (lispobj *)BINDING_STACK_START,
0);
#else
- pscav( (lispobj *)BINDING_STACK_START,
- (lispobj *)SymbolValue(BINDING_STACK_POINTER) -
- (lispobj *)BINDING_STACK_START,
+ for_each_thread(thread) {
+ pscav( (lispobj *)thread->binding_stack_start,
+ (lispobj *)SymbolValue(BINDING_STACK_POINTER,thread) -
+ (lispobj *)thread->binding_stack_start,
+ 0);
+ pscav( (lispobj *) (thread+1),
+ fixnum_value(SymbolValue(FREE_TLS_INDEX,0)) -
+ (sizeof (struct thread))/(sizeof (lispobj)),
0);
+ }
+
+
#endif
/* The original CMU CL code had scavenge-read-only-space code
@@ -1449,8 +1482,8 @@
/* It helps to update the heap free pointers so that free_heap can
* verify after it's done. */
- SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free);
- SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free);
+ SetSymbolValue(READ_ONLY_SPACE_FREE_POINTER, (lispobj)read_only_free,0);
+ SetSymbolValue(STATIC_SPACE_FREE_POINTER, (lispobj)static_free,0);
#if !defined(__i386__)
dynamic_space_free_pointer = current_dynamic_space;
Index: runtime.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/runtime.c,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -d -r1.21 -r1.22
--- runtime.c 27 Feb 2003 00:50:03 -0000 1.21
+++ runtime.c 2 Apr 2003 11:15:23 -0000 1.22
@@ -17,11 +17,16 @@
#include <string.h>
#include <libgen.h>
#include <sys/types.h>
+#include <sys/wait.h>
#include <stdlib.h>
#include <unistd.h>
#include <sys/file.h>
#include <sys/param.h>
#include <sys/stat.h>
+#include <signal.h>
+#include <sys/ptrace.h>
+#include <sched.h>
+#include <errno.h>
#if defined(SVR4) || defined(__linux__)
#include <time.h>
@@ -44,6 +49,7 @@
#include "core.h"
#include "save.h"
#include "lispregs.h"
+#include "thread.h"
#include "genesis/static-symbols.h"
#include "genesis/symbol.h"
@@ -175,6 +181,10 @@
", SBCL_VERSION_STRING);
}
+int gc_thread_pid;
+FILE *stdlog;
+
+
int
main(int argc, char *argv[], char *envp[])
{
@@ -333,35 +343,150 @@
gc_initialize_pointers();
-#ifdef BINDING_STACK_POINTER
- SetSymbolValue(BINDING_STACK_POINTER, BINDING_STACK_START);
-#endif
-
interrupt_init();
-
arch_install_interrupt_handlers();
os_install_interrupt_handlers();
-#ifdef PSEUDO_ATOMIC_ATOMIC
- /* Turn on pseudo atomic for when we call into Lisp. */
- SHOW("turning on pseudo atomic");
- SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1));
- SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0));
-#endif
-
/* Convert remaining argv values to something that Lisp can grok. */
SHOW("setting POSIX-ARGV symbol value");
- SetSymbolValue(POSIX_ARGV, alloc_string_list(argv));
+ SetSymbolValue(POSIX_ARGV, alloc_string_list(argv),0);
/* Install a handler to pick off SIGINT until the Lisp system gets
* far enough along to install its own handler. */
sigint_init();
FSHOW((stderr, "/funcalling initial_function=0x%lx\n", initial_function));
- funcall0(initial_function);
+ create_thread(initial_function);
+ /* in a unithread build, create_thread never returns */
+#ifdef LISP_FEATURE_SB_THREAD
+ gc_thread_pid=getpid();
+ parent_loop();
+#endif
+}
- /* initial_function() is not supposed to return. */
- lose("Lisp initial_function gave up control.");
- return 0; /* dummy value: return something */
+static void parent_sighandler(int signum,siginfo_t *info, void *void_context)
+{
+#if 0
+ os_context_t *context = (os_context_t*)void_context;
+ fprintf(stderr,
+ "parent thread got signal %d from %d, maybe_gc_pending=%d\n",
+ signum, info->si_pid,
+ maybe_gc_pending);
+#endif
}
+#ifdef LISP_FEATURE_SB_THREAD
+static void parent_do_garbage_collect(void)
+{
+ int waiting_threads=0;
+ struct thread *th;
+ int status,p;
+
+ for_each_thread(th) {
+ if(ptrace(PTRACE_ATTACH,th->pid,0,0)) {
+ fprintf(stderr,"attaching to %d ...",th->pid);
+ perror("PTRACE_ATTACH");
+ }
+ else waiting_threads++;
+ }
+ stop_the_world=1;
+
+ do {
+ /* not sure if we have to wait for PTRACE_ATTACH to finish
+ * before we can send PTRACE_CONT, so let's play it safe
+ */
+ while(waiting_threads>0) {
+ if((p=waitpid(-1,&status, WUNTRACED|__WALL))>0) {
+ if(WIFEXITED(status) || WIFSIGNALED(status))
+ destroy_thread(find_thread_by_pid(p));
+ else {
+#if 0
+ fprintf(stderr, "wait returned pid %d signal %x\n",
+ p,WSTOPSIG(status));
+#endif
+ if(WSTOPSIG(status)==SIGTRAP) {
+ if(ptrace(PTRACE_CONT,p,0,SIGTRAP))
+ perror("PTRACE_CONT");
+ }
+ else waiting_threads--;
+ }
+ }
+ }
+ for_each_thread(th) {
+ if(SymbolTlValue(PSEUDO_ATOMIC_ATOMIC,th)) {
+ /* restart the child, setting *p-a-i* which will cause it
+ * to go into interrupt_handle_pending as soon as it's
+ * finished being pseudo_atomic. once there it will
+ * signal itself SIGSTOP, which will give us another
+ * event to wait for */
+ fprintf(stderr, "%d was pseudo-atomic, letting it resume \n",
+ th->pid);
+ SetTlSymbolValue(PSEUDO_ATOMIC_INTERRUPTED,1,th) ;
+ if(ptrace(PTRACE_CONT,th->pid,0,0))
+ perror("PTRACE_CONT");
+ waiting_threads++;
+ }
+ }
+ } while (waiting_threads>0);
+
+ collect_garbage(maybe_gc_pending-1);
+ maybe_gc_pending=0;
+ stop_the_world=0;
+ /* fprintf(stderr, "gc done\n"); */
+ for_each_thread(th)
+ if(ptrace(PTRACE_DETACH,th->pid,0,0))
+ perror("PTRACE_DETACH");
+}
+
+static void /* noreturn */ parent_loop(void)
+{
+ struct sigaction sa;
+ sigset_t sigset;
+ int status;
+
+ sigemptyset(&sigset);
+
+ sigaddset(&sigset, SIGALRM);
+ sigaddset(&sigset, SIGCHLD);
+ sigprocmask(SIG_UNBLOCK,&sigset,0);
+ sa.sa_handler=parent_sighandler;
+ sa.sa_mask=sigset;
+ sa.sa_flags=SA_SIGINFO;
+ sigaction(SIGALRM, &sa, 0);
+ sigaction(SIGCHLD, &sa, 0);
+
+ sigemptyset(&sigset);
+ sa.sa_handler=SIG_IGN;
+ sa.sa_mask=sigset;
+ sa.sa_flags=0;
+ sigaction(SIGINT, &sa, 0);
+
+ while(all_threads) {
+ pid_t pid=0;
+ while(pid=waitpid(-1,&status,__WALL|WUNTRACED)) {
+ struct thread *th;
+ fprintf(stderr,"waitpid pid %d\n",pid);
+ if(pid==-1) {
+ if(errno == EINTR) {
+ if(maybe_gc_pending) parent_do_garbage_collect();
+ continue;
+ }
+ if(errno == ECHILD) break;
+ fprintf(stderr,"waitpid: %s\n",strerror(errno));
+ continue;
+ }
+ th=find_thread_by_pid(pid);
+ if(!th) continue;
+ if(WIFEXITED(status) || WIFSIGNALED(status)) {
+ fprintf(stderr,"waitpid : child %d %x exited \n", pid,th);
+ destroy_thread(th);
+ /* FIXME arrange to call or fake (free-mutex *session-lock*)
+ * if necessary */
+ if(!all_threads) break;
+ }
+ }
+ }
+ exit(WEXITSTATUS(status));
+}
+
+#endif
Index: runtime.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/runtime.h,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- runtime.h 6 Aug 2002 11:46:33 -0000 1.12
+++ runtime.h 2 Apr 2003 11:15:23 -0000 1.13
@@ -102,19 +102,15 @@
/* Too bad ANSI C doesn't define "bool" as C++ does.. */
typedef int boolean;
-/* FIXME: There seems to be no reason that SymbolValue, SetSymbolValue,
- * and SymbolFunction can't be defined as (possibly inline) functions
- * instead of macros. */
-
-#define SymbolValue(sym) \
- (((struct symbol *)((sym)-OTHER_POINTER_LOWTAG))->value)
-#define SetSymbolValue(sym,val) \
- (((struct symbol *)((sym)-OTHER_POINTER_LOWTAG))->value = (val))
+/* FIXME: There seems to be no reason that SymbolFunction can't be
+ * defined as (possibly inline) functions instead of macros. */
+static inline lispobj SymbolValue(u32 sym, void *thread);
+static inline void SetSymbolValue(u32 sym, lispobj val, void *thread);
/* This only works for static symbols. */
/* FIXME: should be called StaticSymbolFunction, right? */
#define SymbolFunction(sym) \
- (((struct fdefn *)(native_pointer(SymbolValue(sym))))->fun)
+ (((struct fdefn *)(native_pointer(SymbolValue(sym,0))))->fun)
/* KLUDGE: As far as I can tell there's no ANSI C way of saying
* "this function never returns". This is the way that you do it
Index: save.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/save.c,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -d -r1.15 -r1.16
--- save.c 27 Feb 2003 00:50:04 -0000 1.15
+++ save.c 2 Apr 2003 11:15:23 -0000 1.16
@@ -24,6 +24,7 @@
#include "lispregs.h"
#include "validate.h"
#include "gc-internal.h"
+#include "thread.h"
#include "genesis/static-symbols.h"
#include "genesis/symbol.h"
@@ -83,6 +84,7 @@
save(char *filename, lispobj init_function)
{
FILE *file;
+ struct thread *th;
/* Open the output file. We don't actually need the file yet, but
* the fopen() might fail for some reason, and we want to detect
@@ -99,9 +101,11 @@
* being SAVE-LISP-AND-DIE instead of SAVE-LISP-AND-GO-ON). */
printf("[undoing binding stack and other enclosing state... ");
fflush(stdout);
- unbind_to_here((lispobj *)BINDING_STACK_START);
- SetSymbolValue(CURRENT_CATCH_BLOCK, 0);
- SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0);
+ for_each_thread(th) { /* XXX really? */
+ unbind_to_here((lispobj *)th->binding_stack_start,th);
+ SetSymbolValue(CURRENT_CATCH_BLOCK, 0,th);
+ SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0,th);
+ }
printf("done]\n");
fflush(stdout);
@@ -135,11 +139,11 @@
output_space(file,
READ_ONLY_CORE_SPACE_ID,
(lispobj *)READ_ONLY_SPACE_START,
- (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER));
+ (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0));
output_space(file,
STATIC_CORE_SPACE_ID,
(lispobj *)STATIC_SPACE_START,
- (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER));
+ (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0));
#ifdef reg_ALLOC
output_space(file,
DYNAMIC_CORE_SPACE_ID,
@@ -154,7 +158,7 @@
output_space(file,
DYNAMIC_CORE_SPACE_ID,
(lispobj *)DYNAMIC_SPACE_START,
- (lispobj *)SymbolValue(ALLOCATION_POINTER));
+ (lispobj *)SymbolValue(ALLOCATION_POINTER,0));
#endif
putw(INITIAL_FUN_CORE_ENTRY_TYPE_CODE, file);
Index: search.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/search.c,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- search.c 27 Feb 2003 15:19:54 -0000 1.8
+++ search.c 2 Apr 2003 11:15:23 -0000 1.9
@@ -15,6 +15,7 @@
#include "sbcl.h"
#include "os.h"
#include "search.h"
+#include "thread.h"
#include "genesis/primitive-objects.h"
boolean search_for_type(int type, lispobj **start, int *count)
Index: thread.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/thread.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- thread.c 26 Mar 2003 01:04:42 -0000 1.2
+++ thread.c 2 Apr 2003 11:15:23 -0000 1.3
@@ -41,6 +41,7 @@
new_thread_trampoline(struct thread *th)
{
lispobj function;
+ lispobj *args = NULL;
function = th->unbound_marker;
if(go==0) {
fprintf(stderr, "/pausing 0x%lx(%d,%d) before new_thread_trampoline(0x%lx)\n",
@@ -54,7 +55,11 @@
if(arch_os_thread_init(th)==0)
return 1; /* failure. no, really */
- return funcall0(function);
+#ifdef LISP_FEATURE_SB_THREAD
+ return call_into_lisp(function,args,0);
+#else
+ return call_into_lisp_first_time(function,args,0);
+#endif
}
/* this is called from any other thread to create the new one, and
@@ -99,6 +104,7 @@
make_fixnum(MAX_INTERRUPTS+
sizeof(struct thread)/sizeof(lispobj)),
0);
+#ifdef LISP_FEATURE_SB_THREAD
#define STATIC_TLS_INIT(sym,field) \
((struct symbol *)(sym-OTHER_POINTER_LOWTAG))->tls_index= \
make_fixnum(THREAD_SLOT_OFFSET_WORDS(field))
@@ -110,6 +116,7 @@
STATIC_TLS_INIT(PSEUDO_ATOMIC_ATOMIC,pseudo_atomic_atomic);
STATIC_TLS_INIT(PSEUDO_ATOMIC_INTERRUPTED,pseudo_atomic_interrupted);
#undef STATIC_TLS_INIT
+#endif
}
th->control_stack_start = spaces;
@@ -131,6 +138,21 @@
* sure why, but it appears to help */
th->pseudo_atomic_atomic=make_fixnum(1);
gc_set_region_empty(&th->alloc_region);
+
+#ifndef LISP_FEATURE_SB_THREAD
+ /* the tls-points-into-struct-thread trick is only good for threaded
+ * sbcl, because unithread sbcl doesn't have tls. So, we copy the
+ * appropriate values from struct thread here, and make sure that
+ * we use the appropriate SymbolValue macros to access any of the
+ * variable quantities from the C runtime. It's not quite OAOOM,
+ * it just feels like it */
+ SetSymbolValue(BINDING_STACK_START,th->binding_stack_start,th);
+ SetSymbolValue(BINDING_STACK_POINTER,th->binding_stack_pointer,th);
+ SetSymbolValue(CONTROL_STACK_START,th->control_stack_start,th);
+ SetSymbolValue(ALIEN_STACK,th->alien_stack_pointer,th);
+ SetSymbolValue(PSEUDO_ATOMIC_ATOMIC,th->pseudo_atomic_atomic,th);
+ SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED,th->pseudo_atomic_interrupted,th);
+#endif
bind_variable(CURRENT_CATCH_BLOCK,make_fixnum(0),th);
bind_variable(CURRENT_UNWIND_PROTECT_BLOCK,make_fixnum(0),th);
@@ -146,9 +168,9 @@
memcpy(th->interrupt_data,global_interrupt_data,
sizeof (struct interrupt_data));
-
-#if defined(LISP_FEATURE_X86) && defined (LISP_FEATURE_LINUX)
th->unbound_marker=initial_function;
+#ifdef LISP_FEATURE_SB_THREAD
+#if defined(LISP_FEATURE_X86) && defined (LISP_FEATURE_LINUX)
kid_pid=
clone(new_thread_trampoline,
(((void*)th->control_stack_start)+THREAD_CONTROL_STACK_SIZE-4),
@@ -159,7 +181,9 @@
#else
#error this stuff presently only works on x86 Linux
#endif
-
+#else
+ kid_pid=getpid();
+#endif
get_spinlock(&all_threads_lock,kid_pid);
th->next=all_threads;
all_threads=th;
@@ -169,6 +193,11 @@
protect_control_stack_guard_page(th->pid,1);
all_threads_lock=0;
th->pid=kid_pid; /* child will not start until this is set */
+#ifndef LISP_FEATURE_SB_THREAD
+ new_thread_trampoline(all_threads); /* call_into_lisp */
+ lose("Clever child? Idiot savant, verging on the.");
+#endif
+
return th->pid;
cleanup:
/* if(th && th->tls_cookie>=0) os_free_tls_pointer(th); */
Index: thread.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/thread.h,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- thread.h 26 Mar 2003 01:04:42 -0000 1.2
+++ thread.h 2 Apr 2003 11:15:23 -0000 1.3
@@ -29,29 +29,42 @@
extern int dynamic_values_bytes;
extern struct thread *find_thread_by_pid(pid_t pid);
+#ifdef LISP_FEATURE_SB_THREAD
#define for_each_thread(th) for(th=all_threads;th;th=th->next)
+#else
+/* there's some possibility a SSC could notice this never actually
+ * loops */
+#define for_each_thread(th) for(th=all_threads;th;th=0)
+#endif
static inline lispobj SymbolValue(u32 tagged_symbol_pointer, void *thread) {
struct symbol *sym= (struct symbol *)
(tagged_symbol_pointer-OTHER_POINTER_LOWTAG);
+#ifdef LISP_FEATURE_SB_THREAD
if(thread && sym->tls_index) {
lispobj r=
((union per_thread_data *)thread)
->dynamic_values[fixnum_value(sym->tls_index)];
if(r!=UNBOUND_MARKER_WIDETAG) return r;
}
+#endif
return sym->value;
}
static inline lispobj SymbolTlValue(u32 tagged_symbol_pointer, void *thread) {
struct symbol *sym= (struct symbol *)
(tagged_symbol_pointer-OTHER_POINTER_LOWTAG);
+#ifdef LISP_FEATURE_SB_THREAD
return ((union per_thread_data *)thread)
->dynamic_values[fixnum_value(sym->tls_index)];
+#else
+ return sym->value;
+#endif
}
static inline void SetSymbolValue(u32 tagged_symbol_pointer,lispobj val, void *thread) {
struct symbol *sym= (struct symbol *)
(tagged_symbol_pointer-OTHER_POINTER_LOWTAG);
+#ifdef LISP_FEATURE_SB_THREAD
if(thread && sym->tls_index) {
lispobj *pr= &(((union per_thread_data *)thread)
->dynamic_values[fixnum_value(sym->tls_index)]);
@@ -60,14 +73,19 @@
return;
}
}
+#endif
sym->value = val;
}
static inline void SetTlSymbolValue(u32 tagged_symbol_pointer,lispobj val, void *thread) {
+#ifdef LISP_FEATURE_SB_THREAD
struct symbol *sym= (struct symbol *)
(tagged_symbol_pointer-OTHER_POINTER_LOWTAG);
((union per_thread_data *)thread)
->dynamic_values[fixnum_value(sym->tls_index)]
=val;
+#else
+ SetSymbolValue(tagged_symbol_pointer,val,thread) ;
+#endif
}
Index: validate.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/validate.c,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -d -r1.13 -r1.14
--- validate.c 6 Aug 2002 11:46:33 -0000 1.13
+++ validate.c 2 Apr 2003 11:15:23 -0000 1.14
@@ -72,8 +72,6 @@
ensure_space( (lispobj *)DYNAMIC_0_SPACE_START , DYNAMIC_SPACE_SIZE);
ensure_space( (lispobj *)DYNAMIC_1_SPACE_START , DYNAMIC_SPACE_SIZE);
#endif
- ensure_space( (lispobj *)CONTROL_STACK_START , CONTROL_STACK_SIZE);
- ensure_space( (lispobj *)BINDING_STACK_START , BINDING_STACK_SIZE);
#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
ensure_space( (lispobj *) ALTERNATE_SIGNAL_STACK_START, SIGSTKSZ);
#endif
@@ -85,11 +83,11 @@
#ifdef PRINTNOISE
printf(" done.\n");
#endif
- protect_control_stack_guard_page(1);
}
-void protect_control_stack_guard_page(int protect_p) {
- os_protect(CONTROL_STACK_GUARD_PAGE,
+void protect_control_stack_guard_page(pid_t t_id, int protect_p) {
+ struct thread *th= find_thread_by_pid(t_id);
+ os_protect(CONTROL_STACK_GUARD_PAGE(th),
os_vm_page_size,protect_p ?
(OS_VM_PROT_READ|OS_VM_PROT_EXECUTE) : OS_VM_PROT_ALL);
}
Index: validate.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/validate.h,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- validate.h 6 Aug 2002 11:46:33 -0000 1.7
+++ validate.h 2 Apr 2003 11:15:23 -0000 1.8
@@ -13,21 +13,22 @@
#define _INCLUDE_VALIDATE_H_
/* constants derived from the fundamental constants in passed by GENESIS */
-#define BINDING_STACK_SIZE ( BINDING_STACK_END - BINDING_STACK_START)
-#define CONTROL_STACK_SIZE ( CONTROL_STACK_END - CONTROL_STACK_START)
+#define BINDING_STACK_SIZE (1024*1024) /* chosen at random */
#define DYNAMIC_SPACE_SIZE ( DYNAMIC_SPACE_END - DYNAMIC_SPACE_START)
#define READ_ONLY_SPACE_SIZE (READ_ONLY_SPACE_END - READ_ONLY_SPACE_START)
#define STATIC_SPACE_SIZE ( STATIC_SPACE_END - STATIC_SPACE_START)
+#define THREAD_CONTROL_STACK_SIZE (2*1024*1024) /* wired elsewhere-watch out */
+#if !defined(LANGUAGE_ASSEMBLY)
+#include <thread.h>
#ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD
-#define CONTROL_STACK_GUARD_PAGE (CONTROL_STACK_START)
+#define CONTROL_STACK_GUARD_PAGE(th) ((void *)(th->control_stack_start))
#else
-#define CONTROL_STACK_GUARD_PAGE (CONTROL_STACK_END - os_vm_page_size)
+#define CONTROL_STACK_GUARD_PAGE(th) (((void *)(th->control_stack_start))+THREAD_CONTROL_STACK_SIZE - os_vm_page_size)
#endif
-#if !defined(LANGUAGE_ASSEMBLY)
extern void validate(void);
-extern void protect_control_stack_guard_page(int protect_p);
+extern void protect_control_stack_guard_page(pid_t t_id, int protect_p);
#endif
/* note for anyone trying to port an architecture's support files
Index: x86-arch.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-arch.c,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -d -r1.17 -r1.18
--- x86-arch.c 27 Feb 2003 00:50:04 -0000 1.17
+++ x86-arch.c 2 Apr 2003 11:15:23 -0000 1.18
@@ -24,6 +24,7 @@
#include "interr.h"
#include "breakpoint.h"
#include "monitor.h"
+#include "thread.h"
#include "genesis/static-symbols.h"
#include "genesis/symbol.h"
@@ -115,13 +116,14 @@
boolean
arch_pseudo_atomic_atomic(os_context_t *context)
{
- return SymbolValue(PSEUDO_ATOMIC_ATOMIC);
+ return SymbolValue(PSEUDO_ATOMIC_ATOMIC,arch_os_get_current_thread());
}
void
arch_set_pseudo_atomic_interrupted(os_context_t *context)
{
- SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1));
+ SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1),
+ arch_os_get_current_thread());
}
/*
@@ -316,6 +318,7 @@
* could be in registers depending on what the compiler likes. So we
* copy the args into a portable vector and let the assembly language
* call-in function figure it out. */
+
lispobj
funcall0(lispobj function)
{
Index: x86-assem.S
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-assem.S,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- x86-assem.S 27 Feb 2003 00:50:05 -0000 1.10
+++ x86-assem.S 2 Apr 2003 11:15:23 -0000 1.11
@@ -19,8 +19,8 @@
#include "genesis/closure.h"
#include "genesis/fdefn.h"
#include "genesis/static-symbols.h"
-#include "genesis/symbol.h"
-
+#include "genesis/symbol.h"
+#include "genesis/thread.h"
/* Minimize conditionalization for different OS naming schemes. */
#if defined __linux__ || defined __FreeBSD__ /* (but *not* OpenBSD) */
@@ -43,6 +43,7 @@
.text
.global GNAME(foreign_function_call_active)
+ .global GNAME(all_threads)
/*
@@ -127,19 +128,38 @@
.text
+ .global GNAME(call_into_lisp_first_time)
+ .type GNAME(call_into_lisp_first_time),@function
+
+/* The *ALIEN-STACK* pointer is set up on the first call_into_lisp when
+ * the stack changes. We don't worry too much about saving registers
+ * here, because we never expect to return from the initial call to lisp
+ * anyway */
+
+ .align align_16byte,0x90
+GNAME(call_into_lisp_first_time):
+ pushl %ebp # Save old frame pointer.
+ movl %esp,%ebp # Establish new frame.
+ movl %esp,ALIEN_STACK + SYMBOL_VALUE_OFFSET
+ movl all_threads,%eax
+ movl THREAD_CONTROL_STACK_START_OFFSET(%eax) ,%esp
+ /* don't think too hard about what happens if we get interrupted
+ * here */
+ addl $THREAD_CONTROL_STACK_SIZE-4,%esp
+ jmp Lstack
+
+ .text
.global GNAME(call_into_lisp)
.type GNAME(call_into_lisp),@function
/* The C conventions require that ebx, esi, edi, and ebp be preserved
* across function calls. */
-/* The *ALIEN-STACK* pointer is set up on the first call_into_lisp when
- * the stack changes. */
.align align_16byte,0x90
GNAME(call_into_lisp):
pushl %ebp # Save old frame pointer.
movl %esp,%ebp # Establish new frame.
-
+Lstack:
/* Save the NPX state */
fwait # Catch any pending NPX exceptions.
subl $108,%esp # Make room for the NPX state.
@@ -178,15 +198,6 @@
movl %eax, GNAME(foreign_function_call_active)
movl %esp,%ebx # remember current stack
- cmpl $CONTROL_STACK_START,%esp
- jbe ChangeToLispStack
- cmpl $CONTROL_STACK_END,%esp
- jbe OnLispStack
-ChangeToLispStack:
- /* Setup the *alien-stack* pointer */
- movl %esp,ALIEN_STACK + SYMBOL_VALUE_OFFSET
- movl $CONTROL_STACK_END,%esp # new stack
-OnLispStack:
pushl %ebx # Save entry stack on (maybe) new stack.
/* Establish Lisp args. */
@@ -662,7 +673,7 @@
-#ifdef LISP_FEATURE_GENCGC_INLINE_ALLOC /* disabled at present */
+#ifdef GENCGC_INLINE_ALLOC /* LISP_FEATURE_GENCGC */
/* These routines are called from Lisp when an inline allocation
* overflows. Every register except the result needs to be preserved.
Index: x86-linux-os.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-linux-os.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- x86-linux-os.c 6 Aug 2002 11:46:33 -0000 1.7
+++ x86-linux-os.c 2 Apr 2003 11:15:23 -0000 1.8
@@ -15,8 +15,12 @@
*/
#include <stdio.h>
+#include <stddef.h>
#include <sys/param.h>
#include <sys/file.h>
+#include <sys/types.h>
+#include <unistd.h>
+
#include "./signal.h"
#include "os.h"
#include "arch.h"
@@ -34,9 +38,104 @@
#include <sys/time.h>
#include <sys/stat.h>
#include <unistd.h>
+#include <asm/ldt.h>
+#include <linux/unistd.h>
+#include <sys/mman.h>
+#include "thread.h" /* dynamic_values_bytes */
+
+_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)];
+
+/* XXX this could be conditionally compiled based on some
+ * "debug-friendly" flag. But it doesn't really make stuff slower,
+ * just the runtime gets fractionally larger */
+
+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);
+}
+
+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 modify_ldt_ldt_s ldt_entry = {
+ 1, 0, 0, /* index, address, length filled in later */
+ 1, MODIFY_LDT_CONTENTS_DATA, 0, 0, 0, 1
+ };
+ /* get next free ldt entry */
+ int n=__modify_ldt(0,local_ldt_copy,sizeof local_ldt_copy);
+ 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 call failed: something magical is not happening */
+ return -1;
+ __asm__ __volatile__ ("movw %w0, %%gs" : : "q"
+ ((n << 3) /* selector number */
+ + (1 << 2) /* TI set = LDT */
+ + 3)); /* privilege level */
+ thread->tls_cookie=n;
+ if(n<0) return 0;
+#endif
+#ifdef LISP_FEATURE_C_STACK_IS_CONTROL_STACK
+ /* Signal handlers are run on the control stack, so if it is exhausted
+ * we had better use an alternate stack for whatever signal tells us
+ * we've exhausted it */
+ sigstack.ss_sp=((void *) thread)+dynamic_values_bytes;
+ sigstack.ss_flags=0;
+ sigstack.ss_size = 32*SIGSTKSZ;
+ sigaltstack(&sigstack,0);
+#endif
+ return 1;
+}
+
+/* if you can't do something like this (maybe because you're using a
+ * register for thread base that is only available in Lisp code)
+ * you'll just have to find_thread_by_pid(getpid())
+ */
+struct thread *arch_os_get_current_thread() {
+#ifdef LISP_FEATURE_SB_THREAD
+ register struct thread *me=0;
+ if(all_threads)
+ __asm__ ("movl %%gs:%c1,%0" : "=r" (me)
+ : "i" (offsetof (struct thread,this)));
+ return me;
+#else
+ return all_threads;
+#endif
+}
+
+/* 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 modify_ldt_ldt_s ldt_entry = {
+ 0, 0, 0,
+ 0, MODIFY_LDT_CONTENTS_DATA, 0, 0, 0, 0
+ };
+
+ ldt_entry.entry_number=thread->tls_cookie;
+ if (__modify_ldt (1, &ldt_entry, sizeof (ldt_entry)) != 0)
+ /* modify_ldt call failed: something magical is not happening */
+ return 0;
+ return 1;
+}
+
/* KLUDGE: As of kernel 2.2.14 on Red Hat 6.2, there's code in the
Index: x86-linux-os.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-linux-os.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- x86-linux-os.h 1 Sep 2002 22:34:18 -0000 1.4
+++ x86-linux-os.h 2 Apr 2003 11:15:23 -0000 1.5
@@ -8,7 +8,9 @@
return (os_context_t *) *void_context;
}
+extern struct thread *arch_os_get_current_thread();
unsigned long os_context_fp_control(os_context_t *context);
void os_restore_fp_control(os_context_t *context);
+int arch_os_thread_init(struct thread *thread);
#endif /* _X86_LINUX_OS_H */
|