Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/runtime thread.c,NONE,1.1.2.1 thread.h,NONE,1.1.2.1 GNUmakefile,1.14,1.14.2.1 cheneygc.c,1.3,1.3.4.1 coreparse.c,1.16,1.16.2.1 gencgc.c,1.24,1.24.4.1 globals.c,1.10,1.10.4.1 globals.h,1.13,1.13.6.1 interrupt.c,1.32,1.32.4.1 interrupt.h,1.5,1.5.6.1 linux-os.c,1.17.4.1,1.17.4.2 print.c,1.12,1.12.4.1 purify.c,1.20,1.20.4.1 runtime.c,1.16,1.16.4.1 runtime.h,1.12,1.12.4.1 save.c,1.14,1.14.2.1 validate.c,1.13,1.13.4.1 validate.h,1.7,1.7.4.1 x86-assem.S,1.9,1.9.4.1 x86-linux-os.c,1.7,1.7.4.1
Update of /cvsroot/sbcl/sbcl/src/runtime
In directory sc8-pr-cvs1:/tmp/cvs-serv7708/src/runtime
Modified Files:
Tag: dan_native_threads_branch
GNUmakefile cheneygc.c coreparse.c gencgc.c globals.c
globals.h interrupt.c interrupt.h linux-os.c print.c purify.c
runtime.c runtime.h save.c validate.c validate.h x86-assem.S
x86-linux-os.c
Added Files:
Tag: dan_native_threads_branch
thread.c thread.h
Log Message:
0.7.9.54.thread.2
_Experimental_ branch for Linux native thread support.
From time to time the code checked in on this branch may compile,
and possibly even run. This is by no means guaranteed
new files thread.[ch] to create threads and their associated resources
(control stack, binding stack etc).
segment selector frobbing moved into x86-linux-os.c where thread.c can
call it
fairly pervasive, fairly obvious changes to runtime to use per-thread
variables for stacks etc in GC, purify, globals_init, etc; also to
do the relevant things once for each thread instead of just once
temporarily ripped out the control stack guard checking as it doesn't
work with multiple control stacks (will need to be re-enabled)
we actually call clone() ! (Only once, though, and the parent just
idles. Don't get too excited)
x86-assem.S gets simpler now that it doesn't need to mess about with
stacks as much
--- NEW FILE: thread.c ---
#include <stdlib.h>
#include <stdio.h>
#include <sched.h>
#ifndef CLONE_PARENT /* lameass glibc 2.2 doesn't define this */
#define CLONE_PARENT 0x00008000 /* even though the manpage documents it */
#endif
#include "runtime.h"
#include "sbcl.h"
#include "validate.h" /* for CONTROL_STACK_SIZE etc */
#include "thread.h"
#include "arch.h"
#include "os.h"
#include "globals.h"
#define ALIEN_STACK_SIZE (1*1024*1024) /* 1Mb size chosen at random */
#if 0
#define THREAD_CONTROL_STACK_SIZE (2*1024*1024) /* must be 2^n */
#endif
int dynamic_values_bytes=256*sizeof(lispobj); /* same for all threads */
struct thread *all_threads;
struct thread *init_thread(lispobj initial_function) {
/* XXX This function or some of it needs to lock all_threads
*/
struct thread *th=calloc(sizeof(struct thread),1);
void *spaces=0;
/* may as well allocate all of thse at once: it saves us from
* having to decide what to do if only some of the allocations
* succeed */
spaces=os_validate(0,
THREAD_CONTROL_STACK_SIZE+BINDING_STACK_SIZE+
ALIEN_STACK_SIZE+dynamic_values_bytes);
if(!spaces) goto cleanup;
th->control_stack_start = spaces;
th->binding_stack_start=
(lispobj*)((void*)th->control_stack_start+THREAD_CONTROL_STACK_SIZE);
th->alien_stack_start=
(lispobj*)((void*)th->binding_stack_start+BINDING_STACK_SIZE);
th->dynamic_values_start=
(lispobj*)((void*)th->alien_stack_start+ALIEN_STACK_SIZE);
if(all_threads) {
/* XXX this is wrong, should be copying from the current
thread instead */
memcpy(th->dynamic_values_start,all_threads->dynamic_values_start,
dynamic_values_bytes);
} else {
int i;
for(i=0;i<(dynamic_values_bytes/sizeof(lispobj));i++)
th->dynamic_values_start[i]=UNBOUND_MARKER_WIDETAG;
}
/* yes, really we are keeping raw machine words in these lisp
* symbol value slots */
/* obviously we'll have to do the dynamic-value-offset thing here
* as soon as we want two threads to actually execute lisp at
* once */
((struct symbol *)native_pointer(ALIEN_STACK))->value
=LOW_WORD(th->dynamic_values_start-1);
#ifdef BINDING_STACK_POINTER
SetSymbolValue(BINDING_STACK_POINTER, LOW_WORD(th->binding_stack_start));
#endif
th->next=all_threads;
th->tls_cookie=os_set_tls_pointer(th);
if(th->tls_cookie<0) goto cleanup;
#if defined(LISP_FEATURE_X86) && defined (LISP_FEATURE_LINUX)
*(th->binding_stack_start-1) = LOW_WORD(th->dynamic_values_start);
th->pid=
clone(funcall0,th->binding_stack_start-2,
((getpid()!=parent_pid)?CLONE_PARENT:0)
|CLONE_SIGHAND|CLONE_VM,initial_function);
fprintf(stderr,"child pid is %d\n",th->pid);
if(!th->pid) goto cleanup;
#else
#error this stuff presently only works on x86 Linux
#endif
all_threads=th;
return th;
cleanup:
/* if(th && th->tls_cookie>=0) os_free_tls_pointer(th); */
if(spaces) os_invalidate(spaces,
THREAD_CONTROL_STACK_SIZE+BINDING_STACK_SIZE+
ALIEN_STACK_SIZE+dynamic_values_bytes);
if(th) free(th);
return 0;
}
--- NEW FILE: thread.h ---
#include <sys/types.h>
#include <unistd.h>
#include "runtime.h"
#include "sbcl.h"
struct thread {
lispobj *control_stack_start;
lispobj *binding_stack_start;
lispobj *alien_stack_start;
lispobj *dynamic_values_start;
pid_t pid;
int tls_cookie; /* on x86, the LDT index */
struct thread *next;
};
extern struct thread *all_threads;
extern int dynamic_values_bytes;
#define for_each_thread(th) for(th=all_threads;th;th=th->next)
Index: GNUmakefile
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/GNUmakefile,v
retrieving revision 1.14
retrieving revision 1.14.2.1
diff -u -d -r1.14 -r1.14.2.1
--- GNUmakefile 15 Sep 2002 16:32:18 -0000 1.14
+++ GNUmakefile 24 Nov 2002 13:14:16 -0000 1.14.2.1
@@ -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: cheneygc.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/cheneygc.c,v
retrieving revision 1.3
retrieving revision 1.3.4.1
diff -u -d -r1.3 -r1.3.4.1
--- cheneygc.c 9 Aug 2002 14:32:49 -0000 1.3
+++ cheneygc.c 24 Nov 2002 13:14:16 -0000 1.3.4.1
@@ -27,6 +27,7 @@
#include "validate.h"
#include "lispregs.h"
#include "interr.h"
+#include "thread.h"
/* So you need to debug? */
#if 0
@@ -117,6 +118,7 @@
lispobj *current_static_space_free_pointer;
unsigned long static_space_size;
unsigned long control_stack_size, binding_stack_size;
+ struct thread *th;
sigset_t tmp, old;
#ifdef PRINTNOISE
@@ -171,6 +173,7 @@
sizeof(interrupt_handlers) / sizeof(lispobj));
/* _size quantities are in units of sizeof(lispobj) - i.e. 4 */
+
control_stack_size =
current_control_stack_pointer-
(lispobj *)CONTROL_STACK_START;
@@ -185,6 +188,7 @@
binding_stack_size =
current_binding_stack_pointer -
(lispobj *)BINDING_STACK_START;
+
#ifdef PRINTNOISE
printf("Scavenging the binding stack %x - %x (%d words) ...\n",
BINDING_STACK_START,current_binding_stack_pointer,
Index: coreparse.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/coreparse.c,v
retrieving revision 1.16
retrieving revision 1.16.2.1
diff -u -d -r1.16 -r1.16.2.1
--- coreparse.c 2 Oct 2002 23:22:48 -0000 1.16
+++ coreparse.c 24 Nov 2002 13:14:16 -0000 1.16.2.1
@@ -187,7 +187,7 @@
goto losing_build_id;
for (i = 0; i < remaining_len; ++i) {
FSHOW((stderr, "ptr[%d] = char = %d, expected=%d\n",
- ptr[i], i, build_id[i]));
+ i,ptr[i], build_id[i]));
if (ptr[i] != build_id[i])
goto losing_build_id;
}
Index: gencgc.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/gencgc.c,v
retrieving revision 1.24
retrieving revision 1.24.4.1
diff -u -d -r1.24 -r1.24.4.1
--- gencgc.c 25 Aug 2002 15:30:32 -0000 1.24
+++ gencgc.c 24 Nov 2002 13:14:16 -0000 1.24.4.1
@@ -37,7 +37,7 @@
#include "arch.h"
#include "gc.h"
#include "gc-internal.h"
-
+#include "thread.h"
/* assembly language stub that executes trap_PendingInterrupt */
void do_pending_interrupt(void);
@@ -3516,13 +3516,17 @@
int static_space_size =
(lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER)
- (lispobj*)STATIC_SPACE_START;
- int binding_stack_size =
- (lispobj*)SymbolValue(BINDING_STACK_POINTER)
- - (lispobj*)BINDING_STACK_START;
-
+ struct thread *th;
+ for_each_thread(th) {
+ /* XXX this needs to be a per-process special and accessed
+ * appropriately for such */
+ int binding_stack_size =
+ (lispobj*)SymbolValue(BINDING_STACK_POINTER)
+ - (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
@@ -3708,8 +3712,14 @@
/* Scavenge the stack's conservative roots. */
{
+ /* XXXX this really is not going to work as soon as we have >1
+ * thread
+ */
void **ptr;
- for (ptr = (void **)CONTROL_STACK_END - 1;
+ for (ptr = ((void **)
+ ((void *)all_threads->control_stack_start
+ + THREAD_CONTROL_STACK_SIZE)
+ -1);
ptr > (void **)&raise;
ptr--) {
preserve_pointer(*ptr);
@@ -3740,10 +3750,16 @@
}
}
- /* Scavenge the binding stack. */
- scavenge((lispobj *) BINDING_STACK_START,
- (lispobj *)SymbolValue(BINDING_STACK_POINTER) -
- (lispobj *)BINDING_STACK_START);
+ /* Scavenge the binding stacks. */
+ {
+ struct thread *th;
+ /* XXX this would be better if it looked up the appropriate
+ * per-thread value of BINDING_STACK_POINTER */
+ for(th=all_threads;th;th=th->next)
+ scavenge((lispobj *) th->binding_stack_start,
+ (lispobj *)SymbolValue(BINDING_STACK_POINTER) -
+ (lispobj *)th->binding_stack_start);
+ }
/* The original CMU CL code had scavenge-read-only-space code
* controlled by the Lisp-level variable
@@ -4005,10 +4021,6 @@
update_x86_dynamic_space_free_pointer();
- /* This is now done by Lisp SCRUB-CONTROL-STACK in Lisp SUB-GC, so
- * we needn't do it here: */
- /* zero_stack();*/
-
current_region_free_pointer = boxed_region.free_pointer;
current_region_end_addr = boxed_region.end_addr;
@@ -4098,10 +4110,6 @@
unboxed_region.start_addr = page_address(0);
unboxed_region.free_pointer = page_address(0);
unboxed_region.end_addr = page_address(0);
-
-#if 0 /* Lisp PURIFY is currently running on the C stack so don't do this. */
- zero_stack();
-#endif
last_free_page = 0;
SetSymbolValue(ALLOCATION_POINTER, (lispobj)((char *)heap_base));
Index: globals.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/globals.c,v
retrieving revision 1.10
retrieving revision 1.10.4.1
diff -u -d -r1.10 -r1.10.4.1
--- globals.c 6 Aug 2002 11:46:33 -0000 1.10
+++ globals.c 24 Nov 2002 13:14:16 -0000 1.10.4.1
@@ -14,6 +14,8 @@
*/
#include <stdio.h>
+#include <sys/types.h>
+#include <unistd.h>
#include "runtime.h"
#include "sbcl.h"
@@ -28,9 +30,7 @@
lispobj *current_binding_stack_pointer;
#endif
-/* ALLOCATION_POINTER is more or less synonymous with RT, it seems.
- * Anyone want to do an RT port of sbcl?
- */
+/* ALLOCATION_POINTER is x86 or RT. Anyone want to do an RT port? */
#ifndef ALLOCATION_POINTER
/* The Object Formerly Known As current_dynamic_space_free_pointer */
@@ -46,10 +46,13 @@
* is done). For the GENCGC, it always points to DYNAMIC_SPACE_START. */
lispobj *current_dynamic_space;
+pid_t parent_pid;
+
void globals_init(void)
{
/* Space, stack, and free pointer vars are initialized by
* validate() and coreparse(). */
+ current_control_frame_pointer = (lispobj *)0;
#ifndef LISP_FEATURE_GENCGC
/* no GC trigger yet */
@@ -59,15 +62,5 @@
/* 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);
-#endif
+ parent_pid=getpid();
}
Index: globals.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/globals.h,v
retrieving revision 1.13
retrieving revision 1.13.6.1
diff -u -d -r1.13 -r1.13.6.1
--- globals.h 7 Jun 2002 01:54:42 -0000 1.13
+++ globals.h 24 Nov 2002 13:14:16 -0000 1.13.6.1
@@ -14,6 +14,8 @@
#ifndef LANGUAGE_ASSEMBLY
+#include <sys/types.h>
+#include <unistd.h>
#include "runtime.h"
extern int foreign_function_call_active;
@@ -31,6 +33,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.32
retrieving revision 1.32.4.1
diff -u -d -r1.32 -r1.32.4.1
--- interrupt.c 6 Aug 2002 11:46:33 -0000 1.32
+++ interrupt.c 24 Nov 2002 13:14:17 -0000 1.32.4.1
@@ -521,56 +521,9 @@
boolean handle_control_stack_guard_triggered(os_context_t *context,void *addr)
{
- /* 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)) {
- void *fun;
- void *code;
-
- /* we hit the end of the control stack. disable protection
- * temporarily so the error handler has some headroom */
- protect_control_stack_guard_page(0);
-
- fun = (void *)
- native_pointer((lispobj) SymbolFunction(CONTROL_STACK_EXHAUSTED_ERROR));
- code = &(((struct simple_fun *) fun)->code);
-
- /* Build a stack frame showing `interrupted' so that the
- * user's backtrace makes (as much) sense (as usual) */
- build_fake_control_stack_frames(context);
- /* signal handler will "return" to this error-causing function */
- *os_context_pc_addr(context) = code;
-#ifdef LISP_FEATURE_X86
- *os_context_register_addr(context,reg_ECX) = 0;
-#else
- /* this much of the calling convention is common to all
- non-x86 ports */
- *os_context_register_addr(context,reg_NARGS) = 0;
- *os_context_register_addr(context,reg_LIP) = code;
- *os_context_register_addr(context,reg_CFP) =
- current_control_frame_pointer;
-#endif
-#ifdef ARCH_HAS_NPC_REGISTER
- *os_context_npc_addr(context) =
- 4 + *os_context_pc_addr(context);
-#endif
-#ifdef LISP_FEATURE_SPARC
- /* Bletch. This is a feature of the SPARC calling convention,
- which sadly I'm not going to go into in large detail here,
- as I don't know it well enough. Suffice to say that if the
- line
-
- (INST MOVE CODE-TN FUNCTION)
-
- in compiler/sparc/call.lisp is changed, then this bit can
- probably go away. -- CSR, 2002-07-24 */
- *os_context_register_addr(context,reg_CODE) =
- fun + FUN_POINTER_LOWTAG;
-#endif
- return 1;
- }
- else return 0;
+ /* not thinking too hard about this just now */
+ /* FIXME so think! */
+ return 0;
}
#ifndef LISP_FEATURE_X86
@@ -698,14 +651,7 @@
/* 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;
- }
+ /* XXX this bit got untimely ripped out in pursuit of threads */
#endif
/* In the case of interrupt handlers which are modified more than
Index: interrupt.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/interrupt.h,v
retrieving revision 1.5
retrieving revision 1.5.6.1
diff -u -d -r1.5 -r1.5.6.1
--- interrupt.h 23 Jul 2002 17:22:37 -0000 1.5
+++ interrupt.h 24 Nov 2002 13:14:17 -0000 1.5.6.1
@@ -19,7 +19,7 @@
* 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
+#define MAX_INTERRUPTS 8 /* was 256, but they rarely seem useful */
extern os_context_t *lisp_interrupt_contexts[MAX_INTERRUPTS];
Index: linux-os.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/linux-os.c,v
retrieving revision 1.17.4.1
retrieving revision 1.17.4.2
diff -u -d -r1.17.4.1 -r1.17.4.2
--- linux-os.c 24 Nov 2002 02:36:43 -0000 1.17.4.1
+++ linux-os.c 24 Nov 2002 13:14:17 -0000 1.17.4.2
@@ -41,21 +41,8 @@
#include <sys/stat.h>
#include <unistd.h>
-#include <asm/ldt.h>
-#include <linux/unistd.h>
-
-#include <unistd.h>
-#include <sys/mman.h>
-
-_syscall3(int, modify_ldt, int, func, void *, ptr, unsigned long, bytecount );
-
-static 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
-};
-u32 local_ldt_copy[LDT_ENTRIES*LDT_ENTRY_SIZE/sizeof(u32)];
-
#include "validate.h"
+#include "thread.h"
size_t os_vm_page_size;
#include "gc.h"
@@ -66,8 +53,6 @@
#endif
void os_init(void)
{
- lispobj *tls_vector=
- mmap(0,4096,PROT_READ|PROT_WRITE,MAP_PRIVATE|MAP_ANONYMOUS,-1,0);
/* Early versions of Linux don't support the mmap(..) functionality
* that we need. */
{
@@ -102,53 +87,9 @@
something?) Find out what this was meant to do, and reenable it
or delete it if possible. -- CSR, 2002-07-15 */
/* SET_FPU_CONTROL_WORD(0x1372|4|8|16|32); no interrupts */
-
- printf("vector is at 0x%x\n",tls_vector);
- {
- /* find index of get next free ldt entry */
- int n=__modify_ldt(0,local_ldt_copy,sizeof local_ldt_copy)
- /LDT_ENTRY_SIZE;
-
- ldt_entry.entry_number=n;
- ldt_entry.base_addr=(unsigned long) tls_vector;
- ldt_entry.limit=1000;
- ldt_entry.limit_in_pages=1;
- tls_vector[0]=UNBOUND_MARKER_WIDETAG;
- tls_vector[1]=UNBOUND_MARKER_WIDETAG;
- tls_vector[2]=2<<2;
- if (__modify_ldt (1, &ldt_entry, sizeof (ldt_entry)) != 0)
- lose("modify_ldt call failed: something magical is not happening");
- __asm__ __volatile__ ("movw %w0, %%gs" : : "q"
- ((n << 3) /* selector number */
- + (1 << 2) /* TI set = LDT */
- + 3)); /* privilege level */
- printf("ldt entry is 0x%x 0x%x\n",
- (ldt_entry.base_addr & 0xff000000) |
- ((ldt_entry.base_addr & 0x00ff0000) >> 16) |
- (ldt_entry.limit & 0xf0000) |
- ((ldt_entry.read_exec_only ^ 1) << 9) |
- (ldt_entry.contents << 10) |
- ((ldt_entry.seg_not_present ^ 1) << 15) |
- (ldt_entry.seg_32bit << 22) |
- (ldt_entry.limit_in_pages << 23) |
- 0x7000,
-
- ((ldt_entry.base_addr & 0x0000ffff) << 16) |
- (ldt_entry.limit & 0x0ffff));
-
-
-
- }
#endif
}
-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);
-}
-
-
/* In Debian CMU CL ca. 2.4.9, it was possible to get an infinite
* cascade of errors from do_mmap(..). This variable is a counter to
* prevent that; when it counts down to zero, an error in do_mmap
@@ -292,8 +233,11 @@
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);
+ /* XXX >1 thread? */
+ in_range_p(addr, all_threads->control_stack_start,
+ THREAD_CONTROL_STACK_SIZE) ||
+ in_range_p(addr, all_threads->binding_stack_start,
+ BINDING_STACK_SIZE);
}
/*
Index: print.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/print.c,v
retrieving revision 1.12
retrieving revision 1.12.4.1
diff -u -d -r1.12 -r1.12.4.1
--- print.c 6 Aug 2002 11:46:33 -0000 1.12
+++ print.c 24 Nov 2002 13:14:17 -0000 1.12.4.1
@@ -411,7 +411,7 @@
* 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: ", "tls-index: " , 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.20
retrieving revision 1.20.4.1
diff -u -d -r1.20 -r1.20.4.1
--- purify.c 6 Aug 2002 11:46:33 -0000 1.20
+++ purify.c 24 Nov 2002 13:14:17 -0000 1.20.4.1
@@ -28,6 +28,7 @@
#include "interr.h"
#include "gc.h"
#include "gc-internal.h"
+#include "thread.h"
#define PRINTNOISE
@@ -1325,8 +1326,10 @@
#endif
#ifdef LISP_FEATURE_GENCGC
- gc_assert((lispobj *)CONTROL_STACK_END > ((&read_only_roots)+1));
- setup_i386_stack_scav(((&static_roots)-2), (lispobj *)CONTROL_STACK_END);
+ setup_i386_stack_scav(((&static_roots)-2),
+ ((void *)all_threads->control_stack_start)
+ +THREAD_CONTROL_STACK_SIZE);
+
#endif
pscav(&static_roots, 1, 0);
@@ -1363,9 +1366,9 @@
(lispobj *)current_binding_stack_pointer - (lispobj *)BINDING_STACK_START,
0);
#else
- pscav( (lispobj *)BINDING_STACK_START,
+ pscav( (lispobj *)all_threads->binding_stack_start,
(lispobj *)SymbolValue(BINDING_STACK_POINTER) -
- (lispobj *)BINDING_STACK_START,
+ (lispobj *)all_threads->binding_stack_start,
0);
#endif
Index: runtime.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/runtime.c,v
retrieving revision 1.16
retrieving revision 1.16.4.1
diff -u -d -r1.16 -r1.16.4.1
--- runtime.c 6 Aug 2002 11:46:33 -0000 1.16
+++ runtime.c 24 Nov 2002 13:14:17 -0000 1.16.4.1
@@ -262,10 +262,6 @@
gc_initialize_pointers();
-#ifdef BINDING_STACK_POINTER
- SetSymbolValue(BINDING_STACK_POINTER, BINDING_STACK_START);
-#endif
-
interrupt_init();
arch_install_interrupt_handlers();
@@ -287,7 +283,11 @@
sigint_init();
FSHOW((stderr, "/funcalling initial_function=0x%lx\n", initial_function));
- funcall0(initial_function);
+ init_thread(initial_function);
+ fprintf(stderr,"started lisp thread\n");
+ while(pause())
+ fprintf(stderr,"parent thread caught a signal\n");
+
/* initial_function() is not supposed to return. */
lose("Lisp initial_function gave up control.");
Index: runtime.h
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/runtime.h,v
retrieving revision 1.12
retrieving revision 1.12.4.1
diff -u -d -r1.12 -r1.12.4.1
--- runtime.h 6 Aug 2002 11:46:33 -0000 1.12
+++ runtime.h 24 Nov 2002 13:14:17 -0000 1.12.4.1
@@ -15,7 +15,7 @@
#ifndef _SBCL_RUNTIME_H_
#define _SBCL_RUNTIME_H_
-#define QSHOW 0 /* Enable low-level debugging output? */
+#define QSHOW 1 /* Enable low-level debugging output? */
#if QSHOW
#define FSHOW(args) fprintf args
#define SHOW(string) FSHOW((stderr, "/%s\n", string))
Index: save.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/save.c,v
retrieving revision 1.14
retrieving revision 1.14.2.1
diff -u -d -r1.14 -r1.14.2.1
--- save.c 2 Oct 2002 23:22:48 -0000 1.14
+++ save.c 24 Nov 2002 13:14:17 -0000 1.14.2.1
@@ -24,6 +24,7 @@
#include "lispregs.h"
#include "validate.h"
#include "gc-internal.h"
+#include "thread.h"
static long
write_bytes(FILE *file, char *addr, long bytes)
@@ -80,6 +81,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
@@ -96,7 +98,8 @@
* 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);
+ for_each_thread(th) /* XXX really? */
+ unbind_to_here((lispobj *)th->binding_stack_start);
SetSymbolValue(CURRENT_CATCH_BLOCK, 0);
SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0);
printf("done]\n");
Index: validate.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/validate.c,v
retrieving revision 1.13
retrieving revision 1.13.4.1
diff -u -d -r1.13 -r1.13.4.1
--- validate.c 6 Aug 2002 11:46:33 -0000 1.13
+++ validate.c 24 Nov 2002 13:14:17 -0000 1.13.4.1
@@ -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,12 +83,14 @@
#ifdef PRINTNOISE
printf(" done.\n");
#endif
- protect_control_stack_guard_page(1);
+ protect_control_stack_guard_page(1);
}
void protect_control_stack_guard_page(int protect_p) {
+ /*
os_protect(CONTROL_STACK_GUARD_PAGE,
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.7.4.1
diff -u -d -r1.7 -r1.7.4.1
--- validate.h 6 Aug 2002 11:46:33 -0000 1.7
+++ validate.h 24 Nov 2002 13:14:17 -0000 1.7.4.1
@@ -13,11 +13,11 @@
#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 */
#ifdef LISP_FEATURE_STACK_GROWS_DOWNWARD_NOT_UPWARD
#define CONTROL_STACK_GUARD_PAGE (CONTROL_STACK_START)
Index: x86-assem.S
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-assem.S,v
retrieving revision 1.9
retrieving revision 1.9.4.1
diff -u -d -r1.9 -r1.9.4.1
--- x86-assem.S 6 Aug 2002 11:46:33 -0000 1.9
+++ x86-assem.S 24 Nov 2002 13:14:17 -0000 1.9.4.1
@@ -173,15 +173,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. */
Index: x86-linux-os.c
===================================================================
RCS file: /cvsroot/sbcl/sbcl/src/runtime/x86-linux-os.c,v
retrieving revision 1.7
retrieving revision 1.7.4.1
diff -u -d -r1.7 -r1.7.4.1
--- x86-linux-os.c 6 Aug 2002 11:46:33 -0000 1.7
+++ x86-linux-os.c 24 Nov 2002 13:14:17 -0000 1.7.4.1
@@ -34,10 +34,54 @@
#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 slowed,
+ * 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 os_set_tls_pointer(struct thread *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
+ };
+ /* find index of get next free ldt entry */
+ int n=__modify_ldt(0,local_ldt_copy,sizeof local_ldt_copy)
+ /LDT_ENTRY_SIZE;
+
+ ldt_entry.entry_number=n;
+ ldt_entry.base_addr=(unsigned long) (thread->dynamic_values_start);
+ 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 */
+ return n;
+}
+
/* KLUDGE: As of kernel 2.2.14 on Red Hat 6.2, there's code in the
* <sys/ucontext.h> file to define symbolic names for offsets into
|