From: Daniel B. <da...@us...> - 2003-04-07 13:17:50
|
Update of /cvsroot/sbcl/sbcl/src/runtime In directory sc8-pr-cvs1:/tmp/cvs-serv10665/src/runtime Modified Files: alpha-arch.c alpha-linux-os.c alpha-osf1-os.c bsd-os.c hppa-arch.c hppa-linux-os.c linux-os.c mips-arch.c mips-linux-os.c osf1-os.c purify.c sparc-linux-os.c thread.c thread.h Log Message: 0.pre8.40 === Threads merge, 0.390625 metres === Unithread fixes for all remaining architectures, although I'm not 100% that BSD ports are all working. Various 32/64 bit fixes for Alpha Removed the allocate-16Mb-at-a-time hacks from the Linux port, substitute with MAP_NORESERVE: CMUCL has been doing this for a long time already without user complaint. Also the retryable mmap errors: as there's no logic in the caller to actually retry, we'd be better off losing if mmap fails. Index: alpha-arch.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/alpha-arch.c,v retrieving revision 1.14 retrieving revision 1.15 diff -u -d -r1.14 -r1.15 --- alpha-arch.c 22 Jul 2002 17:17:49 -0000 1.14 +++ alpha-arch.c 7 Apr 2003 13:16:57 -0000 1.15 @@ -369,6 +369,11 @@ undoably_install_low_level_interrupt_handler(SIGTRAP, sigtrap_handler); } +void get_spinlock(lispobj *word, int value) { + /* FIXME: dummy definition */ + *word = value; +} + extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs); lispobj funcall0(lispobj function) Index: alpha-linux-os.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/alpha-linux-os.c,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- alpha-linux-os.c 6 Aug 2002 11:46:32 -0000 1.7 +++ alpha-linux-os.c 7 Apr 2003 13:16:57 -0000 1.8 @@ -39,6 +39,20 @@ #include "validate.h" size_t os_vm_page_size; +#ifdef LISP_FEATURE_SB_THREAD +#error "Define threading support functions" +#else +struct thread *arch_os_get_current_thread() { + return all_threads; +} +int arch_os_thread_init(struct thread *thread) { + return 1; /* success */ +} +int arch_os_thread_cleanup(struct thread *thread) { + return 1; /* success */ +} +#endif + os_context_register_t * os_context_register_addr(os_context_t *context, int offset) Index: alpha-osf1-os.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/alpha-osf1-os.c,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- alpha-osf1-os.c 6 Aug 2002 11:46:32 -0000 1.2 +++ alpha-osf1-os.c 7 Apr 2003 13:16:58 -0000 1.3 @@ -41,6 +41,19 @@ #include "validate.h" size_t os_vm_page_size; +#ifdef LISP_FEATURE_SB_THREAD +#error "Define threading support functions" +#else +struct thread *arch_os_get_current_thread() { + return all_threads; +} +int arch_os_thread_init(struct thread *thread) { + return 1; /* success */ +} +int arch_os_thread_cleanup(struct thread *thread) { + return 1; /* success */ +} +#endif os_context_register_t * os_context_register_addr(os_context_t *context, int offset) Index: bsd-os.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/bsd-os.c,v retrieving revision 1.13 retrieving revision 1.14 diff -u -d -r1.13 -r1.14 --- bsd-os.c 6 Aug 2002 11:46:32 -0000 1.13 +++ bsd-os.c 7 Apr 2003 13:16:58 -0000 1.14 @@ -190,11 +190,18 @@ boolean is_valid_lisp_addr(os_vm_address_t addr) { - return 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 ); + 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)) + return 1; + for_each_thread(th) { + if((th->control_stack_start <= addr) && (addr < th->control_stack_end)) + return 1; + if(in_range_p(addr, th->binding_stack_start, BINDING_STACK_SIZE)) + return 1; + } + return 0; } /* Index: hppa-arch.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/hppa-arch.c,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- hppa-arch.c 19 Aug 2002 12:14:03 -0000 1.1 +++ hppa-arch.c 7 Apr 2003 13:16:59 -0000 1.2 @@ -416,6 +416,12 @@ undoably_install_low_level_interrupt_handler(SIGBUS,sigbus_handler); } +void get_spinlock(lispobj *word, int value) { + /* FIXME: dummy definition */ + *word = value; +} + + lispobj funcall0(lispobj function) { lispobj *args = current_control_stack_pointer; Index: hppa-linux-os.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/hppa-linux-os.c,v retrieving revision 1.1 retrieving revision 1.2 diff -u -d -r1.1 -r1.2 --- hppa-linux-os.c 19 Aug 2002 12:14:03 -0000 1.1 +++ hppa-linux-os.c 7 Apr 2003 13:16:59 -0000 1.2 @@ -37,6 +37,19 @@ #include "validate.h" size_t os_vm_page_size; +#ifdef LISP_FEATURE_SB_THREAD +#error "Define threading support functions" +#else +struct thread *arch_os_get_current_thread() { + return all_threads; +} +int arch_os_thread_init(struct thread *thread) { + return 1; /* success */ +} +int arch_os_thread_cleanup(struct thread *thread) { + return 1; /* success */ +} +#endif os_context_register_t * os_context_register_addr(os_context_t *context, int offset) Index: linux-os.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/linux-os.c,v retrieving revision 1.19 retrieving revision 1.20 diff -u -d -r1.19 -r1.20 --- linux-os.c 3 Apr 2003 15:33:31 -0000 1.19 +++ linux-os.c 7 Apr 2003 13:17:00 -0000 1.20 @@ -90,96 +90,43 @@ #endif } -/* 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 - * causes the low-level monitor to be called. */ -int n_do_mmap_ignorable_errors = 3; -/* Return 0 for success. */ -static int -do_mmap(os_vm_address_t *addr, os_vm_size_t len, int flags) -{ - /* We *must* have the memory where we expect it. */ - os_vm_address_t old_addr = *addr; +#ifdef LISP_FEATURE_ALPHA +/* The Alpha is a 64 bit CPU. SBCL is a 32 bit application. Due to all + * the places that assume we can get a pointer into a fixnum with no + * information loss, we have to make sure it allocates all its ram in the + * 0-2Gb region. */ - *addr = mmap(*addr, len, OS_VM_PROT_ALL, flags, -1, 0); - if (*addr == MAP_FAILED || - ((old_addr != NULL) && (*addr != old_addr))) { - FSHOW((stderr, - "/retryable error in allocating memory from the OS\n" - "(addr=0x%lx, len=0x%lx, flags=0x%lx)\n", - (long) addr, - (long) len, - (long) flags)); - if (n_do_mmap_ignorable_errors > 0) { - --n_do_mmap_ignorable_errors; - } else { - lose("too many errors in allocating memory from the OS"); - } - perror("mmap"); - return 1; - } - return 0; -} +static void * under_2gb_free_pointer=DYNAMIC_1_SPACE_END; +#endif os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len) { - if (addr) { - int flags = MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED; - os_vm_address_t base_addr = addr; - do { - /* KLUDGE: It looks as though this code allocates memory - * in chunks of size no larger than 'magic', but why? What - * is the significance of 0x1000000 here? Also, can it be - * right that if the first few 'do_mmap' calls succeed, - * then one fails, we leave the memory allocated by the - * first few in place even while we return a code for - * complete failure? -- WHN 19991020 - * - * Peter Van Eynde writes (20000211) - * This was done because the kernel would only check for - * overcommit for every allocation seperately. So if you - * had 16MB of free mem+swap you could allocate 16M. And - * again, and again, etc. - * This in [Linux] 2.X could be bad as they changed the memory - * system. A side effect was/is (I don't really know) that - * programs with a lot of memory mappings run slower. But - * of course for 2.2.2X we now have the NO_RESERVE flag that - * helps... - * - * FIXME: The logic is also flaky w.r.t. failed - * allocations. If we make one or more successful calls to - * do_mmap(..) before one fails, then we've allocated - * memory, and we should ensure that it gets deallocated - * sometime somehow. If this function's response to any - * failed do_mmap(..) is to give up and return NULL (as in - * sbcl-0.6.7), then any failed do_mmap(..) after any - * successful do_mmap(..) causes a memory leak. */ - int magic = 0x1000000; - if (len <= magic) { - if (do_mmap(&addr, len, flags)) { - return NULL; - } - len = 0; - } else { - if (do_mmap(&addr, magic, flags)) { - return NULL; - } - addr += magic; - len = len - magic; - } - } while (len > 0); - return base_addr; - } else { - int flags = MAP_PRIVATE | MAP_ANONYMOUS; - if (do_mmap(&addr, len, flags)) { - return NULL; - } else { - return addr; - } + int flags = MAP_PRIVATE | MAP_ANONYMOUS | MAP_NORESERVE; + os_vm_address_t actual ; + + if (addr) + flags |= MAP_FIXED; +#ifdef LISP_FEATURE_ALPHA + else { + flags |= MAP_FIXED; + addr=under_2gb_free_pointer; } +#endif + actual = mmap(addr, len, OS_VM_PROT_ALL, flags, -1, 0); + if (actual == MAP_FAILED || (addr && (addr!=actual))) { + perror("mmap"); + return 0; /* caller should check this */ + } + +#ifdef LISP_FEATURE_ALPHA + + len=(len+(os_vm_page_size-1))&(~(os_vm_page_size-1)); + under_2gb_free_pointer+=len; +#endif + + return addr; } void Index: mips-arch.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/mips-arch.c,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- mips-arch.c 6 Sep 2002 08:55:25 -0000 1.2 +++ mips-arch.c 7 Apr 2003 13:17:04 -0000 1.3 @@ -351,6 +351,11 @@ undoably_install_low_level_interrupt_handler(SIGFPE,sigfpe_handler); } +void get_spinlock(lispobj *word, int value) { + /* FIXME: dummy definition */ + *word = value; +} + extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs); lispobj funcall0(lispobj function) Index: mips-linux-os.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/mips-linux-os.c,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- mips-linux-os.c 6 Sep 2002 08:55:25 -0000 1.2 +++ mips-linux-os.c 7 Apr 2003 13:17:04 -0000 1.3 @@ -42,6 +42,19 @@ #include <asm/mipsregs.h> size_t os_vm_page_size; +#ifdef LISP_FEATURE_SB_THREAD +#error "Define threading support functions" +#else +struct thread *arch_os_get_current_thread() { + return all_threads; +} +int arch_os_thread_init(struct thread *thread) { + return 1; /* success */ +} +int arch_os_thread_cleanup(struct thread *thread) { + return 1; /* success */ +} +#endif os_context_register_t * os_context_register_addr(os_context_t *context, int offset) Index: osf1-os.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/osf1-os.c,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- osf1-os.c 6 Aug 2002 11:46:33 -0000 1.4 +++ osf1-os.c 7 Apr 2003 13:17:05 -0000 1.5 @@ -132,12 +132,6 @@ /* this is lifted from linux-os.c, so violates OOAO */ *os_context_register_addr(context,reg_ALLOC) -= (1L<<63); interrupt_handle_pending(context); - } else if(((addr>=DYNAMIC_0_SPACE_END) && (addr<DYNAMIC_1_SPACE_START)) || - ((addr>=DYNAMIC_1_SPACE_END) && (addr<CONTROL_STACK_START))){ - /* there's empty gap between these spaces. This clause needs - review if the spaces are ever juggled to make this untrue */ - fprintf(stderr, "bad address 0x%p\n",addr); - lose("ran off end of dynamic space"); } else if (!interrupt_maybe_gc(signal, info, context)) { if(!handle_control_stack_guard_triggered(context,addr)) interrupt_handle_now(signal, info, context); Index: purify.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/purify.c,v retrieving revision 1.26 retrieving revision 1.27 diff -u -d -r1.26 -r1.27 --- purify.c 5 Apr 2003 13:04:15 -0000 1.26 +++ purify.c 7 Apr 2003 13:17:06 -0000 1.27 @@ -1476,10 +1476,9 @@ * calling SCRUB-CONTROL-STACK - this zeros the stack on the x86. */ #ifndef __i386__ os_zero((os_vm_address_t) current_control_stack_pointer, - (os_vm_size_t) (THREAD_CONTROL_STACK_SIZE - - ((current_control_stack_pointer - - all_threads->control_stack_start) - * sizeof(lispobj)))); + (os_vm_size_t) + ((all_threads->control_stack_end - + current_control_stack_pointer) * sizeof(lispobj))); #endif /* It helps to update the heap free pointers so that free_heap can Index: sparc-linux-os.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/sparc-linux-os.c,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- sparc-linux-os.c 6 Aug 2002 11:46:33 -0000 1.4 +++ sparc-linux-os.c 7 Apr 2003 13:17:08 -0000 1.5 @@ -37,6 +37,19 @@ #include "validate.h" size_t os_vm_page_size; +#ifdef LISP_FEATURE_SB_THREAD +#error "Define threading support functions" +#else +struct thread *arch_os_get_current_thread() { + return all_threads; +} +int arch_os_thread_init(struct thread *thread) { + return 1; /* success */ +} +int arch_os_thread_cleanup(struct thread *thread) { + return 1; /* success */ +} +#endif os_context_register_t * os_context_register_addr(os_context_t *context, int offset) Index: thread.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/thread.c,v retrieving revision 1.7 retrieving revision 1.8 diff -u -d -r1.7 -r1.8 --- thread.c 5 Apr 2003 13:04:15 -0000 1.7 +++ thread.c 7 Apr 2003 13:17:08 -0000 1.8 @@ -120,8 +120,10 @@ STATIC_TLS_INIT(CONTROL_STACK_START,control_stack_start); STATIC_TLS_INIT(CONTROL_STACK_END,control_stack_end); STATIC_TLS_INIT(ALIEN_STACK,alien_stack_pointer); +#ifdef LISP_FEATURE_X86 STATIC_TLS_INIT(PSEUDO_ATOMIC_ATOMIC,pseudo_atomic_atomic); STATIC_TLS_INIT(PSEUDO_ATOMIC_INTERRUPTED,pseudo_atomic_interrupted); +#endif #undef STATIC_TLS_INIT #endif } @@ -141,10 +143,12 @@ #else th->alien_stack_pointer=((void *)th->alien_stack_start); #endif +#ifdef LISP_FEATURE_X86 th->pseudo_atomic_interrupted=0; /* runtime.c used to set PSEUDO_ATOMIC_ATOMIC =1 globally. I'm not * sure why, but it appears to help */ th->pseudo_atomic_atomic=make_fixnum(1); +#endif #ifdef LISP_FEATURE_GENCGC gc_set_region_empty(&th->alloc_region); #endif @@ -175,7 +179,7 @@ bind_variable(INTERRUPT_PENDING, NIL,th); bind_variable(INTERRUPTS_ENABLED,T,th); - th->interrupt_data=malloc(sizeof (struct interrupt_data)); + th->interrupt_data=os_validate(0,(sizeof (struct interrupt_data))); if(all_threads) memcpy(th->interrupt_data, arch_os_get_current_thread()->interrupt_data, Index: thread.h =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/thread.h,v retrieving revision 1.5 retrieving revision 1.6 diff -u -d -r1.5 -r1.6 --- thread.h 5 Apr 2003 13:04:15 -0000 1.5 +++ thread.h 7 Apr 2003 13:17:10 -0000 1.6 @@ -39,7 +39,7 @@ static inline lispobj SymbolValue(u32 tagged_symbol_pointer, void *thread) { struct symbol *sym= (struct symbol *) - (tagged_symbol_pointer-OTHER_POINTER_LOWTAG); + (pointer_sized_uint_t)(tagged_symbol_pointer-OTHER_POINTER_LOWTAG); #ifdef LISP_FEATURE_SB_THREAD if(thread && sym->tls_index) { lispobj r= @@ -52,7 +52,7 @@ } static inline lispobj SymbolTlValue(u32 tagged_symbol_pointer, void *thread) { struct symbol *sym= (struct symbol *) - (tagged_symbol_pointer-OTHER_POINTER_LOWTAG); + (pointer_sized_uint_t)(tagged_symbol_pointer-OTHER_POINTER_LOWTAG); #ifdef LISP_FEATURE_SB_THREAD return ((union per_thread_data *)thread) ->dynamic_values[fixnum_value(sym->tls_index)]; @@ -63,7 +63,7 @@ static inline void SetSymbolValue(u32 tagged_symbol_pointer,lispobj val, void *thread) { struct symbol *sym= (struct symbol *) - (tagged_symbol_pointer-OTHER_POINTER_LOWTAG); + (pointer_sized_uint_t)(tagged_symbol_pointer-OTHER_POINTER_LOWTAG); #ifdef LISP_FEATURE_SB_THREAD if(thread && sym->tls_index) { lispobj *pr= &(((union per_thread_data *)thread) @@ -79,7 +79,7 @@ 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); + (pointer_sized_uint_t)(tagged_symbol_pointer-OTHER_POINTER_LOWTAG); ((union per_thread_data *)thread) ->dynamic_values[fixnum_value(sym->tls_index)] =val; |