Menu
▾
▴
[Sbcl-commits] CVS: sbcl/src/runtime alloc.c,1.19,1.19.10.1 alpha-arch.c,1.17,1.17.10.1 backtrace.c,1.19,1.19.2.1 cheneygc.c,1.11,1.11.2.1 coreparse.c,1.23,1.23.16.1 gc-common.c,1.21,1.21.2.1 gc-internal.h,1.11,1.11.2.1 globals.h,1.19,1.19.10.1 interrupt.c,1.67,1.67.2.1 parse.c,1.14,1.14.2.1 purify.c,1.45,1.45.2.1 runtime.h,1.18,1.18.2.1 thread.h,1.13,1.13.2.1 wrap.c,1.14,1.14.10.1
|
From: Nathan F. <nf...@us...> - 2005-01-11 18:03:06
|
Update of /cvsroot/sbcl/sbcl/src/runtime In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv20510/src/runtime Modified Files: Tag: alpha64-3-branch alloc.c alpha-arch.c backtrace.c cheneygc.c coreparse.c gc-common.c gc-internal.h globals.h interrupt.c parse.c purify.c runtime.h thread.h wrap.c Log Message: 0.8.18.25.alpha64-3.1: "Third time's the charm." Commit an updated version of Christophe and Dan's work on an Alpha64 port, motivated by Juho's recent work on AMD64. I forward ported the alpha64_2 branch to 0.8.13.mumble, and successfully reached the beginning of warm-init. (1+ MOST-POSITIVE-FIXNUM) returns the right answer. :) However, given that there has been a lot of work recently on a 64-bit clean SBCL (and many improvements since 0.8.13.mumble), doing another forward port seemed like a reasonable idea. WARNING: I have not tried to build an actual alpha64 sbcl with this version yet, but I can assure you that the build did work properly for 0.8.13.x. I may have also forgotten some files in src/code/ or thereabouts. Improvements over the alpha64_2 branch: * several arithmetic assembly VOPs have been rewritten; * can compile simple DEFUNs; * calling sequences updated to be closer to PPC. Things which are known to not work: * bignums (can't really tell, since printing of bignums is borked); * unicode; * linkage-tables; * probably other things I am forgetting. Index: alloc.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/alloc.c,v retrieving revision 1.19 retrieving revision 1.19.10.1 diff -u -d -r1.19 -r1.19.10.1 --- alloc.c 10 Aug 2004 00:20:46 -0000 1.19 +++ alloc.c 11 Jan 2005 18:02:33 -0000 1.19.10.1 @@ -95,7 +95,7 @@ struct vector *result; result = (struct vector *) - pa_alloc(ALIGNED_SIZE((2 + (length*size + 31) / 32) * sizeof(lispobj))); + pa_alloc(ALIGNED_SIZE((2 + (length*size + (N_WORD_BITS-1)) / N_WORD_BITS) * sizeof(lispobj))); result->header = type; result->length = make_fixnum(length); Index: alpha-arch.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/alpha-arch.c,v retrieving revision 1.17 retrieving revision 1.17.10.1 diff -u -d -r1.17 -r1.17.10.1 --- alpha-arch.c 10 Aug 2004 00:20:46 -0000 1.17 +++ alpha-arch.c 11 Jan 2005 18:02:33 -0000 1.17.10.1 @@ -88,7 +88,8 @@ /* This may be complete rubbish, as (at least for traps) pc points * _after_ the instruction that caused us to be here anyway. */ - ((char*)*os_context_pc_addr(context)) +=4; } + ((char*)*os_context_pc_addr(context)) +=4; +} unsigned char * arch_internal_error_arguments(os_context_t *context) @@ -278,7 +279,7 @@ static void sigtrap_handler(int signal, siginfo_t *siginfo, os_context_t *context) { - unsigned int code; + unsigned long code; sigset_t *mask; #ifdef LISP_FEATURE_LINUX os_restore_fp_control(context); @@ -312,11 +313,13 @@ *os_context_sigmask_addr(context)= orig_sigmask; after_breakpoint=0; /* false */ return; - } else + } else { code = trap_Breakpoint; - } else + } + } else { /* a "system service" */ - code=*((u32 *)(*os_context_pc_addr(context))); + code=*os_context_pc_addr(context); + } switch (code) { case trap_PendingInterrupt: @@ -345,7 +348,7 @@ break; default: - fprintf(stderr, "unidentified breakpoint/trap %d\n",code); + fprintf(stderr, "unidentified breakpoint/trap %ld\n",code); interrupt_handle_now(signal, siginfo, context); break; } Index: backtrace.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/backtrace.c,v retrieving revision 1.19 retrieving revision 1.19.2.1 diff -u -d -r1.19 -r1.19.2.1 --- backtrace.c 6 Jan 2005 12:48:03 -0000 1.19 +++ backtrace.c 11 Jan 2005 18:02:33 -0000 1.19.2.1 @@ -28,34 +28,22 @@ #include "genesis/primitive-objects.h" #include "thread.h" -#if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)) +#ifndef LISP_FEATURE_X86 /* KLUDGE: Sigh ... I know what the call frame looks like and it had * better not change. */ struct call_frame { -#ifndef alpha struct call_frame *old_cont; -#else - u32 old_cont; -#endif lispobj saved_lra; lispobj code; lispobj other_state[5]; }; struct call_info { -#ifndef alpha struct call_frame *frame; -#else - u32 frame; -#endif int interrupted; -#ifndef alpha struct code *code; -#else - u32 code; -#endif lispobj lra; int pc; /* Note: this is the trace file offset, not the actual pc. */ }; @@ -139,11 +127,7 @@ } if (info->code != NULL) info->pc = pc - (unsigned long) info->code - -#ifndef alpha - (HEADER_LENGTH(info->code->header) * sizeof(lispobj)); -#else (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj)); -#endif else info->pc = 0; } @@ -170,7 +154,7 @@ if (info->lra == NIL) { /* We were interrupted. Find the correct signal context. */ - free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)>>2; + free = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)); while (free-- > 0) { os_context_t *context = thread->interrupt_contexts[free]; @@ -187,11 +171,7 @@ if (info->code != NULL) info->pc = (unsigned long)native_pointer(info->lra) - (unsigned long)info->code - -#ifndef alpha (HEADER_LENGTH(info->code->header) * sizeof(lispobj)); -#else - (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj)); -#endif else info->pc = 0; } @@ -213,13 +193,10 @@ if (info.code != (struct code *) 0) { lispobj function; - printf("CODE: 0x%08X, ", (unsigned long) info.code | OTHER_POINTER_LOWTAG); + printf("CODE: 0x%016X, ", (pointer_sized_uint_t)info.code | OTHER_POINTER_LOWTAG); -#ifndef alpha function = info.code->entry_points; -#else - function = ((struct code *)info.code)->entry_points; -#endif + while (function != NIL) { struct simple_fun *header; lispobj name; @@ -244,7 +221,6 @@ string = (struct vector *) object; printf("%s, ", (char *) string->data); } else - /* FIXME: broken from (VECTOR NIL) */ printf("(Not simple string??\?), "); } else printf("(Not other pointer??\?), "); @@ -257,7 +233,7 @@ printf("CODE: ???, "); if (info.lra != NIL) - printf("LRA: 0x%08x, ", (unsigned long)info.lra); + printf("LRA: 0x%016x, ", (unsigned long)info.lra); else printf("<no LRA>, "); Index: cheneygc.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/cheneygc.c,v retrieving revision 1.11 retrieving revision 1.11.2.1 diff -u -d -r1.11 -r1.11.2.1 --- cheneygc.c 6 Jan 2005 12:48:03 -0000 1.11 +++ cheneygc.c 11 Jan 2005 18:02:33 -0000 1.11.2.1 @@ -90,19 +90,19 @@ void * -gc_general_alloc(long bytes, int unboxed_p, int quick_p) { +gc_general_alloc(int bytes, int unboxed_p, int quick_p) { lispobj *new=new_space_free_pointer; new_space_free_pointer+=(bytes/N_WORD_BYTES); return new; } -lispobj copy_large_unboxed_object(lispobj object, long nwords) { +lispobj copy_large_unboxed_object(lispobj object, int nwords) { return copy_object(object,nwords); } -lispobj copy_unboxed_object(lispobj object, long nwords) { +lispobj copy_unboxed_object(lispobj object, int nwords) { return copy_object(object,nwords); } -lispobj copy_large_object(lispobj object, long nwords) { +lispobj copy_large_object(lispobj object, int nwords) { return copy_object(object,nwords); } @@ -495,9 +495,47 @@ } +/* code and code-related objects */ + +/* FIXME (1) this could probably be defined using something like + * sizeof(lispobj)*floor(sizeof(struct simple_fun)/sizeof(lispobj)) + * - FUN_POINTER_LOWTAG + * as I'm reasonably sure that simple_fun->code must always be the + * last slot in the object + + * FIXME (2) it also appears in purify.c, and it has a different value + * for SPARC users in that bit + */ + +#define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - FUN_POINTER_LOWTAG) + +/* Note: on the sparc we don't have to do anything special for fdefns, */ +/* 'cause the raw-addr has a function lowtag. */ +#ifndef LISP_FEATURE_SPARC +static int +scav_fdefn(lispobj *where, lispobj object) +{ + struct fdefn *fdefn; + + fdefn = (struct fdefn *)where; + + if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET) + == (char *)((unsigned long)(fdefn->raw_addr))) { + scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1); + fdefn->raw_addr = + ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET; + return sizeof(struct fdefn) / sizeof(lispobj); + } + else + return 1; +} +#endif + + + /* vector-like objects */ -static long +static int scav_vector(lispobj *where, lispobj object) { if (HeaderValue(object) == subtype_VectorValidHashing) { @@ -514,7 +552,7 @@ #define WEAK_POINTER_NWORDS \ CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2) -static long +static int scav_weak_pointer(lispobj *where, lispobj object) { /* Do not let GC scavenge the value slot of the weak pointer */ Index: coreparse.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/coreparse.c,v retrieving revision 1.23 retrieving revision 1.23.16.1 diff -u -d -r1.23 -r1.23.16.1 --- coreparse.c 5 Apr 2004 23:16:36 -0000 1.23 +++ coreparse.c 11 Jan 2005 18:02:48 -0000 1.23.16.1 @@ -41,7 +41,7 @@ ; static void -process_directory(int fd, u32 *ptr, int count) +process_directory(int fd, lispobj *ptr, int count) { struct ndir_entry *entry; @@ -69,7 +69,7 @@ } } - FSHOW((stderr, "/space id = %d, free pointer = 0x%08x\n", + FSHOW((stderr, "/space id = %d, free pointer = 0x%08lx\n", id, (long)free_pointer)); switch (id) { @@ -135,7 +135,7 @@ exit(1); } - header = calloc(os_vm_page_size / sizeof(u32), sizeof(u32)); + header = calloc(os_vm_page_size / N_WORD_BYTES, N_WORD_BYTES); count = read(fd, header, os_vm_page_size); if (count < os_vm_page_size) { @@ -209,13 +209,13 @@ SHOW("NEW_DIRECTORY_CORE_ENTRY_TYPE_CODE case"); process_directory(fd, ptr, -#ifndef alpha remaining_len / (sizeof(struct ndir_entry) / + /* FIXME: this should be + * something like + * sizeof(uword) + * where `uword' is + * appropriately typedef'd */ sizeof(long)) -#else - remaining_len / (sizeof(struct ndir_entry) / - sizeof(u32)) -#endif ); break; @@ -229,7 +229,7 @@ } ptr += remaining_len; - FSHOW((stderr, "/new ptr=%x\n", ptr)); + FSHOW((stderr, "/new ptr=%lx\n", ptr)); } SHOW("about to free(header)"); free(header); Index: gc-common.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/gc-common.c,v retrieving revision 1.21 retrieving revision 1.21.2.1 diff -u -d -r1.21 -r1.21.2.1 --- gc-common.c 6 Jan 2005 12:48:03 -0000 1.21 +++ gc-common.c 11 Jan 2005 18:02:48 -0000 1.21.2.1 @@ -37,7 +37,6 @@ #include "validate.h" #include "lispregs.h" #include "arch.h" -#include "fixnump.h" #include "gc.h" #include "genesis/primitive-objects.h" #include "genesis/static-symbols.h" @@ -81,9 +80,9 @@ return newspace_copy; } [...962 lines suppressed...] sizetab[SIMPLE_ARRAY_NIL_WIDETAG] = size_vector_nil; @@ -1948,9 +1880,6 @@ size_vector_complex_long_float; #endif sizetab[COMPLEX_BASE_STRING_WIDETAG] = size_boxed; -#ifdef COMPLEX_CHARACTER_STRING_WIDETAG - sizetab[COMPLEX_CHARACTER_STRING_WIDETAG] = size_boxed; -#endif sizetab[COMPLEX_VECTOR_NIL_WIDETAG] = size_boxed; sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed; sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed; @@ -1965,7 +1894,7 @@ sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed; sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed; sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed; - sizetab[CHARACTER_WIDETAG] = size_immediate; + sizetab[BASE_CHAR_WIDETAG] = size_immediate; sizetab[SAP_WIDETAG] = size_unboxed; sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate; sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer; Index: gc-internal.h =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/gc-internal.h,v retrieving revision 1.11 retrieving revision 1.11.2.1 diff -u -d -r1.11 -r1.11.2.1 --- gc-internal.h 6 Jan 2005 12:48:03 -0000 1.11 +++ gc-internal.h 11 Jan 2005 18:02:48 -0000 1.11.2.1 @@ -30,13 +30,13 @@ #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1))) -static inline unsigned long -NWORDS(unsigned long x, unsigned long n_bits) +static inline unsigned int +NWORDS(unsigned int x, unsigned int n_bits) { /* A good compiler should be able to constant-fold this whole thing, even with the conditional. */ if(n_bits <= N_WORD_BITS) { - unsigned long elements_per_word = N_WORD_BITS/n_bits; + unsigned int elements_per_word = N_WORD_BITS/n_bits; return CEILING(x, elements_per_word)/elements_per_word; } @@ -48,17 +48,6 @@ } /* FIXME: Shouldn't this be defined in sbcl.h? */ - -/* FIXME (1) this could probably be defined using something like - * sizeof(lispobj)*floor(sizeof(struct simple_fun)/sizeof(lispobj)) - * - FUN_POINTER_LOWTAG - * as I'm reasonably sure that simple_fun->code must always be the - * last slot in the object - - * FIXME (2) it also appears in purify.c, and it has a different value - * for SPARC users in that bit - */ - #define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - FUN_POINTER_LOWTAG) /* values for the *_alloc_* parameters */ @@ -71,28 +60,26 @@ #define ALLOC_UNBOXED 1 #define ALLOC_QUICK 1 -void *gc_general_alloc(long nbytes,int unboxed_p,int quick_p); +void *gc_general_alloc(int nbytes,int unboxed_p,int quick_p); -extern long (*scavtab[256])(lispobj *where, lispobj object); +extern int (*scavtab[256])(lispobj *where, lispobj object); extern lispobj (*transother[256])(lispobj object); -extern long (*sizetab[256])(lispobj *where); +extern int (*sizetab[256])(lispobj *where); extern struct weak_pointer *weak_pointers; /* in gc-common.c */ extern void scavenge(lispobj *start, long n_words); extern void scan_weak_pointers(void); -lispobj copy_large_unboxed_object(lispobj object, long nwords); -lispobj copy_unboxed_object(lispobj object, long nwords); -lispobj copy_large_object(lispobj object, long nwords); -lispobj copy_object(lispobj object, long nwords); +lispobj copy_large_unboxed_object(lispobj object, int nwords); +lispobj copy_unboxed_object(lispobj object, int nwords); +lispobj copy_large_object(lispobj object, int nwords); +lispobj copy_object(lispobj object, int nwords); lispobj *search_read_only_space(void *pointer); lispobj *search_static_space(void *pointer); lispobj *search_dynamic_space(void *pointer); -#include "fixnump.h" - /* Scan an area looking for an object which encloses the given pointer. * Return the object start on success or NULL on failure. */ static lispobj * @@ -105,7 +92,7 @@ /* If thing is an immediate then this is a cons. */ if (is_lisp_pointer(thing) || (fixnump(thing)) - || (widetag_of(thing) == CHARACTER_WIDETAG) + || (widetag_of(thing) == BASE_CHAR_WIDETAG) || (widetag_of(thing) == UNBOUND_MARKER_WIDETAG)) count = 2; else Index: globals.h =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/globals.h,v retrieving revision 1.19 retrieving revision 1.19.10.1 diff -u -d -r1.19 -r1.19.10.1 --- globals.h 10 Aug 2004 00:20:46 -0000 1.19 +++ globals.h 11 Jan 2005 18:02:48 -0000 1.19.10.1 @@ -58,6 +58,9 @@ #ifdef __linux__ #define EXTERN(name,bytes) .globl name #endif +#ifdef osf1 +#define EXTERN(name,bytes) .globl name +#endif #endif #ifdef ppc #ifdef LISP_FEATURE_DARWIN @@ -81,16 +84,16 @@ * done -dan 2002.05.07 */ -EXTERN(foreign_function_call_active, 4) +EXTERN(foreign_function_call_active, N_WORD_BYTES) -EXTERN(current_control_stack_pointer, 4) -EXTERN(current_control_frame_pointer, 4) -EXTERN(current_binding_stack_pointer, 4) -EXTERN(dynamic_space_free_pointer, 4) -EXTERN(current_dynamic_space, 4) +EXTERN(current_control_stack_pointer, N_WORD_BYTES) +EXTERN(current_control_frame_pointer, N_WORD_BYTES) +EXTERN(current_binding_stack_pointer, N_WORD_BYTES) +EXTERN(dynamic_space_free_pointer, N_WORD_BYTES) +EXTERN(current_dynamic_space, N_WORD_BYTES) #ifdef mips -EXTERN(current_flags_register, 4) +EXTERN(current_flags_register, N_WORD_BYTES) #endif #endif /* LANGUAGE_ASSEMBLY */ Index: interrupt.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/interrupt.c,v retrieving revision 1.67 retrieving revision 1.67.2.1 diff -u -d -r1.67 -r1.67.2.1 --- interrupt.c 6 Jan 2005 12:48:03 -0000 1.67 +++ interrupt.c 11 Jan 2005 18:02:48 -0000 1.67.2.1 @@ -161,7 +161,7 @@ void build_fake_control_stack_frames(struct thread *th,os_context_t *context) { -#ifndef LISP_FEATURE_C_STACK_IS_CONTROL_STACK +#ifndef LISP_FEATURE_X86 lispobj oldcont; @@ -219,9 +219,9 @@ #ifdef reg_ALLOC dynamic_space_free_pointer = (lispobj *)(*os_context_register_addr(context, reg_ALLOC)); -#ifdef alpha +#if 0 if ((long)dynamic_space_free_pointer & 1) { - lose("dead in fake_foreign_function_call, context = %x", context); + lose("dead in fake_foreign_function_call, context = %lx", context); } #endif #endif @@ -364,11 +364,13 @@ { os_context_t *context = (os_context_t*)void_context; struct thread *thread=arch_os_get_current_thread(); -#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) +#ifndef LISP_FEATURE_X86 boolean were_in_lisp; #endif union interrupt_handler handler; + FSHOW((stderr, "/interrupted at %#lx\n", *os_context_pc_addr(context))); + #ifdef LISP_FEATURE_LINUX /* Under Linux on some architectures, we appear to have to restore the FPU control word from the context, as after the signal is @@ -381,7 +383,7 @@ return; } -#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) +#ifndef LISP_FEATURE_X86 were_in_lisp = !foreign_function_call_active; if (were_in_lisp) #endif @@ -440,7 +442,7 @@ (*handler.c)(signal, info, void_context); } -#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) +#ifndef LISP_FEATURE_X86 if (were_in_lisp) #endif { @@ -481,7 +483,7 @@ * actually use its argument for anything on x86, so this branch * may succeed even when context is null (gencgc alloc()) */ if ( -#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) +#ifndef LISP_FEATURE_X86 (!foreign_function_call_active) && #endif arch_pseudo_atomic_atomic(context)) { @@ -625,31 +627,10 @@ #ifdef LISP_FEATURE_X86 /* Suppose the existence of some function that saved all * registers, called call_into_lisp, then restored GP registers and - * returned. It would look something like this: - - push ebp - mov ebp esp - pushad - push $0 - push $0 - pushl {address of function to call} - call 0x8058db0 <call_into_lisp> - addl $12,%esp - popa - leave - ret - - * What we do here is set up the stack that call_into_lisp would - * expect to see if it had been called by this code, and frob the - * signal context so that signal return goes directly to call_into_lisp, - * and when that function (and the lisp function it invoked) returns, - * it returns to the second half of this imaginary function which - * restores all registers and returns to C - - * For this to work, the latter part of the imaginary function - * must obviously exist in reality. That would be post_signal_tramp + * returned. We shortcut this: fake the stack that call_into_lisp + * would see, then arrange to have it called directly. post_signal_tramp + * is the second half of this function */ - u32 *sp=(u32 *)*os_context_register_addr(context,reg_ESP); *(sp-14) = post_signal_tramp; /* return address for call_into_lisp */ @@ -659,9 +640,9 @@ /* this order matches that used in POPAD */ *(sp-10)=*os_context_register_addr(context,reg_EDI); *(sp-9)=*os_context_register_addr(context,reg_ESI); - - *(sp-8)=*os_context_register_addr(context,reg_ESP)-8; - *(sp-7)=0; + /* this gets overwritten again before it's used, anyway */ + *(sp-8)=*os_context_register_addr(context,reg_EBP); + *(sp-7)=0 ; /* POPAD doesn't set ESP, but expects a gap for it anyway */ *(sp-6)=*os_context_register_addr(context,reg_EBX); *(sp-5)=*os_context_register_addr(context,reg_EDX); @@ -679,13 +660,7 @@ *os_context_pc_addr(context) = call_into_lisp; *os_context_register_addr(context,reg_ECX) = 0; *os_context_register_addr(context,reg_EBP) = sp-2; -#ifdef __NetBSD__ - *os_context_register_addr(context,reg_UESP) = sp-14; -#else *os_context_register_addr(context,reg_ESP) = sp-14; -#endif -#elif defined(LISP_FEATURE_X86_64) - lose("deferred gubbins still needs to be written"); #else /* this much of the calling convention is common to all non-x86 ports */ @@ -722,41 +697,22 @@ { /* called when a child thread exits */ mark_dead_threads(); } + #endif -boolean handle_guard_page_triggered(os_context_t *context,void *addr){ +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 >= CONTROL_STACK_GUARD_PAGE(th) && - addr < CONTROL_STACK_GUARD_PAGE(th) + os_vm_page_size) { - /* We hit the end of the control stack: disable guard page - * protection so the error handler has some headroom, protect the - * previous page so that we can catch returns from the guard page - * and restore it. */ - protect_control_stack_guard_page(th->pid,0); - protect_control_stack_return_guard_page(th->pid,1); - - arrange_return_to_lisp_function - (context, SymbolFunction(CONTROL_STACK_EXHAUSTED_ERROR)); - return 1; - } - else if(addr >= CONTROL_STACK_RETURN_GUARD_PAGE(th) && - addr < CONTROL_STACK_RETURN_GUARD_PAGE(th) + os_vm_page_size) { - /* We're returning from the guard page: reprotect it, and - * unprotect this one. This works even if we somehow missed - * the return-guard-page, and hit it on our way to new - * exhaustion instead. */ - protect_control_stack_guard_page(th->pid,1); - protect_control_stack_return_guard_page(th->pid,0); - return 1; - } - else if (addr >= undefined_alien_address && - addr < undefined_alien_address + os_vm_page_size) { + if(addr>=(void *)CONTROL_STACK_GUARD_PAGE(th) && + addr<(void *)(CONTROL_STACK_GUARD_PAGE(th)+os_vm_page_size)) { + /* we hit the end of the control stack. disable protection + * temporarily so the error handler has some headroom */ + protect_control_stack_guard_page(th->pid,0L); + arrange_return_to_lisp_function - (context, SymbolFunction(UNDEFINED_ALIEN_ERROR)); + (context, SymbolFunction(CONTROL_STACK_EXHAUSTED_ERROR)); return 1; } else return 0; Index: parse.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/parse.c,v retrieving revision 1.14 retrieving revision 1.14.2.1 diff -u -d -r1.14 -r1.14.2.1 --- parse.c 6 Jan 2005 12:48:03 -0000 1.14 +++ parse.c 11 Jan 2005 18:02:48 -0000 1.14.2.1 @@ -223,14 +223,14 @@ printf("unknown variable: ``%s''\n", token); throw_to_monitor(); } - result &= ~7; + result &= ~LOWTAG_MASK; } else { if (!string_to_long(token, &result)) { printf("invalid number: ``%s''\n", token); throw_to_monitor(); } - result &= ~3; + result &= ~FIXNUM_TAG_MASK; } if (!is_valid_lisp_addr((os_vm_address_t)result)) { @@ -258,7 +258,7 @@ /* Search dynamic space. */ headerptr = (lispobj *)DYNAMIC_SPACE_START; -#if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)) +#if !defined(LISP_FEATURE_X86) count = dynamic_space_free_pointer - (lispobj *)DYNAMIC_SPACE_START; @@ -322,7 +322,7 @@ int regnum; os_context_t *context; - free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)>>2; + free = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,thread)); if (free == 0) { printf("Variable ``%s'' is not valid -- there is no current interrupt context.\n", token); Index: purify.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/purify.c,v retrieving revision 1.45 retrieving revision 1.45.2.1 diff -u -d -r1.45 -r1.45.2.1 --- purify.c 6 Jan 2005 12:48:03 -0000 1.45 +++ purify.c 11 Jan 2005 18:02:48 -0000 1.45.2.1 @@ -27,7 +27,6 @@ #include "interrupt.h" #include "purify.h" #include "interr.h" -#include "fixnump.h" #include "gc.h" #include "gc-internal.h" #include "thread.h" @@ -66,7 +65,7 @@ static lispobj *read_only_free, *static_free; -static lispobj *pscav(lispobj *addr, long nwords, boolean constant); +static lispobj *pscav(lispobj *addr, int nwords, boolean constant); #define LATERBLOCKSIZE 1020 #define LATERMAXCOUNT 10 @@ -76,16 +75,10 @@ struct later *next; union { lispobj *ptr; - long count; + int count; } u[LATERBLOCKSIZE]; } *later_blocks = NULL; -static long later_count = 0; - -#if N_WORD_BITS == 32 - #define SIMPLE_ARRAY_WORD_WIDETAG SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG -#elif N_WORD_BITS == 64 - #define SIMPLE_ARRAY_WORD_WIDETAG SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG -#endif +static int later_count = 0; /* FIXME: Shouldn't this be defined in sbcl.h? See also notes in * cheneygc.c */ @@ -121,7 +114,7 @@ } static inline lispobj * -newspace_alloc(long nwords, int constantp) +newspace_alloc(int nwords, int constantp) { lispobj *ret; nwords=CEILING(nwords,2); @@ -137,7 +130,7 @@ -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) +#ifdef LISP_FEATURE_X86 #ifdef LISP_FEATURE_GENCGC /* @@ -179,85 +172,84 @@ break; case CLOSURE_HEADER_WIDETAG: case FUNCALLABLE_INSTANCE_HEADER_WIDETAG: - if ((long)pointer != ((long)start_addr+FUN_POINTER_LOWTAG)) { + if ((int)pointer != ((int)start_addr+FUN_POINTER_LOWTAG)) { if (pointer_filter_verbose) { - fprintf(stderr,"*Wf2: %x %x %x\n", - (unsigned long) pointer, - (unsigned long) start_addr, *start_addr); + fprintf(stderr,"*Wf2: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } break; default: if (pointer_filter_verbose) { - fprintf(stderr,"*Wf3: %x %x %x\n", (unsigned long) pointer, - (unsigned long) start_addr, *start_addr); + fprintf(stderr,"*Wf3: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } break; case LIST_POINTER_LOWTAG: - if ((long)pointer != ((long)start_addr+LIST_POINTER_LOWTAG)) { + if ((int)pointer != ((int)start_addr+LIST_POINTER_LOWTAG)) { if (pointer_filter_verbose) - fprintf(stderr,"*Wl1: %x %x %x\n", (unsigned long) pointer, - (unsigned long) start_addr, *start_addr); + fprintf(stderr,"*Wl1: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); return 0; } /* Is it plausible cons? */ if ((is_lisp_pointer(start_addr[0]) - || ((start_addr[0] & 3) == 0) /* fixnum */ - || (widetag_of(start_addr[0]) == CHARACTER_WIDETAG) + || (fixnump(start_addr[0])) + || (widetag_of(start_addr[0]) == BASE_CHAR_WIDETAG) || (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG)) && (is_lisp_pointer(start_addr[1]) - || ((start_addr[1] & 3) == 0) /* fixnum */ - || (widetag_of(start_addr[1]) == CHARACTER_WIDETAG) + || (fixnump(start_addr[1])) + || (widetag_of(start_addr[1]) == BASE_CHAR_WIDETAG) || (widetag_of(start_addr[1]) == UNBOUND_MARKER_WIDETAG))) { break; } else { if (pointer_filter_verbose) { - fprintf(stderr,"*Wl2: %x %x %x\n", (unsigned long) pointer, - (unsigned long) start_addr, *start_addr); + fprintf(stderr,"*Wl2: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } case INSTANCE_POINTER_LOWTAG: - if ((long)pointer != ((long)start_addr+INSTANCE_POINTER_LOWTAG)) { + if ((int)pointer != ((int)start_addr+INSTANCE_POINTER_LOWTAG)) { if (pointer_filter_verbose) { - fprintf(stderr,"*Wi1: %x %x %x\n", (unsigned long) pointer, - (unsigned long) start_addr, *start_addr); + fprintf(stderr,"*Wi1: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } if (widetag_of(start_addr[0]) != INSTANCE_HEADER_WIDETAG) { if (pointer_filter_verbose) { - fprintf(stderr,"*Wi2: %x %x %x\n", (unsigned long) pointer, - (unsigned long) start_addr, *start_addr); + fprintf(stderr,"*Wi2: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } break; case OTHER_POINTER_LOWTAG: - if ((long)pointer != ((long)start_addr+OTHER_POINTER_LOWTAG)) { + if ((int)pointer != ((int)start_addr+OTHER_POINTER_LOWTAG)) { if (pointer_filter_verbose) { - fprintf(stderr,"*Wo1: %x %x %x\n", (unsigned long) pointer, - (unsigned long) start_addr, *start_addr); + fprintf(stderr,"*Wo1: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } /* Is it plausible? Not a cons. XXX should check the headers. */ - if (is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0)) { + if (is_lisp_pointer(start_addr[0]) || (fixnump(start_addr[0]))) { if (pointer_filter_verbose) { - fprintf(stderr,"*Wo2: %x %x %x\n", (unsigned long) pointer, - (unsigned long) start_addr, *start_addr); + fprintf(stderr,"*Wo2: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } switch (widetag_of(start_addr[0])) { case UNBOUND_MARKER_WIDETAG: - case CHARACTER_WIDETAG: + case BASE_CHAR_WIDETAG: if (pointer_filter_verbose) { - fprintf(stderr,"*Wo3: %x %x %x\n", (unsigned long) pointer, - (unsigned long) start_addr, *start_addr); + fprintf(stderr,"*Wo3: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; @@ -265,15 +257,15 @@ case CLOSURE_HEADER_WIDETAG: case FUNCALLABLE_INSTANCE_HEADER_WIDETAG: if (pointer_filter_verbose) { - fprintf(stderr,"*Wo4: %x %x %x\n", (unsigned long) pointer, - (unsigned long) start_addr, *start_addr); + fprintf(stderr,"*Wo4: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; case INSTANCE_HEADER_WIDETAG: if (pointer_filter_verbose) { - fprintf(stderr,"*Wo5: %x %x %x\n", (unsigned long) pointer, - (unsigned long) start_addr, *start_addr); + fprintf(stderr,"*Wo5: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; @@ -292,9 +284,6 @@ #endif case SIMPLE_ARRAY_WIDETAG: case COMPLEX_BASE_STRING_WIDETAG: -#ifdef COMPLEX_CHARACTER_STRING_WIDETAG - case COMPLEX_CHARACTER_STRING_WIDETAG: -#endif case COMPLEX_VECTOR_NIL_WIDETAG: case COMPLEX_BIT_VECTOR_WIDETAG: case COMPLEX_VECTOR_WIDETAG: @@ -311,9 +300,6 @@ #endif case SIMPLE_ARRAY_NIL_WIDETAG: case SIMPLE_BASE_STRING_WIDETAG: -#ifdef SIMPLE_CHARACTER_STRING_WIDETAG - case SIMPLE_CHARACTER_STRING_WIDETAG: -#endif case SIMPLE_BIT_VECTOR_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG: @@ -326,15 +312,6 @@ #endif case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG: case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG: -#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG - case SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG: -#endif -#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG - case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG: -#endif -#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG - case SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG: -#endif #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG: #endif @@ -347,11 +324,16 @@ #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG: #endif +#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG + case SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG - case SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG: + case SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG: #endif #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG - case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG: + case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG: +#endif #endif case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG: case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG: @@ -373,16 +355,16 @@ default: if (pointer_filter_verbose) { - fprintf(stderr,"*Wo6: %x %x %x\n", (unsigned long) pointer, - (unsigned long) start_addr, *start_addr); + fprintf(stderr,"*Wo6: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } break; default: if (pointer_filter_verbose) { - fprintf(stderr,"*W?: %x %x %x\n", (unsigned long) pointer, - (unsigned long) start_addr, *start_addr); + fprintf(stderr,"*W?: %x %x %x\n", (unsigned int) pointer, + (unsigned int) start_addr, *start_addr); } return 0; } @@ -393,12 +375,12 @@ #define MAX_STACK_POINTERS 256 lispobj *valid_stack_locations[MAX_STACK_POINTERS]; -unsigned long num_valid_stack_locations; +unsigned int num_valid_stack_locations; #define MAX_STACK_RETURN_ADDRESSES 128 lispobj *valid_stack_ra_locations[MAX_STACK_RETURN_ADDRESSES]; lispobj *valid_stack_ra_code_objects[MAX_STACK_RETURN_ADDRESSES]; -unsigned long num_valid_stack_ra_locations; +unsigned int num_valid_stack_ra_locations; /* Identify valid stack slots. */ static void @@ -425,7 +407,7 @@ MAX_STACK_RETURN_ADDRESSES); valid_stack_ra_locations[num_valid_stack_ra_locations] = sp; valid_stack_ra_code_objects[num_valid_stack_ra_locations++] = - (lispobj *)((long)start_addr + OTHER_POINTER_LOWTAG); + (lispobj *)((int)start_addr + OTHER_POINTER_LOWTAG); } else { if (valid_dynamic_space_pointer((void *)thing, start_addr)) { gc_assert(num_valid_stack_locations < MAX_STACK_POINTERS); @@ -445,7 +427,7 @@ static void pscav_i386_stack(void) { - long i; + int i; for (i = 0; i < num_valid_stack_locations; i++) pscav(valid_stack_locations[i], 1, 0); @@ -456,13 +438,13 @@ if (pointer_filter_verbose) { fprintf(stderr,"*C moved RA %x to %x; for code object %x to %x\n", *valid_stack_ra_locations[i], - (long)(*valid_stack_ra_locations[i]) - - ((long)valid_stack_ra_code_objects[i] - (long)code_obj), - (unsigned long) valid_stack_ra_code_objects[i], code_obj); + (int)(*valid_stack_ra_locations[i]) + - ((int)valid_stack_ra_code_objects[i] - (int)code_obj), + (unsigned int) valid_stack_ra_code_objects[i], code_obj); } *valid_stack_ra_locations[i] = - ((long)(*valid_stack_ra_locations[i]) - - ((long)valid_stack_ra_code_objects[i] - (long)code_obj)); + ((int)(*valid_stack_ra_locations[i]) + - ((int)valid_stack_ra_code_objects[i] - (int)code_obj)); } } #endif @@ -470,7 +452,7 @@ static void -pscav_later(lispobj *where, long count) +pscav_later(lispobj *where, int count) { struct later *new; @@ -501,10 +483,10 @@ static lispobj ptrans_boxed(lispobj thing, lispobj header, boolean constant) { - long nwords; + int nwords; lispobj result, *new, *old; - nwords = CEILING(1 + HeaderValue(header), 2); + nwords = 1 + HeaderValue(header); /* Allocate it */ old = (lispobj *)native_pointer(thing); @@ -544,10 +526,10 @@ * space placed into it (e.g. the cache-name slot), but * the lists and arrays at the time of a purify can be * moved to the RO space. */ - long nwords; + int nwords; lispobj result, *new, *old; - nwords = CEILING(1 + HeaderValue(header), 2); + nwords = 1 + HeaderValue(header); /* Allocate it */ old = (lispobj *)native_pointer(thing); @@ -574,11 +556,11 @@ static lispobj ptrans_fdefn(lispobj thing, lispobj header) { - long nwords; + int nwords; lispobj result, *new, *old, oldfn; struct fdefn *fdefn; - nwords = CEILING(1 + HeaderValue(header), 2); + nwords = 1 + HeaderValue(header); /* Allocate it */ old = (lispobj *)native_pointer(thing); @@ -604,10 +586,10 @@ static lispobj ptrans_unboxed(lispobj thing, lispobj header) { - long nwords; + int nwords; lispobj result, *new, *old; - nwords = CEILING(1 + HeaderValue(header), 2); + nwords = 1 + HeaderValue(header); /* Allocate it */ old = (lispobj *)native_pointer(thing); @@ -624,24 +606,17 @@ } static lispobj -ptrans_vector(lispobj thing, long bits, long extra, +ptrans_vector(lispobj thing, int bits, int extra, boolean boxed, boolean constant) { struct vector *vector; - long nwords; + int nwords; lispobj result, *new; - long length; vector = (struct vector *)native_pointer(thing); - length = fixnum_value(vector->length)+extra; - // Argh, handle simple-vector-nil separately. - if (bits == 0) { - nwords = 2; - } else { - nwords = CEILING(NWORDS(length, bits) + 2, 2); - } + nwords = 2 + NWORDS(fixnum_value(vector->length)+extra, bits); - new=newspace_alloc(nwords, (constant || !boxed)); + new = newspace_alloc(nwords, (constant || !boxed)); bcopy(vector, new, nwords * sizeof(lispobj)); result = make_lispobj(new, lowtag_of(thing)); @@ -653,11 +628,11 @@ return result; } -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) +#ifdef LISP_FEATURE_X86 static void apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) { - long nheader_words, ncode_words, nwords; + int nheader_words, ncode_words, nwords; void *constants_start_addr, *constants_end_addr; void *code_start_addr, *code_end_addr; lispobj fixups = NIL; @@ -668,7 +643,7 @@ nheader_words = HeaderValue(*(lispobj *)new_code); nwords = ncode_words + nheader_words; - constants_start_addr = (void *)new_code + 5 * N_WORD_BYTES; + constants_start_addr = (void *)new_code + 5*N_WORD_BYTES; constants_end_addr = (void *)new_code + nheader_words*N_WORD_BYTES; code_start_addr = (void *)new_code + nheader_words*N_WORD_BYTES; code_end_addr = (void *)new_code + nwords*N_WORD_BYTES; @@ -699,11 +674,12 @@ (struct vector *)native_pointer(*(lispobj *)fixups_vector); } - if (widetag_of(fixups_vector->header) == SIMPLE_ARRAY_WORD_WIDETAG) { + if (widetag_of(fixups_vector->header) == + SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG) { /* We got the fixups for the code block. Now work through the * vector, and apply a fixup at each address. */ - long length = fixnum_value(fixups_vector->length); - long i; + int length = fixnum_value(fixups_vector->length); + int i; for (i=0; i<length; i++) { unsigned offset = fixups_vector->data[i]; /* Now check the current value of offset. */ @@ -713,7 +689,7 @@ /* If it's within the old_code object then it must be an * absolute fixup (relative ones are not saved) */ if ((old_value>=(unsigned)old_code) - && (old_value<((unsigned)old_code + nwords * N_WORD_BYTES))) + && (old_value<((unsigned)old_code + nwords*N_WORD_BYTES))) /* So add the dispacement. */ *(unsigned *)((unsigned)code_start_addr + offset) = old_value + displacement; @@ -740,18 +716,17 @@ ptrans_code(lispobj thing) { struct code *code, *new; - long nwords; + int nwords; lispobj func, result; code = (struct code *)native_pointer(thing); - nwords = CEILING(HeaderValue(code->header) + fixnum_value(code->code_size), - 2); + nwords = HeaderValue(code->header) + fixnum_value(code->code_size); new = (struct code *)newspace_alloc(nwords,1); /* constant */ bcopy(code, new, nwords * sizeof(lispobj)); -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) +#ifdef LISP_FEATURE_X86 apply_code_fixups_during_purify(code,new); #endif @@ -796,13 +771,13 @@ gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG); gc_assert(!dynamic_pointer_p(func)); -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) +#ifdef LISP_FEATURE_X86 /* Temporarily convert the self pointer to a real function pointer. */ ((struct simple_fun *)native_pointer(func))->self -= FUN_RAW_ADDR_OFFSET; #endif pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1); -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) +#ifdef LISP_FEATURE_X86 ((struct simple_fun *)native_pointer(func))->self += FUN_RAW_ADDR_OFFSET; #endif @@ -815,7 +790,7 @@ static lispobj ptrans_func(lispobj thing, lispobj header) { - long nwords; + int nwords; lispobj code, *new, *old, result; struct simple_fun *function; @@ -847,7 +822,7 @@ } else { /* It's some kind of closure-like thing. */ - nwords = CEILING(1 + HeaderValue(header), 2); + nwords = 1 + HeaderValue(header); old = (lispobj *)native_pointer(thing); /* Allocate the new one. FINs *must* not go in read_only @@ -893,7 +868,7 @@ ptrans_list(lispobj thing, boolean constant) { struct cons *old, *new, *orig; - long length; + int length; orig = (struct cons *) newspace_alloc(0,constant); length = 0; @@ -949,9 +924,6 @@ case COMPLEX_WIDETAG: case SIMPLE_ARRAY_WIDETAG: case COMPLEX_BASE_STRING_WIDETAG: -#ifdef COMPLEX_CHARACTER_STRING_WIDETAG - case COMPLEX_CHARACTER_STRING_WIDETAG: -#endif case COMPLEX_BIT_VECTOR_WIDETAG: case COMPLEX_VECTOR_NIL_WIDETAG: case COMPLEX_VECTOR_WIDETAG: @@ -971,11 +943,6 @@ case SIMPLE_BASE_STRING_WIDETAG: return ptrans_vector(thing, 8, 1, 0, constant); -#ifdef SIMPLE_CHARACTER_STRING_WIDETAG - case SIMPLE_CHARACTER_STRING_WIDETAG: - return ptrans_vector(thing, 32, 1, 0, constant); -#endif - case SIMPLE_BIT_VECTOR_WIDETAG: return ptrans_vector(thing, 1, 0, 0, constant); @@ -1013,25 +980,19 @@ #endif return ptrans_vector(thing, 32, 0, 0, constant); -#if N_WORD_BITS == 64 -#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG - case SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG: -#endif -#ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG - case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG: -#endif #ifdef SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG - case SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG: -#endif + case SIMPLE_ARRAY_UNSIGNED_BYTE_64_WIDETAG: #ifdef SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG - case SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG: + case SIMPLE_ARRAY_SIGNED_BYTE_61_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_60_WIDETAG: #endif #ifdef SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG - case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG: + case SIMPLE_ARRAY_SIGNED_BYTE_64_WIDETAG: + case SIMPLE_ARRAY_UNSIGNED_BYTE_63_WIDETAG: #endif return ptrans_vector(thing, 64, 0, 0, constant); #endif - + case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG: return ptrans_vector(thing, 32, 0, 0, constant); @@ -1078,14 +1039,13 @@ return ptrans_fdefn(thing, header); default: - fprintf(stderr, "Invalid widetag: %d\n", widetag_of(header)); /* Should only come across other pointers to the above stuff. */ gc_abort(); return NIL; } } -static long +static int pscav_fdefn(struct fdefn *fdefn) { boolean fix_func; @@ -1098,15 +1058,14 @@ return sizeof(struct fdefn) / sizeof(lispobj); } -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) +#ifdef LISP_FEATURE_X86 /* now putting code objects in static space */ -static long +static int pscav_code(struct code*code) { - long nwords; + int nwords; lispobj func; - nwords = CEILING(HeaderValue(code->header) + fixnum_value(code->code_size), - 2); + nwords = HeaderValue(code->header) + fixnum_value(code->code_size); /* Arrange to scavenge the debug info later. */ pscav_later(&code->debug_info, 1); @@ -1122,14 +1081,14 @@ gc_assert(lowtag_of(func) == FUN_POINTER_LOWTAG); gc_assert(!dynamic_pointer_p(func)); -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) +#ifdef LISP_FEATURE_X86 /* Temporarily convert the self pointer to a real function * pointer. */ ((struct simple_fun *)native_pointer(func))->self -= FUN_RAW_ADDR_OFFSET; #endif pscav(&((struct simple_fun *)native_pointer(func))->self, 2, 1); -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) +#ifdef LISP_FEATURE_X86 ((struct simple_fun *)native_pointer(func))->self += FUN_RAW_ADDR_OFFSET; #endif @@ -1141,10 +1100,10 @@ #endif static lispobj * -pscav(lispobj *addr, long nwords, boolean constant) +pscav(lispobj *addr, int nwords, boolean constant) { lispobj thing, *thingp, header; - long count = 0; /* (0 = dummy init value to stop GCC warning) */ + int count = 0; /* (0 = dummy init value to stop GCC warning) */ struct vector *vector; while (nwords > 0) { @@ -1186,7 +1145,7 @@ } count = 1; } - else if (thing & FIXNUM_TAG_MASK) { + else if (thing & 3) { /* FIXME: 3? not 2? */ /* It's an other immediate. Maybe the header for an unboxed */ /* object. */ switch (widetag_of(thing)) { @@ -1198,7 +1157,7 @@ #endif case SAP_WIDETAG: /* It's an unboxed simple object. */ - count = CEILING(HeaderValue(thing)+1, 2); + count = HeaderValue(thing)+1; break; case SIMPLE_VECTOR_WIDETAG: @@ -1206,7 +1165,7 @@ *addr = (subtype_VectorMustRehash << N_WIDETAG_BITS) | SIMPLE_VECTOR_WIDETAG; } - count = 2; + count = 1; break; case SIMPLE_ARRAY_NIL_WIDETAG: @@ -1218,13 +1177,6 @@ count = CEILING(NWORDS(fixnum_value(vector->length)+1,8)+2,2); break; -#ifdef SIMPLE_CHARACTER_STRING_WIDETAG - case SIMPLE_CHARACTER_STRING_WIDETAG: - vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length)+1,32)+2,2); - break; -#endif - case SIMPLE_BIT_VECTOR_WIDETAG: vector = (struct vector *)addr; count = CEILING(NWORDS(fixnum_value(vector->length),1)+2,2); @@ -1288,8 +1240,7 @@ case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG: vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length), 32) + 2, - 2); + count = CEILING(NWORDS(fixnum_value(vector->length),32)+2,2); break; case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG: @@ -1297,8 +1248,7 @@ case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG: #endif vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length), 64) + 2, - 2); + count = CEILING(NWORDS(fixnum_value(vector->length),64)+2,2); break; #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG @@ -1316,8 +1266,7 @@ #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG: vector = (struct vector *)addr; - count = CEILING(NWORDS(fixnum_value(vector->length), 128) + 2, - 2); + count = CEILING(NWORDS(fixnum_value(vector->length),128)+2,2); break; #endif @@ -1334,7 +1283,7 @@ #endif case CODE_HEADER_WIDETAG: -#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) +#ifndef LISP_FEATURE_X86 gc_abort(); /* no code headers in static space */ #else count = pscav_code((struct code*)addr); @@ -1348,7 +1297,7 @@ gc_abort(); break; -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) +#ifdef LISP_FEATURE_X86 case CLOSURE_HEADER_WIDETAG: case FUNCALLABLE_INSTANCE_HEADER_WIDETAG: /* The function self pointer needs special care on the @@ -1397,7 +1346,7 @@ purify(lispobj static_roots, lispobj read_only_roots) { lispobj *clean; - long count, i; + int count, i; struct later *laters, *next; struct thread *thread; @@ -1426,7 +1375,7 @@ return 0; } -#if defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64) +#if defined(LISP_FEATURE_X86) dynamic_space_free_pointer = (lispobj*)SymbolValue(ALLOCATION_POINTER,0); #endif @@ -1441,7 +1390,7 @@ fflush(stdout); #endif -#if defined(LISP_FEATURE_GENCGC) && (defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)) +#if (defined(LISP_FEATURE_GENCGC) && defined(LISP_FEATURE_X86)) /* note this expects only one thread to be active. We'd have to * stop all the others in the same way as GC does if we wanted * PURIFY to work when >1 thread exists */ @@ -1465,7 +1414,7 @@ printf(" stack"); fflush(stdout); #endif -#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) +#ifndef LISP_FEATURE_X86 pscav((lispobj *)all_threads->control_stack_start, current_control_stack_pointer - all_threads->control_stack_start, @@ -1480,7 +1429,7 @@ printf(" bindings"); fflush(stdout); #endif -#if !(defined(LISP_FEATURE_X86) || defined(LISP_FEATURE_X86_64)) +#if !defined(LISP_FEATURE_X86) pscav( (lispobj *)all_threads->binding_stack_start, (lispobj *)current_binding_stack_pointer - all_threads->binding_stack_start, @@ -1560,7 +1509,7 @@ /* Zero the stack. Note that the stack is also zeroed by SUB-GC * calling SCRUB-CONTROL-STACK - this zeros the stack on the x86. */ -#if !defined(LISP_FEATURE_X86) && !defined(LISP_FEATURE_X86_64) +#ifndef LISP_FEATURE_X86 os_zero((os_vm_address_t) current_control_stack_pointer, (os_vm_size_t) ((all_threads->control_stack_end - Index: runtime.h =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/runtime.h,v retrieving revision 1.18 retrieving revision 1.18.2.1 diff -u -d -r1.18 -r1.18.2.1 --- runtime.h 6 Jan 2005 12:48:04 -0000 1.18 +++ runtime.h 11 Jan 2005 18:02:48 -0000 1.18.2.1 @@ -45,10 +45,13 @@ /* even on alpha, int happens to be 4 bytes. long is longer. */ /* FIXME: these names really shouldn't reflect their length and this is not quite right for some of the FFI stuff */ -typedef unsigned long u64; -typedef signed long s64; +#if 64 == N_WORD_BITS +typedef unsigned long u32; +typedef signed long s32; +#else typedef unsigned int u32; typedef signed int s32; +#endif /* this is an integral type the same length as a machine pointer */ typedef unsigned long pointer_sized_uint_t ; Index: thread.h =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/thread.h,v retrieving revision 1.13 retrieving revision 1.13.2.1 diff -u -d -r1.13 -r1.13.2.1 --- thread.h 6 Jan 2005 12:48:04 -0000 1.13 +++ thread.h 11 Jan 2005 18:02:48 -0000 1.13.2.1 @@ -12,7 +12,7 @@ #ifdef LISP_FEATURE_GENCGC #include "gencgc-alloc-region.h" #else -struct alloc_region { }; +struct alloc_region; #endif #include "genesis/symbol.h" #include "genesis/static-symbols.h" @@ -43,7 +43,7 @@ #define for_each_thread(th) for(th=all_threads;th;th=0) #endif -static inline lispobj SymbolValue(u64 tagged_symbol_pointer, void *thread) { +static inline lispobj SymbolValue(lispobj tagged_symbol_pointer, void *thread) { struct symbol *sym= (struct symbol *) (pointer_sized_uint_t)(tagged_symbol_pointer-OTHER_POINTER_LOWTAG); #ifdef LISP_FEATURE_SB_THREAD @@ -56,7 +56,7 @@ #endif return sym->value; } -static inline lispobj SymbolTlValue(u64 tagged_symbol_pointer, void *thread) { +static inline lispobj SymbolTlValue(lispobj tagged_symbol_pointer, void *thread) { struct symbol *sym= (struct symbol *) (pointer_sized_uint_t)(tagged_symbol_pointer-OTHER_POINTER_LOWTAG); #ifdef LISP_FEATURE_SB_THREAD @@ -67,7 +67,7 @@ #endif } -static inline void SetSymbolValue(u64 tagged_symbol_pointer,lispobj val, void *thread) { +static inline void SetSymbolValue(lispobj tagged_symbol_pointer,lispobj val, void *thread) { struct symbol *sym= (struct symbol *) (pointer_sized_uint_t)(tagged_symbol_pointer-OTHER_POINTER_LOWTAG); #ifdef LISP_FEATURE_SB_THREAD @@ -82,7 +82,7 @@ #endif sym->value = val; } -static inline void SetTlSymbolValue(u64 tagged_symbol_pointer,lispobj val, void *thread) { +static inline void SetTlSymbolValue(lispobj tagged_symbol_pointer,lispobj val, void *thread) { #ifdef LISP_FEATURE_SB_THREAD struct symbol *sym= (struct symbol *) (pointer_sized_uint_t)(tagged_symbol_pointer-OTHER_POINTER_LOWTAG); Index: wrap.c =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/runtime/wrap.c,v retrieving revision 1.14 retrieving revision 1.14.10.1 diff -u -d -r1.14 -r1.14.10.1 --- wrap.c 10 Aug 2004 00:20:47 -0000 1.14 +++ wrap.c 11 Jan 2005 18:02:48 -0000 1.14.10.1 @@ -156,7 +156,7 @@ * (2003-10-03) on all working platforms except MIPS and HPPA; if some * motivated spark would simply fix those, this hack could go away. * -- CSR, 2003-10-03 */ -typedef u32 ffi_dev_t; /* since Linux dev_t can be 64 bits */ +typedef int ffi_dev_t; /* since Linux dev_t can be 64 bits */ typedef u32 ffi_off_t; /* since OpenBSD 2.8 st_size is 64 bits */ /* a representation of stat(2) results which doesn't depend on CPU or OS */ @@ -168,7 +168,7 @@ * I remember when I was young and innocent, I read about how the * C preprocessor isn't to be used to globally munge random * lowercase symbols like this, because things like this could - * happen, and I nodded sagely. But now I know better.:-| This is + * happen, and I nodded sagely. But now I know better. :-| This is * another entry for Dan Barlow's ongoing episodic rant about C * header files, I guess.. -- WHN 2001-05-10 */ ffi_dev_t wrapped_st_dev; /* device */ @@ -211,8 +211,10 @@ { struct stat real_buf; int ret; + fprintf(stderr, "in stat_wrapper, buf=%#lx\n", buf); if ((ret = stat(file_name,&real_buf)) >= 0) copy_to_stat_wrapper(buf, &real_buf); + fprintf(stderr, "examined %s, ret=%d\n", file_name, ret); return ret; } @@ -221,6 +223,7 @@ { struct stat real_buf; int ret; + fprintf(stderr, "in lstat_wrapper"); if ((ret = lstat(file_name,&real_buf)) >= 0) copy_to_stat_wrapper(buf, &real_buf); return ret; @@ -231,6 +234,7 @@ { struct stat real_buf; int ret; + fprintf(stderr, "in fstat_wrapper"); if ((ret = fstat(filedes,&real_buf)) >= 0) copy_to_stat_wrapper(buf, &real_buf); return ret; |