From 9a8c1c2fff9faf402f71e9ac738934aca6fecf66 Mon Sep 17 00:00:00 2001 From: rtoy <rtoy> Date: Thu, 15 Sep 2005 18:26:53 +0000 Subject: [PATCH] Indent all source files using GNU indent using the config in .indent.pro. --- lisp/Darwin-os.c | 404 +- lisp/Darwin-os.h | 4 +- lisp/FreeBSD-os.c | 228 +- lisp/FreeBSD-os.h | 12 +- lisp/Linux-os.c | 417 +- lisp/Linux-os.h | 36 +- lisp/NetBSD-os.c | 348 +- lisp/NetBSD-os.h | 4 +- lisp/OpenBSD-os.c | 216 +- lisp/OpenBSD-os.h | 4 +- lisp/alloc.c | 55 +- lisp/alpha-arch.c | 425 +- lisp/amd64-arch.c | 426 +- lisp/arch.h | 14 +- lisp/backtrace.c | 619 ++- lisp/breakpoint.c | 194 +- lisp/breakpoint.h | 10 +- lisp/cgc.c | 2833 +++++------ lisp/cgc.h | 2 +- lisp/core.h | 22 +- lisp/coreparse.c | 90 +- lisp/darwin-lispadjuster.c | 113 +- lisp/dynbind.c | 47 +- lisp/dynbind.h | 4 +- lisp/elf.c | 154 +- lisp/gc.c | 2526 +++++----- lisp/gc.h | 4 +- lisp/gencgc.c | 9404 +++++++++++++++++++----------------- lisp/gencgc.h | 85 +- lisp/globals.c | 10 +- lisp/globals.h | 20 +- lisp/hppa-arch.c | 293 +- lisp/hpux-os.c | 433 +- lisp/interr.c | 117 +- lisp/interr.h | 4 +- lisp/interrupt.c | 475 +- lisp/interrupt.h | 25 +- lisp/irix-asm-munge.c | 136 +- lisp/irix-os.c | 81 +- lisp/lisp.c | 597 ++- lisp/mach-os.c | 117 +- lisp/mips-arch.c | 350 +- lisp/monitor.c | 445 +- lisp/os-common.c | 399 +- lisp/os.h | 18 +- lisp/osf1-os.c | 95 +- lisp/parse.c | 410 +- lisp/ppc-arch.c | 543 ++- lisp/ppc-darwin-dlshim.c | 109 +- lisp/ppc-lispregs.h | 4 +- lisp/ppc-validate.h | 16 +- lisp/print.c | 854 ++-- lisp/purify.c | 1812 +++---- lisp/runprog.c | 9 +- lisp/save.c | 72 +- lisp/search.c | 36 +- lisp/search.h | 6 +- lisp/socket.c | 167 +- lisp/solaris-os.c | 454 +- lisp/sparc-arch.c | 776 +-- lisp/sparc-lispregs.h | 4 +- lisp/sparc-validate.h | 22 +- lisp/sunos-os.c | 914 ++-- lisp/sunos-os.h | 4 +- lisp/time.c | 11 +- lisp/undefineds.c | 40 +- lisp/undefineds.h | 431 +- lisp/validate.c | 46 +- lisp/vars.c | 131 +- lisp/vars.h | 3 +- lisp/x86-arch.c | 416 +- lisp/x86-validate.h | 68 +- 72 files changed, 15324 insertions(+), 14349 deletions(-) diff --git a/lisp/Darwin-os.c b/lisp/Darwin-os.c index c22899c4e..b38cad025 100644 --- a/lisp/Darwin-os.c +++ b/lisp/Darwin-os.c @@ -14,7 +14,7 @@ * Frobbed for OpenBSD by Pierre R. Mai, 2001. * Frobbed for Darwin by Pierre R. Mai, 2003. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Darwin-os.c,v 1.4 2005/09/06 13:05:58 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Darwin-os.c,v 1.5 2005/09/15 18:26:50 rtoy Exp $ * */ @@ -46,8 +46,8 @@ vm_size_t os_vm_page_size; #define DPRINTF(t,a) {if (t) fprintf a;} - + /* * This is accessed by Lisp! Make this a static symbol? */ @@ -59,261 +59,311 @@ int cycles_per_tick = 1; * counter; we have to derive the relationship ourselves. */ -void timebase_init() +void +timebase_init() { - int mib[2]; - int tbfrequency; - int cpufrequency; - unsigned int miblen; - size_t len; + int mib[2]; + int tbfrequency; + int cpufrequency; + unsigned int miblen; + size_t len; - mib[0] = CTL_HW; + mib[0] = CTL_HW; #ifndef HW_TB_FREQ - /* - * Mac OS X 10.2.8 doesn't have this, so we take it from 10.3.8, - * which does. - */ + /* + * Mac OS X 10.2.8 doesn't have this, so we take it from 10.3.8, + * which does. + */ #define HW_TB_FREQ 23 -#endif - mib[1] = HW_TB_FREQ; - miblen = 2; - len = sizeof(tbfrequency); - - if (sysctl(mib, miblen, &tbfrequency, &len, NULL, 0) == -1) { - perror("Error getting HW_TB_FREQ from sysctl: "); - } - - mib[0] = CTL_HW; - mib[1] = HW_CPU_FREQ; - miblen = 2; - len = sizeof(cpufrequency); - if (sysctl(mib, miblen, &cpufrequency, &len, NULL, 0) == -1) { - perror("Error getting HW_CPU_FREQ from sysctl: "); - } - - cycles_per_tick = cpufrequency / tbfrequency; -} +#endif + mib[1] = HW_TB_FREQ; + miblen = 2; + len = sizeof(tbfrequency); + + if (sysctl(mib, miblen, &tbfrequency, &len, NULL, 0) == -1) { + perror("Error getting HW_TB_FREQ from sysctl: "); + } + mib[0] = CTL_HW; + mib[1] = HW_CPU_FREQ; + miblen = 2; + len = sizeof(cpufrequency); + if (sysctl(mib, miblen, &cpufrequency, &len, NULL, 0) == -1) { + perror("Error getting HW_CPU_FREQ from sysctl: "); + } + + cycles_per_tick = cpufrequency / tbfrequency; +} -void os_init(void) + +void +os_init(void) { - os_vm_page_size = OS_VM_DEFAULT_PAGESIZE; - timebase_init(); + os_vm_page_size = OS_VM_DEFAULT_PAGESIZE; + timebase_init(); } -int os_get_errno(void) +int +os_get_errno(void) { - return errno; + return errno; } -int os_set_errno(int newvalue) +int +os_set_errno(int newvalue) { - errno=newvalue; - return errno; + errno = newvalue; + return errno; } -int* sc_reg(os_context_t *context, int offset) +int * +sc_reg(os_context_t * context, int offset) { - ppc_saved_state_t *state = &context->uc_mcontext->ss; - switch(offset) - { - case 0: return &state->r0; - case 1: return &state->r1; - case 2: return &state->r2; - case 3: return &state->r3; - case 4: return &state->r4; - case 5: return &state->r5; - case 6: return &state->r6; - case 7: return &state->r7; - case 8: return &state->r8; - case 9: return &state->r9; - case 10: return &state->r10; - case 11: return &state->r11; - case 12: return &state->r12; - case 13: return &state->r13; - case 14: return &state->r14; - case 15: return &state->r15; - case 16: return &state->r16; - case 17: return &state->r17; - case 18: return &state->r18; - case 19: return &state->r19; - case 20: return &state->r20; - case 21: return &state->r21; - case 22: return &state->r22; - case 23: return &state->r23; - case 24: return &state->r24; - case 25: return &state->r25; - case 26: return &state->r26; - case 27: return &state->r27; - case 28: return &state->r28; - case 29: return &state->r29; - case 30: return &state->r30; - case 31: return &state->r31; - case 41: return &context->uc_mcontext->es.dar; - case 42: return &context->uc_mcontext->es.dsisr; - } - - return (int*)0; + ppc_saved_state_t *state = &context->uc_mcontext->ss; + + switch (offset) { + case 0: + return &state->r0; + case 1: + return &state->r1; + case 2: + return &state->r2; + case 3: + return &state->r3; + case 4: + return &state->r4; + case 5: + return &state->r5; + case 6: + return &state->r6; + case 7: + return &state->r7; + case 8: + return &state->r8; + case 9: + return &state->r9; + case 10: + return &state->r10; + case 11: + return &state->r11; + case 12: + return &state->r12; + case 13: + return &state->r13; + case 14: + return &state->r14; + case 15: + return &state->r15; + case 16: + return &state->r16; + case 17: + return &state->r17; + case 18: + return &state->r18; + case 19: + return &state->r19; + case 20: + return &state->r20; + case 21: + return &state->r21; + case 22: + return &state->r22; + case 23: + return &state->r23; + case 24: + return &state->r24; + case 25: + return &state->r25; + case 26: + return &state->r26; + case 27: + return &state->r27; + case 28: + return &state->r28; + case 29: + return &state->r29; + case 30: + return &state->r30; + case 31: + return &state->r31; + case 41: + return &context->uc_mcontext->es.dar; + case 42: + return &context->uc_mcontext->es.dsisr; + } + + return (int *) 0; } -void os_save_context(void) +void +os_save_context(void) { - /* - * Called from interrupt handlers so C stuff knows things set in Lisp. - */ + /* + * Called from interrupt handlers so C stuff knows things set in Lisp. + */ } -void os_set_context(void) +void +os_set_context(void) { } -os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len) +os_vm_address_t +os_validate(os_vm_address_t addr, os_vm_size_t len) { - int flags = MAP_PRIVATE | MAP_ANONYMOUS; + int flags = MAP_PRIVATE | MAP_ANONYMOUS; - if (addr) - flags |= MAP_FIXED; - else - flags |= MAP_VARIABLE; + if (addr) + flags |= MAP_FIXED; + else + flags |= MAP_VARIABLE; - DPRINTF(0, (stderr, "os_validate %x %d => ", addr, len)); + DPRINTF(0, (stderr, "os_validate %x %d => ", addr, len)); - addr = mmap(addr, len, OS_VM_PROT_ALL, flags, -1, 0); + addr = mmap(addr, len, OS_VM_PROT_ALL, flags, -1, 0); - if (addr == (os_vm_address_t) -1) - { - perror("mmap"); - return NULL; + if (addr == (os_vm_address_t) - 1) { + perror("mmap"); + return NULL; } - DPRINTF(0, (stderr, "%x\n", addr)); + DPRINTF(0, (stderr, "%x\n", addr)); - return addr; + return addr; } -void os_invalidate(os_vm_address_t addr, os_vm_size_t len) +void +os_invalidate(os_vm_address_t addr, os_vm_size_t len) { - DPRINTF(0, (stderr, "os_invalidate %x %d\n", addr, len)); + DPRINTF(0, (stderr, "os_invalidate %x %d\n", addr, len)); - if (munmap(addr, len) == -1) - perror("munmap"); + if (munmap(addr, len) == -1) + perror("munmap"); } -os_vm_address_t os_map(int fd, int offset, os_vm_address_t addr, - os_vm_size_t len) +os_vm_address_t +os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len) { - addr = mmap(addr, len, - OS_VM_PROT_ALL, - MAP_PRIVATE | MAP_FILE | MAP_FIXED, - fd, (off_t) offset); + addr = mmap(addr, len, + OS_VM_PROT_ALL, + MAP_PRIVATE | MAP_FILE | MAP_FIXED, fd, (off_t) offset); - if (addr == (os_vm_address_t) -1) - perror("mmap"); + if (addr == (os_vm_address_t) - 1) + perror("mmap"); - return addr; + return addr; } -void os_flush_icache(os_vm_address_t address, os_vm_size_t length) +void +os_flush_icache(os_vm_address_t address, os_vm_size_t length) { /* see ppc-arch.c */ - ppc_flush_icache(address,length); + ppc_flush_icache(address, length); } -void os_protect(os_vm_address_t address, os_vm_size_t length, - os_vm_prot_t prot) +void +os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot) { - if (mprotect(address, length, prot) == -1) - perror("mprotect"); + if (mprotect(address, length, prot) == -1) + perror("mprotect"); } - -static boolean in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen) + +static boolean +in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen) { - char* beg = (char*) sbeg; - char* end = (char*) sbeg + slen; - char* adr = (char*) a; - return (adr >= beg && adr < end); + char *beg = (char *) sbeg; + char *end = (char *) sbeg + slen; + char *adr = (char *) a; + + return (adr >= beg && adr < end); } -boolean valid_addr(os_vm_address_t addr) +boolean +valid_addr(os_vm_address_t addr) { - int ret; - os_vm_address_t newaddr; - newaddr = os_trunc_to_page(addr); - - 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_0_SPACE_START, dynamic_space_size ) - || in_range_p(addr, DYNAMIC_1_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 )) - return TRUE; - return FALSE; + int ret; + os_vm_address_t newaddr; + + newaddr = os_trunc_to_page(addr); + + 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_0_SPACE_START, dynamic_space_size) + || in_range_p(addr, DYNAMIC_1_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)) + return TRUE; + return FALSE; } - -static void sigsegv_handler(HANDLER_ARGS) + +static void +sigsegv_handler(HANDLER_ARGS) { #if defined GENCGC - caddr_t fault_addr = code->si_addr; - int page_index = find_page_index((void*)fault_addr); + caddr_t fault_addr = code->si_addr; + int page_index = find_page_index((void *) fault_addr); #if SIGSEGV_VERBOSE - fprintf(stderr,"Signal %d, fault_addr=%x, page_index=%d:\n", - signal, fault_addr, page_index); + fprintf(stderr, "Signal %d, fault_addr=%x, page_index=%d:\n", + signal, fault_addr, page_index); #endif - /* Check if the fault is within the dynamic space. */ - if (page_index != -1) { - /* Un-protect the page */ + /* Check if the fault is within the dynamic space. */ + if (page_index != -1) { + /* Un-protect the page */ - /* The page should have been marked write protected */ - if (!PAGE_WRITE_PROTECTED(page_index)) - fprintf(stderr, "*** Sigsegv in page not marked as write protected\n"); + /* The page should have been marked write protected */ + if (!PAGE_WRITE_PROTECTED(page_index)) + fprintf(stderr, + "*** Sigsegv in page not marked as write protected\n"); - os_protect(page_address(page_index), 4096, OS_VM_PROT_ALL); - page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK; - page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK; + os_protect(page_address(page_index), 4096, OS_VM_PROT_ALL); + page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK; + page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK; - return; + return; } #endif - SAVE_CONTEXT(); + SAVE_CONTEXT(); - DPRINTF(0, (stderr, "sigsegv:\n")); - if (!interrupt_maybe_gc(signal,code,context)) - interrupt_handle_now(signal, code, context); + DPRINTF(0, (stderr, "sigsegv:\n")); + if (!interrupt_maybe_gc(signal, code, context)) + interrupt_handle_now(signal, code, context); - /* Work around G5 bug; fix courtesy gbyers via chandler */ - sigreturn(context); + /* Work around G5 bug; fix courtesy gbyers via chandler */ + sigreturn(context); } -static void sigbus_handler(HANDLER_ARGS) +static void +sigbus_handler(HANDLER_ARGS) { - SAVE_CONTEXT(); + SAVE_CONTEXT(); - DPRINTF(0, (stderr, "sigbus:\n")); - if (!interrupt_maybe_gc(signal,code,context)) - interrupt_handle_now(signal, code, context); + DPRINTF(0, (stderr, "sigbus:\n")); + if (!interrupt_maybe_gc(signal, code, context)) + interrupt_handle_now(signal, code, context); - /* Work around G5 bug; fix courtesy gbyers via chandler */ - sigreturn(context); + /* Work around G5 bug; fix courtesy gbyers via chandler */ + sigreturn(context); } -void os_install_interrupt_handlers(void) +void +os_install_interrupt_handlers(void) { /* interrupt_install_low_level_handler(SIGSEGV, sigsegv_handler); */ - interrupt_install_low_level_handler(SIGBUS, sigbus_handler); + interrupt_install_low_level_handler(SIGBUS, sigbus_handler); } void map_core_sections(char *exec_name) { - fprintf(stderr,"Linked cores not supported for Darwin!\n"); - exit(1); + fprintf(stderr, "Linked cores not supported for Darwin!\n"); + exit(1); } #define RTLD_LAZY 1 @@ -321,23 +371,23 @@ map_core_sections(char *exec_name) #define RTLD_GLOBAL 0x100 -void *os_dlsym(const char *sym_name, lispobj lib_list) +void * +os_dlsym(const char *sym_name, lispobj lib_list) { static void *program_handle; void *sym_addr = 0; if (!program_handle) - program_handle = dlopen((void *)0, RTLD_LAZY | RTLD_GLOBAL); + program_handle = dlopen((void *) 0, RTLD_LAZY | RTLD_GLOBAL); if (lib_list != NIL) { lispobj lib_list_head; for (lib_list_head = lib_list; - lib_list_head != NIL; - lib_list_head = (CONS(lib_list_head))->cdr) { + lib_list_head != NIL; lib_list_head = (CONS(lib_list_head))->cdr) { struct cons *lib_cons = CONS(CONS(lib_list_head)->car); - struct sap *dlhandle = (struct sap *)PTR(lib_cons->car); + struct sap *dlhandle = (struct sap *) PTR(lib_cons->car); - sym_addr = dlsym((void *)dlhandle->pointer, sym_name); + sym_addr = dlsym((void *) dlhandle->pointer, sym_name); if (sym_addr) return sym_addr; } diff --git a/lisp/Darwin-os.h b/lisp/Darwin-os.h index b43270398..12b519356 100644 --- a/lisp/Darwin-os.h +++ b/lisp/Darwin-os.h @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Darwin-os.h,v 1.2 2005/01/13 19:55:00 fgilham Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Darwin-os.h,v 1.3 2005/09/15 18:26:50 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -38,7 +38,7 @@ typedef int os_vm_prot_t; #define GET_CONTEXT #define os_context_t ucontext_t -int* sc_reg(os_context_t *,int); +int *sc_reg(os_context_t *, int); #define PROTECTION_VIOLATION_SIGNAL SIGBUS diff --git a/lisp/FreeBSD-os.c b/lisp/FreeBSD-os.c index 26c486200..85817ee66 100644 --- a/lisp/FreeBSD-os.c +++ b/lisp/FreeBSD-os.c @@ -12,7 +12,7 @@ * Much hacked by Paul Werkowski * GENCGC support by Douglas Crosher, 1996, 1997. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/FreeBSD-os.c,v 1.10 2003/03/23 21:23:41 gerd Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/FreeBSD-os.c,v 1.11 2005/09/15 18:26:50 rtoy Exp $ * */ @@ -47,198 +47,198 @@ int errno; #endif vm_size_t os_vm_page_size; - + void -os_init (void) +os_init(void) { - os_vm_page_size = getpagesize (); + os_vm_page_size = getpagesize(); } int -sc_reg (struct sigcontext *c, int offset) +sc_reg(struct sigcontext *c, int offset) { - switch(offset) - { - case 0: return c->sc_eax; - case 2: return c->sc_ecx; - case 4: return c->sc_edx; - case 6: return c->sc_ebx; - case 8: return c->sc_esp; - case 10: return c->sc_ebp; - case 12: return c->sc_esi; - case 14: return c->sc_edi; + switch (offset) { + case 0: + return c->sc_eax; + case 2: + return c->sc_ecx; + case 4: + return c->sc_edx; + case 6: + return c->sc_ebx; + case 8: + return c->sc_esp; + case 10: + return c->sc_ebp; + case 12: + return c->sc_esi; + case 14: + return c->sc_edi; } - - return 0; + + return 0; } void -os_save_context (void) +os_save_context(void) { - /* Called from interrupt handlers so C stuff knows things set in - Lisp. */ + /* Called from interrupt handlers so C stuff knows things set in + Lisp. */ } void -os_set_context (void) +os_set_context(void) { } -os_vm_address_t -os_validate (os_vm_address_t addr, os_vm_size_t len) +os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len) { - int flags = MAP_PRIVATE | MAP_ANONYMOUS; + int flags = MAP_PRIVATE | MAP_ANONYMOUS; - if (addr) - flags |= MAP_FIXED; - else - flags |= MAP_VARIABLE; + if (addr) + flags |= MAP_FIXED; + else + flags |= MAP_VARIABLE; - addr = mmap (addr, len, OS_VM_PROT_ALL, flags, -1, 0); + addr = mmap(addr, len, OS_VM_PROT_ALL, flags, -1, 0); - if (addr == (os_vm_address_t) -1) - { - perror ("mmap"); - return NULL; + if (addr == (os_vm_address_t) - 1) { + perror("mmap"); + return NULL; } - return addr; + return addr; } void -os_invalidate (os_vm_address_t addr, os_vm_size_t len) +os_invalidate(os_vm_address_t addr, os_vm_size_t len) { - if (munmap (addr, len) == -1) - perror ("munmap"); + if (munmap(addr, len) == -1) + perror("munmap"); } os_vm_address_t -os_map (int fd, int offset, os_vm_address_t addr, - os_vm_size_t len) +os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len) { - addr = mmap (addr, len, OS_VM_PROT_ALL, - MAP_PRIVATE | MAP_FILE | MAP_FIXED, - fd, (off_t) offset); + addr = mmap(addr, len, OS_VM_PROT_ALL, + MAP_PRIVATE | MAP_FILE | MAP_FIXED, fd, (off_t) offset); - if (addr == (os_vm_address_t) -1) - perror ("mmap"); + if (addr == (os_vm_address_t) - 1) + perror("mmap"); - return addr; + return addr; } void -os_flush_icache (os_vm_address_t address, os_vm_size_t length) +os_flush_icache(os_vm_address_t address, os_vm_size_t length) { } void -os_protect (os_vm_address_t address, os_vm_size_t length, - os_vm_prot_t prot) +os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot) { - if (mprotect (address, length, prot) == -1) - perror ("mprotect"); + if (mprotect(address, length, prot) == -1) + perror("mprotect"); } - + static boolean -in_range_p (os_vm_address_t a, lispobj sbeg, size_t slen) +in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen) { - char *beg = (char *) sbeg; - char *end = (char *) sbeg + slen; - char *adr = (char *) a; - return adr >= beg && adr < end; + char *beg = (char *) sbeg; + char *end = (char *) sbeg + slen; + char *adr = (char *) a; + + return adr >= beg && adr < end; } -boolean -valid_addr (os_vm_address_t addr) +boolean valid_addr(os_vm_address_t addr) { - int ret; - os_vm_address_t newaddr; - newaddr = os_trunc_to_page (addr); + int ret; + os_vm_address_t newaddr; + + newaddr = os_trunc_to_page(addr); - 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_0_SPACE_START, dynamic_space_size) + 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_0_SPACE_START, dynamic_space_size) #ifndef GENCGC - || in_range_p (addr, DYNAMIC_1_SPACE_START, dynamic_space_size) + || in_range_p(addr, DYNAMIC_1_SPACE_START, dynamic_space_size) #endif - || in_range_p (addr, CONTROL_STACK_START, CONTROL_STACK_SIZE) - || in_range_p (addr, BINDING_STACK_START, BINDING_STACK_SIZE)) - return TRUE; - return FALSE; + || in_range_p(addr, CONTROL_STACK_START, CONTROL_STACK_SIZE) + || in_range_p(addr, BINDING_STACK_START, BINDING_STACK_SIZE)) + return TRUE; + return FALSE; } - + static void -sigbus_handler (int signal, int code, struct sigcontext *context, - void *fault_addr) +sigbus_handler(int signal, int code, struct sigcontext *context, + void *fault_addr) { - int page_index; - + int page_index; + #ifdef RED_ZONE_HIT - if (os_control_stack_overflow (fault_addr, context)) - return; + if (os_control_stack_overflow(fault_addr, context)) + return; #endif - + #if defined GENCGC - page_index = find_page_index(fault_addr); + page_index = find_page_index(fault_addr); - /* Check if the fault is within the dynamic space. */ - if (page_index != -1) - { - /* Un-protect the page */ + /* Check if the fault is within the dynamic space. */ + if (page_index != -1) { + /* Un-protect the page */ - /* The page should have been marked write protected */ - if (!PAGE_WRITE_PROTECTED (page_index)) - fprintf (stderr, "*** Sigbus in page not marked as write protected\n"); + /* The page should have been marked write protected */ + if (!PAGE_WRITE_PROTECTED(page_index)) + fprintf(stderr, + "*** Sigbus in page not marked as write protected\n"); - os_protect (page_address (page_index), 4096, OS_VM_PROT_ALL); - page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK; - page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK; + os_protect(page_address(page_index), 4096, OS_VM_PROT_ALL); + page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK; + page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK; - return; + return; } #endif /* GENCGC */ - interrupt_handle_now (signal, code, context); + interrupt_handle_now(signal, code, context); } static void -sigsegv_handler (int signal, int code, struct sigcontext *context) +sigsegv_handler(int signal, int code, struct sigcontext *context) { - interrupt_handle_now (signal, code, context); + interrupt_handle_now(signal, code, context); } void -os_install_interrupt_handlers (void) +os_install_interrupt_handlers(void) { - interrupt_install_low_level_handler - (SIGSEGV, (void (*) (HANDLER_ARGS)) sigsegv_handler); - interrupt_install_low_level_handler - (SIGBUS, (void (*) (HANDLER_ARGS)) sigbus_handler); + interrupt_install_low_level_handler + (SIGSEGV, (void (*)(HANDLER_ARGS)) sigsegv_handler); + interrupt_install_low_level_handler + (SIGBUS, (void (*)(HANDLER_ARGS)) sigbus_handler); } void * -os_dlsym (const char *sym_name, lispobj lib_list) +os_dlsym(const char *sym_name, lispobj lib_list) { - if (lib_list != NIL) - { - lispobj lib_list_head; - - for (lib_list_head = lib_list; - lib_list_head != NIL; - lib_list_head = CONS (lib_list_head)->cdr) - { - struct cons *lib_cons = CONS (CONS (lib_list_head)->car); - struct sap *dlhandle = (struct sap *) PTR (lib_cons->car); - void *sym_addr = dlsym ((void *) dlhandle->pointer, sym_name); - - if (sym_addr) - return sym_addr; + if (lib_list != NIL) { + lispobj lib_list_head; + + for (lib_list_head = lib_list; + lib_list_head != NIL; lib_list_head = CONS(lib_list_head)->cdr) { + struct cons *lib_cons = CONS(CONS(lib_list_head)->car); + struct sap *dlhandle = (struct sap *) PTR(lib_cons->car); + void *sym_addr = dlsym((void *) dlhandle->pointer, sym_name); + + if (sym_addr) + return sym_addr; } } - - return dlsym (RTLD_DEFAULT, sym_name); + + return dlsym(RTLD_DEFAULT, sym_name); } diff --git a/lisp/FreeBSD-os.h b/lisp/FreeBSD-os.h index 3783a78ba..14bfd7ae8 100644 --- a/lisp/FreeBSD-os.h +++ b/lisp/FreeBSD-os.h @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/FreeBSD-os.h,v 1.7 2005/01/13 19:55:00 fgilham Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/FreeBSD-os.h,v 1.8 2005/09/15 18:26:50 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -18,10 +18,10 @@ #define MAP_ANONYMOUS MAP_ANON #define MAP_VARIABLE 0 -typedef caddr_t os_vm_address_t; +typedef caddr_t os_vm_address_t; typedef vm_size_t os_vm_size_t; -typedef off_t os_vm_offset_t; -typedef int os_vm_prot_t; +typedef off_t os_vm_offset_t; +typedef int os_vm_prot_t; #define OS_VM_PROT_READ PROT_READ #define OS_VM_PROT_WRITE PROT_WRITE @@ -29,8 +29,8 @@ typedef int os_vm_prot_t; #define OS_VM_DEFAULT_PAGESIZE 4096 -int sc_reg (struct sigcontext*,int); -void os_save_context (void); +int sc_reg(struct sigcontext *, int); +void os_save_context(void); /* I *think* this is when things became incompatible with old signals. */ diff --git a/lisp/Linux-os.c b/lisp/Linux-os.c index abdc4d81f..88b8fabd8 100644 --- a/lisp/Linux-os.c +++ b/lisp/Linux-os.c @@ -15,7 +15,7 @@ * GENCGC support by Douglas Crosher, 1996, 1997. * Alpha support by Julian Dolby, 1999. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.c,v 1.24 2005/04/24 12:41:58 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.c,v 1.25 2005/09/15 18:26:50 rtoy Exp $ * */ @@ -61,306 +61,342 @@ int PVE_stub_errno; #endif #if ((LINUX_VERSION_CODE >= linuxversion(2,1,0)) || (__GNU_LIBRARY__ >= 6)) -void update_errno (void) +void +update_errno(void) { - PVE_stub_errno = errno; + PVE_stub_errno = errno; } #endif - -void os_init(void) + +void +os_init(void) { - struct utsname name; + struct utsname name; - uname(&name); + uname(&name); - /* We need this for mmap */ + /* We need this for mmap */ - if (name.release[0] < '2') - { - printf("Linux version must be later then 2.0.0!\n"); - exit(2); - } + if (name.release[0] < '2') { + printf("Linux version must be later then 2.0.0!\n"); + exit(2); + } - os_vm_page_size = getpagesize(); + os_vm_page_size = getpagesize(); #if defined(i386) || defined(__x86_64) #if 0 - setfpucw(0x1272|4|8|16|32); /* No interrupts */ + setfpucw(0x1272 | 4 | 8 | 16 | 32); /* No interrupts */ #else - /* - * Round to nearest, double-float precision (not extended!), disable - * interrupts for everything except invalid. - */ - setfpucw(_FPU_RC_NEAREST | _FPU_DOUBLE | _FPU_MASK_PM | _FPU_MASK_UM | - _FPU_MASK_OM | _FPU_MASK_ZM | _FPU_MASK_DM); + /* + * Round to nearest, double-float precision (not extended!), disable + * interrupts for everything except invalid. + */ + setfpucw(_FPU_RC_NEAREST | _FPU_DOUBLE | _FPU_MASK_PM | _FPU_MASK_UM | + _FPU_MASK_OM | _FPU_MASK_ZM | _FPU_MASK_DM); #endif #endif } #ifdef i386 #if (LINUX_VERSION_CODE >= linuxversion(2,1,0)) || (__GNU_LIBRARY__ >= 6) -int sc_reg(struct sigcontext *c, int offset) +int +sc_reg(struct sigcontext *c, int offset) #else -int sc_reg(struct sigcontext_struct *c, int offset) +int +sc_reg(struct sigcontext_struct *c, int offset) #endif { - switch(offset) - { - case 0: return c->eax; - case 2: return c->ecx; - case 4: return c->edx; - case 6: return c->ebx; - case 8: return c->esp; - case 10: return c->ebp; - case 12: return c->esi; - case 14: return c->edi; + switch (offset) { + case 0: + return c->eax; + case 2: + return c->ecx; + case 4: + return c->edx; + case 6: + return c->ebx; + case 8: + return c->esp; + case 10: + return c->ebp; + case 12: + return c->esi; + case 14: + return c->edi; } - return 0; + return 0; } #endif #ifdef __x86_64 -int sc_reg(struct sigcontext *c, int offset) +int +sc_reg(struct sigcontext *c, int offset) { - switch(offset) - { - case 0: return c->rax; - case 2: return c->rcx; - case 4: return c->rdx; - case 6: return c->rbx; - case 8: return c->rsp; - case 10: return c->rbp; - case 12: return c->rsi; - case 14: return c->rdi; - case 16: return c->r8; - case 18: return c->r9; - case 20: return c->r10; - case 22: return c->r11; - case 24: return c->r12; - case 26: return c->r13; - case 28: return c->r14; - case 30: return c->r15; + switch (offset) { + case 0: + return c->rax; + case 2: + return c->rcx; + case 4: + return c->rdx; + case 6: + return c->rbx; + case 8: + return c->rsp; + case 10: + return c->rbp; + case 12: + return c->rsi; + case 14: + return c->rdi; + case 16: + return c->r8; + case 18: + return c->r9; + case 20: + return c->r10; + case 22: + return c->r11; + case 24: + return c->r12; + case 26: + return c->r13; + case 28: + return c->r14; + case 30: + return c->r15; } - return 0; + return 0; } #endif -void os_save_context(void) +void +os_save_context(void) { - /* - * Called from interrupt handlers so C stuff knows things set in Lisp. - */ + /* + * Called from interrupt handlers so C stuff knows things set in Lisp. + */ } -void os_set_context(void) +void +os_set_context(void) { } -os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len) +os_vm_address_t +os_validate(os_vm_address_t addr, os_vm_size_t len) { - int flags = MAP_PRIVATE | MAP_ANONYMOUS | MAP_NORESERVE; - os_vm_address_t out_addr; - - DPRINTF(0, (stderr, "os_validate %p %d => ", addr, len)); + int flags = MAP_PRIVATE | MAP_ANONYMOUS | MAP_NORESERVE; + os_vm_address_t out_addr; - out_addr = mmap(addr, len, OS_VM_PROT_ALL, flags, -1, 0); + DPRINTF(0, (stderr, "os_validate %p %d => ", addr, len)); - if (out_addr == (os_vm_address_t) -1) - { - perror("mmap"); - return NULL; + out_addr = mmap(addr, len, OS_VM_PROT_ALL, flags, -1, 0); + + if (out_addr == (os_vm_address_t) - 1) { + perror("mmap"); + return NULL; } - if (addr && (addr != out_addr)) - { - fprintf(stderr, "Couldn't mmap at %p, len %d; got mapping at %p instead", - addr, len, out_addr); - munmap(addr, len); - return NULL; + if (addr && (addr != out_addr)) { + fprintf(stderr, + "Couldn't mmap at %p, len %d; got mapping at %p instead", addr, + len, out_addr); + munmap(addr, len); + return NULL; } - - DPRINTF(0, (stderr, "%p\n", out_addr)); - return out_addr; + DPRINTF(0, (stderr, "%p\n", out_addr)); + + return out_addr; } -void os_invalidate(os_vm_address_t addr, os_vm_size_t len) +void +os_invalidate(os_vm_address_t addr, os_vm_size_t len) { - DPRINTF(0, (stderr, "os_invalidate %p %d\n", addr, len)); + DPRINTF(0, (stderr, "os_invalidate %p %d\n", addr, len)); - if (munmap(addr, len) == -1) - perror("munmap"); + if (munmap(addr, len) == -1) + perror("munmap"); } -os_vm_address_t os_map(int fd, int offset, os_vm_address_t addr, - os_vm_size_t len) +os_vm_address_t +os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len) { - addr = mmap(addr, len, - OS_VM_PROT_ALL, - MAP_PRIVATE | MAP_FILE | MAP_FIXED, - fd, (off_t) offset); + addr = mmap(addr, len, + OS_VM_PROT_ALL, + MAP_PRIVATE | MAP_FILE | MAP_FIXED, fd, (off_t) offset); - if (addr == (os_vm_address_t) -1) - perror("mmap"); + if (addr == (os_vm_address_t) - 1) + perror("mmap"); - return addr; + return addr; } -void os_flush_icache(os_vm_address_t address, os_vm_size_t length) +void +os_flush_icache(os_vm_address_t address, os_vm_size_t length) { } -void os_protect(os_vm_address_t address, os_vm_size_t length, - os_vm_prot_t prot) +void +os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot) { - if (mprotect(address, length, prot) == -1) - perror("mprotect"); + if (mprotect(address, length, prot) == -1) + perror("mprotect"); } - -static boolean in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen) + +static boolean +in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen) { - char* beg = (char*) sbeg; - char* end = (char*) sbeg + slen; - char* adr = (char*) a; - return (adr >= beg && adr < end); + char *beg = (char *) sbeg; + char *end = (char *) sbeg + slen; + char *adr = (char *) a; + + return (adr >= beg && adr < end); } -boolean valid_addr(os_vm_address_t addr) +boolean +valid_addr(os_vm_address_t addr) { - os_vm_address_t newaddr; - newaddr = os_trunc_to_page(addr); - - 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_0_SPACE_START, dynamic_space_size ) - || in_range_p(addr, DYNAMIC_1_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 )) - return TRUE; - return FALSE; + os_vm_address_t newaddr; + + newaddr = os_trunc_to_page(addr); + + 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_0_SPACE_START, dynamic_space_size) + || in_range_p(addr, DYNAMIC_1_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)) + return TRUE; + return FALSE; } - + #if defined GENCGC -static void sigsegv_handle_now(HANDLER_ARGS) +static void +sigsegv_handle_now(HANDLER_ARGS) { - interrupt_handle_now(signal, contextstruct); + interrupt_handle_now(signal, contextstruct); } static int tramp_signal; static struct sigcontext tramp_contextstruct; -static void sigsegv_handler_tramp (void) +static void +sigsegv_handler_tramp(void) { - sigsegv_handle_now (tramp_signal, tramp_contextstruct); - assert (0); + sigsegv_handle_now(tramp_signal, tramp_contextstruct); + assert(0); } -void sigsegv_handler(HANDLER_ARGS) +void +sigsegv_handler(HANDLER_ARGS) { - GET_CONTEXT - + GET_CONTEXT #if (LINUX_VERSION_CODE >= linuxversion(2,1,0)) || (__GNU_LIBRARY__ >= 6) - int fault_addr = ((struct sigcontext *) (&contextstruct))->cr2; + int fault_addr = ((struct sigcontext *) (&contextstruct))->cr2; #else - int fault_addr = ((struct sigcontext_struct *) (&contextstruct))->cr2; + int fault_addr = ((struct sigcontext_struct *) (&contextstruct))->cr2; #endif - int page_index = find_page_index((void *) fault_addr); + int page_index = find_page_index((void *) fault_addr); #ifdef RED_ZONE_HIT - if (os_control_stack_overflow ((void *) fault_addr, &contextstruct)) - return; + if (os_control_stack_overflow((void *) fault_addr, &contextstruct)) + return; #endif - /* check if the fault is within the dynamic space. */ - if (page_index != -1) { - /* Un-protect the page */ + /* check if the fault is within the dynamic space. */ + if (page_index != -1) { + /* Un-protect the page */ - /* The page should have been marked write protected */ - if (!PAGE_WRITE_PROTECTED(page_index)) - fprintf(stderr, "*** Sigsegv in page not marked as write protected\n"); - os_protect(page_address(page_index), 4096, OS_VM_PROT_ALL); - page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK; - page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK; - - return; - } + /* The page should have been marked write protected */ + if (!PAGE_WRITE_PROTECTED(page_index)) + fprintf(stderr, + "*** Sigsegv in page not marked as write protected\n"); + os_protect(page_address(page_index), 4096, OS_VM_PROT_ALL); + page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK; + page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK; + return; + } #if defined(__x86_64) - DPRINTF(0,(stderr,"sigsegv: rip: %p\n",context->rip)); + DPRINTF(0, (stderr, "sigsegv: rip: %p\n", context->rip)); #else - DPRINTF(0,(stderr,"sigsegv: eip: %lx\n",context->eip)); + DPRINTF(0, (stderr, "sigsegv: eip: %lx\n", context->eip)); #endif #ifdef RED_ZONE_HIT - { - /* Switch back to the normal stack and invoke the Lisp signal - handler there. Global variables are used to pass the context - to the other stack. */ - tramp_signal = signal; - tramp_contextstruct = contextstruct; - SC_PC(context) = sigsegv_handler_tramp; - return; - } + { + /* Switch back to the normal stack and invoke the Lisp signal + handler there. Global variables are used to pass the context + to the other stack. */ + tramp_signal = signal; + tramp_contextstruct = contextstruct; + SC_PC(context) = sigsegv_handler_tramp; + return; + } #endif - sigsegv_handle_now(signal, contextstruct); + sigsegv_handle_now(signal, contextstruct); } #else -static void sigsegv_handler(HANDLER_ARGS) +static void +sigsegv_handler(HANDLER_ARGS) { - os_vm_address_t addr; + os_vm_address_t addr; #ifdef i386 - GET_CONTEXT + GET_CONTEXT #endif - - DPRINTF(0, (stderr, "sigsegv\n")); + DPRINTF(0, (stderr, "sigsegv\n")); #ifdef i386 - interrupt_handle_now(signal, contextstruct); + interrupt_handle_now(signal, contextstruct); #else #define CONTROL_STACK_TOP (((char*) CONTROL_STACK_START) + CONTROL_STACK_SIZE) - addr = arch_get_bad_addr(signal,code,context); - - if (addr != NULL && context->sc_regs[reg_ALLOC] & (1 << 63)) { - context->sc_regs[reg_ALLOC] -= (1 << 63); - interrupt_handle_pending(context); - } else if (addr > CONTROL_STACK_TOP && addr < BINDING_STACK_START) { - fprintf(stderr, "Possible stack overflow at 0x%08lX!\n", addr); - /* try to fix control frame pointer */ - while (!(CONTROL_STACK_START <= *current_control_frame_pointer && - *current_control_frame_pointer <= CONTROL_STACK_TOP)) - ((char*) current_control_frame_pointer) -= sizeof(lispobj); - ldb_monitor(); - } else if (!interrupt_maybe_gc(signal, code, context)) - interrupt_handle_now(signal, code, context); + addr = arch_get_bad_addr(signal, code, context); + + if (addr != NULL && context->sc_regs[reg_ALLOC] & (1 << 63)) { + context->sc_regs[reg_ALLOC] -= (1 << 63); + interrupt_handle_pending(context); + } else if (addr > CONTROL_STACK_TOP && addr < BINDING_STACK_START) { + fprintf(stderr, "Possible stack overflow at 0x%08lX!\n", addr); + /* try to fix control frame pointer */ + while (!(CONTROL_STACK_START <= *current_control_frame_pointer && + *current_control_frame_pointer <= CONTROL_STACK_TOP)) + ((char *) current_control_frame_pointer) -= sizeof(lispobj); + ldb_monitor(); + } else if (!interrupt_maybe_gc(signal, code, context)) + interrupt_handle_now(signal, code, context); #endif } #endif -static void sigbus_handler(HANDLER_ARGS) +static void +sigbus_handler(HANDLER_ARGS) { #if defined(i386) || defined(__x86_64) - GET_CONTEXT + GET_CONTEXT #endif - - DPRINTF(1, (stderr, "sigbus:\n")); /* there is no sigbus in linux??? */ + DPRINTF(1, (stderr, "sigbus:\n")); /* there is no sigbus in linux??? */ #if defined(i386) || defined(__x86_64) - interrupt_handle_now(signal, contextstruct); + interrupt_handle_now(signal, contextstruct); #else - interrupt_handle_now(signal, code, context); -#endif + interrupt_handle_now(signal, code, context); +#endif } -void os_install_interrupt_handlers(void) +void +os_install_interrupt_handlers(void) { - interrupt_install_low_level_handler(SIGSEGV, sigsegv_handler); - interrupt_install_low_level_handler(SIGBUS, sigbus_handler); + interrupt_install_low_level_handler(SIGSEGV, sigsegv_handler); + interrupt_install_low_level_handler(SIGBUS, sigbus_handler); } /* Some symbols, most notably stat and lstat, don't appear at all in @@ -368,7 +404,8 @@ void os_install_interrupt_handlers(void) braindamage. So, try falling back to a stub in linux-stubs.S that will call the proper function if it's one of those. */ -static void *dlsym_fallback(void *handle, const char *name) +static void * +dlsym_fallback(void *handle, const char *name) { char newsym[1024]; void *sym_addr; @@ -384,30 +421,30 @@ static void *dlsym_fallback(void *handle, const char *name) return sym_addr; } -void *os_dlsym(const char *sym_name, lispobj lib_list) +void * +os_dlsym(const char *sym_name, lispobj lib_list) { static void *program_handle; void *sym_addr = 0; if (!program_handle) - program_handle = dlopen((void *)0, RTLD_LAZY | RTLD_GLOBAL); + program_handle = dlopen((void *) 0, RTLD_LAZY | RTLD_GLOBAL); if (lib_list != NIL) { lispobj lib_list_head; for (lib_list_head = lib_list; - lib_list_head != NIL; - lib_list_head = (CONS(lib_list_head))->cdr) { + lib_list_head != NIL; lib_list_head = (CONS(lib_list_head))->cdr) { struct cons *lib_cons = CONS(CONS(lib_list_head)->car); - struct sap *dlhandle = (struct sap *)PTR(lib_cons->car); + struct sap *dlhandle = (struct sap *) PTR(lib_cons->car); - sym_addr = dlsym((void *)dlhandle->pointer, sym_name); + sym_addr = dlsym((void *) dlhandle->pointer, sym_name); if (sym_addr) return sym_addr; } } sym_addr = dlsym(program_handle, sym_name); if (!sym_addr && dlerror()) { - return dlsym_fallback(program_handle,sym_name); + return dlsym_fallback(program_handle, sym_name); } else { return sym_addr; } diff --git a/lisp/Linux-os.h b/lisp/Linux-os.h index a882990e8..31a39023d 100644 --- a/lisp/Linux-os.h +++ b/lisp/Linux-os.h @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.h,v 1.16 2005/01/13 19:55:00 fgilham Exp $ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Linux-os.h,v 1.17 2005/09/15 18:26:50 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -16,7 +16,7 @@ #include <sys/types.h> #include <sys/mman.h> #include <sys/signal.h> -#include <string.h> +#include <string.h> /* #include <dlfcn.h> */ #include <sys/time.h> #include <sys/stat.h> @@ -29,25 +29,25 @@ #define linuxversion(a, b, c) (((a)<<16)+((b)<<8)+(c)) -typedef caddr_t os_vm_address_t; /* like hpux */ -typedef size_t os_vm_size_t; /* like hpux */ -typedef off_t os_vm_offset_t; /* like hpux */ -typedef int os_vm_prot_t; /* like hpux */ +typedef caddr_t os_vm_address_t; /* like hpux */ +typedef size_t os_vm_size_t; /* like hpux */ +typedef off_t os_vm_offset_t; /* like hpux */ +typedef int os_vm_prot_t; /* like hpux */ -#define OS_VM_PROT_READ PROT_READ /* like hpux */ -#define OS_VM_PROT_WRITE PROT_WRITE /* like hpux */ -#define OS_VM_PROT_EXECUTE PROT_EXEC /* like hpux */ +#define OS_VM_PROT_READ PROT_READ /* like hpux */ +#define OS_VM_PROT_WRITE PROT_WRITE /* like hpux */ +#define OS_VM_PROT_EXECUTE PROT_EXEC /* like hpux */ -#ifndef __alpha__ -#define OS_VM_DEFAULT_PAGESIZE 4096 /* like hpux */ +#ifndef __alpha__ +#define OS_VM_DEFAULT_PAGESIZE 4096 /* like hpux */ #else -#define OS_VM_DEFAULT_PAGESIZE 8192 /* like hpux */ +#define OS_VM_DEFAULT_PAGESIZE 8192 /* like hpux */ #endif #if (LINUX_VERSION_CODE >= linuxversion(2,1,0)) || (__GNU_LIBRARY__ >= 6) -int sc_reg(struct sigcontext *,int); +int sc_reg(struct sigcontext *, int); #else -int sc_reg(struct sigcontext_struct *,int); +int sc_reg(struct sigcontext_struct *, int); #endif void os_save_context(void); @@ -87,7 +87,7 @@ typedef struct sigcontext_struct sigcontext; #define sv_flags sa_flags #define sv_handler sa_handler #if (__GNU_LIBRARY__ < 6) -#define sv_onstack sa_mask /* ouch, this one really hurts */ +#define sv_onstack sa_mask /* ouch, this one really hurts */ #endif #define uc_sigmask oldmask #if defined (__x86_64) @@ -97,11 +97,11 @@ typedef struct sigcontext_struct sigcontext; #define sc_pc eip #define sc_sp esp #endif -#define sc_mask oldmask +#define sc_mask oldmask #if (LINUX_VERSION_CODE >= linuxversion(2,1,0)) || (__GNU_LIBRARY__ >= 6) -#define sigcontext sigcontext +#define sigcontext sigcontext #else -#define sigcontext sigcontext_struct +#define sigcontext sigcontext_struct #endif #define sc_efl eflags diff --git a/lisp/NetBSD-os.c b/lisp/NetBSD-os.c index 30026e1a3..77048695d 100644 --- a/lisp/NetBSD-os.c +++ b/lisp/NetBSD-os.c @@ -15,7 +15,7 @@ * Frobbed for OpenBSD by Pierre R. Mai, 2001. * Frobbed for NetBSD by Pierre R. Mai, 2002. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/NetBSD-os.c,v 1.2 2004/07/07 15:03:11 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/NetBSD-os.c,v 1.3 2005/09/15 18:26:50 rtoy Exp $ * */ @@ -45,249 +45,267 @@ size_t os_vm_page_size; #if defined GENCGC #include "gencgc.h" #endif - -void os_init(void) + +void +os_init(void) { - os_vm_page_size = OS_VM_DEFAULT_PAGESIZE; + os_vm_page_size = OS_VM_DEFAULT_PAGESIZE; } -int sc_reg(os_context_t *c, int offset) +int +sc_reg(os_context_t * c, int offset) { #ifdef i386 #if USE_SA_SIGINFO - switch(offset) - { - case 0: return c->uc_mcontext.__gregs[_REG_EAX]; - case 2: return c->uc_mcontext.__gregs[_REG_ECX]; - case 4: return c->uc_mcontext.__gregs[_REG_EDX]; - case 6: return c->uc_mcontext.__gregs[_REG_EBX]; - case 8: return c->uc_mcontext.__gregs[_REG_ESP]; - case 10: return c->uc_mcontext.__gregs[_REG_EBP]; - case 12: return c->uc_mcontext.__gregs[_REG_ESI]; - case 14: return c->uc_mcontext.__gregs[_REG_EDI]; + switch (offset) { + case 0: + return c->uc_mcontext.__gregs[_REG_EAX]; + case 2: + return c->uc_mcontext.__gregs[_REG_ECX]; + case 4: + return c->uc_mcontext.__gregs[_REG_EDX]; + case 6: + return c->uc_mcontext.__gregs[_REG_EBX]; + case 8: + return c->uc_mcontext.__gregs[_REG_ESP]; + case 10: + return c->uc_mcontext.__gregs[_REG_EBP]; + case 12: + return c->uc_mcontext.__gregs[_REG_ESI]; + case 14: + return c->uc_mcontext.__gregs[_REG_EDI]; } #else - switch(offset) - { - case 0: return c->sc_eax; - case 2: return c->sc_ecx; - case 4: return c->sc_edx; - case 6: return c->sc_ebx; - case 8: return c->sc_esp; - case 10: return c->sc_ebp; - case 12: return c->sc_esi; - case 14: return c->sc_edi; + switch (offset) { + case 0: + return c->sc_eax; + case 2: + return c->sc_ecx; + case 4: + return c->sc_edx; + case 6: + return c->sc_ebx; + case 8: + return c->sc_esp; + case 10: + return c->sc_ebp; + case 12: + return c->sc_esi; + case 14: + return c->sc_edi; } #endif #endif - return 0; + return 0; } -void os_save_context(void) +void +os_save_context(void) { - /* - * Called from interrupt handlers so C stuff knows things set in Lisp. - */ + /* + * Called from interrupt handlers so C stuff knows things set in Lisp. + */ } -void os_set_context(void) +void +os_set_context(void) { } -os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len) +os_vm_address_t +os_validate(os_vm_address_t addr, os_vm_size_t len) { - int flags = MAP_PRIVATE | MAP_ANONYMOUS; - - /* - * NetBSD 1.5.2 seems to insist on each mmap being less than 128MB. - * So we mmap in 64MB steps. This is probably inefficient, but the - * missing CR2 reporting in signal handlers already ensures that - * NetBSD/x86 is not a suitable platform for CMU CL as it stands. - */ - - if (addr) - flags |= MAP_FIXED; - else - flags |= MAP_VARIABLE; - - DPRINTF(0, (stderr, "os_validate %p %d =>", addr, len)); - - if (addr) - { - os_vm_address_t curaddr=addr; - - while (len>0) - { - os_vm_address_t resaddr; - int curlen=MIN(64*1024*1024,len); - - resaddr = mmap(curaddr, curlen, OS_VM_PROT_ALL, flags, -1, 0); - - if (resaddr == (os_vm_address_t) -1) - { - perror("mmap"); - - while (curaddr>addr) - { - curaddr-=64*1024*1024; - munmap(curaddr,64*1024*1024); + int flags = MAP_PRIVATE | MAP_ANONYMOUS; + + /* + * NetBSD 1.5.2 seems to insist on each mmap being less than 128MB. + * So we mmap in 64MB steps. This is probably inefficient, but the + * missing CR2 reporting in signal handlers already ensures that + * NetBSD/x86 is not a suitable platform for CMU CL as it stands. + */ + + if (addr) + flags |= MAP_FIXED; + else + flags |= MAP_VARIABLE; + + DPRINTF(0, (stderr, "os_validate %p %d =>", addr, len)); + + if (addr) { + os_vm_address_t curaddr = addr; + + while (len > 0) { + os_vm_address_t resaddr; + int curlen = MIN(64 * 1024 * 1024, len); + + resaddr = mmap(curaddr, curlen, OS_VM_PROT_ALL, flags, -1, 0); + + if (resaddr == (os_vm_address_t) - 1) { + perror("mmap"); + + while (curaddr > addr) { + curaddr -= 64 * 1024 * 1024; + munmap(curaddr, 64 * 1024 * 1024); } - - return NULL; + + return NULL; } - DPRINTF(0, (stderr, " %p", resaddr)); - - curaddr+=curlen; - len-=curlen; + DPRINTF(0, (stderr, " %p", resaddr)); + + curaddr += curlen; + len -= curlen; } - - DPRINTF(0, (stderr, "\n")); - } - else - { - addr = mmap(0, len, OS_VM_PROT_ALL, flags, -1, 0); - - if (addr == (os_vm_address_t) -1) - { - perror("mmap"); - return NULL; + + DPRINTF(0, (stderr, "\n")); + } else { + addr = mmap(0, len, OS_VM_PROT_ALL, flags, -1, 0); + + if (addr == (os_vm_address_t) - 1) { + perror("mmap"); + return NULL; } - - DPRINTF(0, (stderr, " %p\n", addr)); + + DPRINTF(0, (stderr, " %p\n", addr)); } - return addr; + return addr; } -void os_invalidate(os_vm_address_t addr, os_vm_size_t len) +void +os_invalidate(os_vm_address_t addr, os_vm_size_t len) { - DPRINTF(0, (stderr, "os_invalidate %p %d\n", addr, len)); + DPRINTF(0, (stderr, "os_invalidate %p %d\n", addr, len)); - if (munmap(addr, len) == -1) - perror("munmap"); + if (munmap(addr, len) == -1) + perror("munmap"); } -os_vm_address_t os_map(int fd, int offset, os_vm_address_t addr, - os_vm_size_t len) +os_vm_address_t +os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len) { - addr = mmap(addr, len, - OS_VM_PROT_ALL, - MAP_PRIVATE | MAP_FILE | MAP_FIXED, - fd, (off_t) offset); + addr = mmap(addr, len, + OS_VM_PROT_ALL, + MAP_PRIVATE | MAP_FILE | MAP_FIXED, fd, (off_t) offset); - if (addr == (os_vm_address_t) -1) - perror("mmap"); + if (addr == (os_vm_address_t) - 1) + perror("mmap"); - return addr; + return addr; } -void os_flush_icache(os_vm_address_t address, os_vm_size_t length) +void +os_flush_icache(os_vm_address_t address, os_vm_size_t length) { } -void os_protect(os_vm_address_t address, os_vm_size_t length, - os_vm_prot_t prot) +void +os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot) { - if (mprotect(address, length, prot) == -1) - perror("mprotect"); + if (mprotect(address, length, prot) == -1) + perror("mprotect"); } - -static boolean in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen) + +static boolean +in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen) { - char* beg = (char*) sbeg; - char* end = (char*) sbeg + slen; - char* adr = (char*) a; - return (adr >= beg && adr < end); + char *beg = (char *) sbeg; + char *end = (char *) sbeg + slen; + char *adr = (char *) a; + + return (adr >= beg && adr < end); } -boolean valid_addr(os_vm_address_t addr) +boolean +valid_addr(os_vm_address_t addr) { - os_vm_address_t newaddr; - newaddr = os_trunc_to_page(addr); + os_vm_address_t newaddr; - 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_0_SPACE_START, dynamic_space_size ) + newaddr = os_trunc_to_page(addr); + + 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_0_SPACE_START, dynamic_space_size) #ifndef GENCGC - || in_range_p(addr, DYNAMIC_1_SPACE_START, dynamic_space_size ) + || in_range_p(addr, DYNAMIC_1_SPACE_START, dynamic_space_size) #endif - || in_range_p(addr, CONTROL_STACK_START , CONTROL_STACK_SIZE ) - || in_range_p(addr, BINDING_STACK_START , BINDING_STACK_SIZE )) - return TRUE; - return FALSE; + || in_range_p(addr, CONTROL_STACK_START, CONTROL_STACK_SIZE) + || in_range_p(addr, BINDING_STACK_START, BINDING_STACK_SIZE)) + return TRUE; + return FALSE; } - -static void sigsegv_handler(HANDLER_ARGS) + +static void +sigsegv_handler(HANDLER_ARGS) { #if defined GENCGC - caddr_t fault_addr = code ? code->si_addr : 0; - int page_index = find_page_index((void*)fault_addr); + caddr_t fault_addr = code ? code->si_addr : 0; + int page_index = find_page_index((void *) fault_addr); #if SIGSEGV_VERBOSE - fprintf(stderr,"Signal %d, fault_addr=%p, page_index=%d:\n", - signal, fault_addr, page_index); + fprintf(stderr, "Signal %d, fault_addr=%p, page_index=%d:\n", + signal, fault_addr, page_index); #endif - /* Check if the fault is within the dynamic space. */ - if (page_index != -1) { - /* Un-protect the page */ + /* Check if the fault is within the dynamic space. */ + if (page_index != -1) { + /* Un-protect the page */ - /* The page should have been marked write protected */ - if (!PAGE_WRITE_PROTECTED(page_index)) - fprintf(stderr, "*** Sigsegv in page not marked as write protected\n"); + /* The page should have been marked write protected */ + if (!PAGE_WRITE_PROTECTED(page_index)) + fprintf(stderr, + "*** Sigsegv in page not marked as write protected\n"); - os_protect(page_address(page_index), 4096, OS_VM_PROT_ALL); - page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK; - page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK; + os_protect(page_address(page_index), 4096, OS_VM_PROT_ALL); + page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK; + page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK; - return; + return; } #endif - SAVE_CONTEXT(); + SAVE_CONTEXT(); - DPRINTF(0, (stderr, "sigsegv:\n")); - interrupt_handle_now(signal, code, context); + DPRINTF(0, (stderr, "sigsegv:\n")); + interrupt_handle_now(signal, code, context); } -static void sigbus_handler(HANDLER_ARGS) +static void +sigbus_handler(HANDLER_ARGS) { - SAVE_CONTEXT(); + SAVE_CONTEXT(); - DPRINTF(0, (stderr, "sigbus:\n")); - interrupt_handle_now(signal, code, context); + DPRINTF(0, (stderr, "sigbus:\n")); + interrupt_handle_now(signal, code, context); } -void os_install_interrupt_handlers(void) +void +os_install_interrupt_handlers(void) { - interrupt_install_low_level_handler(SIGSEGV, sigsegv_handler); - interrupt_install_low_level_handler(SIGBUS, sigbus_handler); + interrupt_install_low_level_handler(SIGSEGV, sigsegv_handler); + interrupt_install_low_level_handler(SIGBUS, sigbus_handler); } void * -os_dlsym (const char *sym_name, lispobj lib_list) +os_dlsym(const char *sym_name, lispobj lib_list) { - if (lib_list != NIL) - { - lispobj lib_list_head; - - for (lib_list_head = lib_list; - lib_list_head != NIL; - lib_list_head = CONS (lib_list_head)->cdr) - { - struct cons *lib_cons = CONS (CONS (lib_list_head)->car); - struct sap *dlhandle = (struct sap *) PTR (lib_cons->car); - void *sym_addr = dlsym ((void *) dlhandle->pointer, sym_name); - - if (sym_addr) - return sym_addr; + if (lib_list != NIL) { + lispobj lib_list_head; + + for (lib_list_head = lib_list; + lib_list_head != NIL; lib_list_head = CONS(lib_list_head)->cdr) { + struct cons *lib_cons = CONS(CONS(lib_list_head)->car); + struct sap *dlhandle = (struct sap *) PTR(lib_cons->car); + void *sym_addr = dlsym((void *) dlhandle->pointer, sym_name); + + if (sym_addr) + return sym_addr; } } - - return dlsym (RTLD_DEFAULT, sym_name); + + return dlsym(RTLD_DEFAULT, sym_name); } diff --git a/lisp/NetBSD-os.h b/lisp/NetBSD-os.h index c599ee36d..ce4fc36ac 100644 --- a/lisp/NetBSD-os.h +++ b/lisp/NetBSD-os.h @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/NetBSD-os.h,v 1.3 2005/01/13 19:55:00 fgilham Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/NetBSD-os.h,v 1.4 2005/09/15 18:26:50 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -34,7 +34,7 @@ typedef int os_vm_prot_t; #define CODE(code) ((code) ? code->si_code : 0) #define os_context_t ucontext_t -int sc_reg(ucontext_t *,int); +int sc_reg(ucontext_t *, int); #define PROTECTION_VIOLATION_SIGNAL SIGSEGV diff --git a/lisp/OpenBSD-os.c b/lisp/OpenBSD-os.c index 6381ec659..67b3d2eee 100644 --- a/lisp/OpenBSD-os.c +++ b/lisp/OpenBSD-os.c @@ -13,7 +13,7 @@ * GENCGC support by Douglas Crosher, 1996, 1997. * Frobbed for OpenBSD by Pierre R. Mai, 2001. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/OpenBSD-os.c,v 1.1 2001/12/06 19:15:44 pmai Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/OpenBSD-os.c,v 1.2 2005/09/15 18:26:50 rtoy Exp $ * */ @@ -41,167 +41,187 @@ vm_size_t os_vm_page_size; #if defined GENCGC #include "gencgc.h" #endif - -void os_init(void) + +void +os_init(void) { - os_vm_page_size = OS_VM_DEFAULT_PAGESIZE; + os_vm_page_size = OS_VM_DEFAULT_PAGESIZE; } -int sc_reg(struct sigcontext *c, int offset) +int +sc_reg(struct sigcontext *c, int offset) { - switch(offset) - { - case 0: return c->sc_eax; - case 2: return c->sc_ecx; - case 4: return c->sc_edx; - case 6: return c->sc_ebx; - case 8: return c->sc_esp; - case 10: return c->sc_ebp; - case 12: return c->sc_esi; - case 14: return c->sc_edi; + switch (offset) { + case 0: + return c->sc_eax; + case 2: + return c->sc_ecx; + case 4: + return c->sc_edx; + case 6: + return c->sc_ebx; + case 8: + return c->sc_esp; + case 10: + return c->sc_ebp; + case 12: + return c->sc_esi; + case 14: + return c->sc_edi; } - return 0; + return 0; } -void os_save_context(void) +void +os_save_context(void) { - /* - * Called from interrupt handlers so C stuff knows things set in Lisp. - */ + /* + * Called from interrupt handlers so C stuff knows things set in Lisp. + */ } -void os_set_context(void) +void +os_set_context(void) { } -os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len) +os_vm_address_t +os_validate(os_vm_address_t addr, os_vm_size_t len) { - int flags = MAP_PRIVATE | MAP_ANONYMOUS; + int flags = MAP_PRIVATE | MAP_ANONYMOUS; - if (addr) - flags |= MAP_FIXED; - else - flags |= MAP_VARIABLE; + if (addr) + flags |= MAP_FIXED; + else + flags |= MAP_VARIABLE; - DPRINTF(0, (stderr, "os_validate %x %d => ", addr, len)); + DPRINTF(0, (stderr, "os_validate %x %d => ", addr, len)); - addr = mmap(addr, len, OS_VM_PROT_ALL, flags, -1, 0); + addr = mmap(addr, len, OS_VM_PROT_ALL, flags, -1, 0); - if (addr == (os_vm_address_t) -1) - { - perror("mmap"); - return NULL; + if (addr == (os_vm_address_t) - 1) { + perror("mmap"); + return NULL; } - DPRINTF(0, (stderr, "%x\n", addr)); + DPRINTF(0, (stderr, "%x\n", addr)); - return addr; + return addr; } -void os_invalidate(os_vm_address_t addr, os_vm_size_t len) +void +os_invalidate(os_vm_address_t addr, os_vm_size_t len) { - DPRINTF(0, (stderr, "os_invalidate %x %d\n", addr, len)); + DPRINTF(0, (stderr, "os_invalidate %x %d\n", addr, len)); - if (munmap(addr, len) == -1) - perror("munmap"); + if (munmap(addr, len) == -1) + perror("munmap"); } -os_vm_address_t os_map(int fd, int offset, os_vm_address_t addr, - os_vm_size_t len) +os_vm_address_t +os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len) { - addr = mmap(addr, len, - OS_VM_PROT_ALL, - MAP_PRIVATE | MAP_FILE | MAP_FIXED, - fd, (off_t) offset); + addr = mmap(addr, len, + OS_VM_PROT_ALL, + MAP_PRIVATE | MAP_FILE | MAP_FIXED, fd, (off_t) offset); - if (addr == (os_vm_address_t) -1) - perror("mmap"); + if (addr == (os_vm_address_t) - 1) + perror("mmap"); - return addr; + return addr; } -void os_flush_icache(os_vm_address_t address, os_vm_size_t length) +void +os_flush_icache(os_vm_address_t address, os_vm_size_t length) { } -void os_protect(os_vm_address_t address, os_vm_size_t length, - os_vm_prot_t prot) +void +os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot) { - if (mprotect(address, length, prot) == -1) - perror("mprotect"); + if (mprotect(address, length, prot) == -1) + perror("mprotect"); } - -static boolean in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen) + +static boolean +in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen) { - char* beg = (char*) sbeg; - char* end = (char*) sbeg + slen; - char* adr = (char*) a; - return (adr >= beg && adr < end); + char *beg = (char *) sbeg; + char *end = (char *) sbeg + slen; + char *adr = (char *) a; + + return (adr >= beg && adr < end); } -boolean valid_addr(os_vm_address_t addr) +boolean +valid_addr(os_vm_address_t addr) { - int ret; - os_vm_address_t newaddr; - newaddr = os_trunc_to_page(addr); - - 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_0_SPACE_START, dynamic_space_size ) - || in_range_p(addr, DYNAMIC_1_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 )) - return TRUE; - return FALSE; + int ret; + os_vm_address_t newaddr; + + newaddr = os_trunc_to_page(addr); + + 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_0_SPACE_START, dynamic_space_size) + || in_range_p(addr, DYNAMIC_1_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)) + return TRUE; + return FALSE; } - -static void sigsegv_handler(HANDLER_ARGS) + +static void +sigsegv_handler(HANDLER_ARGS) { #if defined GENCGC - caddr_t fault_addr = code->si_addr; - int page_index = find_page_index((void*)fault_addr); + caddr_t fault_addr = code->si_addr; + int page_index = find_page_index((void *) fault_addr); #if SIGSEGV_VERBOSE - fprintf(stderr,"Signal %d, fault_addr=%x, page_index=%d:\n", - signal, fault_addr, page_index); + fprintf(stderr, "Signal %d, fault_addr=%x, page_index=%d:\n", + signal, fault_addr, page_index); #endif - /* Check if the fault is within the dynamic space. */ - if (page_index != -1) { - /* Un-protect the page */ + /* Check if the fault is within the dynamic space. */ + if (page_index != -1) { + /* Un-protect the page */ - /* The page should have been marked write protected */ - if (!PAGE_WRITE_PROTECTED(page_index)) - fprintf(stderr, "*** Sigsegv in page not marked as write protected\n"); + /* The page should have been marked write protected */ + if (!PAGE_WRITE_PROTECTED(page_index)) + fprintf(stderr, + "*** Sigsegv in page not marked as write protected\n"); - os_protect(page_address(page_index), 4096, OS_VM_PROT_ALL); - page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK; - page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK; + os_protect(page_address(page_index), 4096, OS_VM_PROT_ALL); + page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK; + page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK; - return; + return; } #endif - SAVE_CONTEXT(); + SAVE_CONTEXT(); - DPRINTF(0, (stderr, "sigsegv:\n")); - interrupt_handle_now(signal, code, context); + DPRINTF(0, (stderr, "sigsegv:\n")); + interrupt_handle_now(signal, code, context); } -static void sigbus_handler(HANDLER_ARGS) +static void +sigbus_handler(HANDLER_ARGS) { - SAVE_CONTEXT(); + SAVE_CONTEXT(); - DPRINTF(0, (stderr, "sigbus:\n")); - interrupt_handle_now(signal, code, context); + DPRINTF(0, (stderr, "sigbus:\n")); + interrupt_handle_now(signal, code, context); } -void os_install_interrupt_handlers(void) +void +os_install_interrupt_handlers(void) { - interrupt_install_low_level_handler(SIGSEGV, sigsegv_handler); - interrupt_install_low_level_handler(SIGBUS, sigbus_handler); + interrupt_install_low_level_handler(SIGSEGV, sigsegv_handler); + interrupt_install_low_level_handler(SIGBUS, sigbus_handler); } diff --git a/lisp/OpenBSD-os.h b/lisp/OpenBSD-os.h index bfeb0abb3..a0c1db894 100644 --- a/lisp/OpenBSD-os.h +++ b/lisp/OpenBSD-os.h @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/OpenBSD-os.h,v 1.2 2005/01/13 19:55:00 fgilham Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/OpenBSD-os.h,v 1.3 2005/09/15 18:26:50 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -34,6 +34,6 @@ typedef int os_vm_prot_t; #define CODE(code) ((code) ? code->si_code : 0) #define uc_sigmask sc_mask -int sc_reg(struct sigcontext*,int); +int sc_reg(struct sigcontext *, int); #endif /* _OPENBSD_OS_H_ */ diff --git a/lisp/alloc.c b/lisp/alloc.c index 9ec65ed22..042a0ec23 100644 --- a/lisp/alloc.c +++ b/lisp/alloc.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/alloc.c,v 1.9 2005/04/16 02:05:06 rtoy Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/alloc.c,v 1.10 2005/09/15 18:26:50 rtoy Exp $ */ #include <string.h> @@ -36,7 +36,8 @@ Allocation Routines. #elif defined(WANT_CGC) extern lispobj *alloc(int bytes); #else -static lispobj *alloc(int bytes) +static lispobj * +alloc(int bytes) { lispobj *result; @@ -47,85 +48,91 @@ static lispobj *alloc(int bytes) SET_FREE_POINTER(result + (bytes / sizeof(lispobj))); if (GET_GC_TRIGGER() && GET_FREE_POINTER() > GET_GC_TRIGGER()) { - SET_GC_TRIGGER((char *)GET_FREE_POINTER() - - (char *)current_dynamic_space); + SET_GC_TRIGGER((char *) GET_FREE_POINTER() + - (char *) current_dynamic_space); } return result; } #endif -static lispobj *alloc_unboxed(int type, int words) +static lispobj * +alloc_unboxed(int type, int words) { lispobj *result; - result = (lispobj *)alloc(ALIGNED_SIZE((1 + words) * sizeof(lispobj))); + result = (lispobj *) alloc(ALIGNED_SIZE((1 + words) * sizeof(lispobj))); *result = (lispobj) (words << type_Bits) | type; return result; } -static lispobj alloc_vector(int type, int length, int size) +static lispobj +alloc_vector(int type, int length, int size) { struct vector *result; result = (struct vector *) - alloc(ALIGNED_SIZE((2 + (length*size + 31) / 32) * sizeof(lispobj))); + alloc(ALIGNED_SIZE((2 + (length * size + 31) / 32) * sizeof(lispobj))); result->header = type; result->length = make_fixnum(length); - return ((lispobj)result)|type_OtherPointer; + return ((lispobj) result) | type_OtherPointer; } -lispobj alloc_cons(lispobj car, lispobj cdr) +lispobj +alloc_cons(lispobj car, lispobj cdr) { - struct cons *ptr = (struct cons *)alloc(ALIGNED_SIZE(sizeof(struct cons))); + struct cons *ptr = (struct cons *) alloc(ALIGNED_SIZE(sizeof(struct cons))); ptr->car = car; ptr->cdr = cdr; - return (lispobj)ptr | type_ListPointer; + return (lispobj) ptr | type_ListPointer; } -lispobj alloc_number(long n) +lispobj +alloc_number(long n) { struct bignum *ptr; #ifdef __x86_64 - if (-0x2000000000000000 < n && n < 0x2000000000000000) /* -2^61 to 2^61 */ + if (-0x2000000000000000 < n && n < 0x2000000000000000) /* -2^61 to 2^61 */ #else if (-0x20000000 < n && n < 0x20000000) #endif - return make_fixnum(n); + return make_fixnum(n); else { - ptr = (struct bignum *)alloc_unboxed(type_Bignum, 1); + ptr = (struct bignum *) alloc_unboxed(type_Bignum, 1); - ptr->digits[0] = n; + ptr->digits[0] = n; return (lispobj) ptr | type_OtherPointer; } } -lispobj alloc_string(char *str) +lispobj +alloc_string(char *str) { int len = strlen(str); - lispobj result = alloc_vector(type_SimpleString, len+1, 8); - struct vector *vec = (struct vector *)PTR(result); + lispobj result = alloc_vector(type_SimpleString, len + 1, 8); + struct vector *vec = (struct vector *) PTR(result); vec->length = make_fixnum(len); - strcpy((char *)vec->data, str); + strcpy((char *) vec->data, str); return result; } -lispobj alloc_sap(void *ptr) +lispobj +alloc_sap(void *ptr) { #ifndef alpha - struct sap *sap_ptr = (struct sap *)alloc_unboxed(type_Sap, 1); + struct sap *sap_ptr = (struct sap *) alloc_unboxed(type_Sap, 1); #else - struct sap *sap_ptr = (struct sap *)alloc_unboxed(type_Sap, 3); + struct sap *sap_ptr = (struct sap *) alloc_unboxed(type_Sap, 3); #endif sap_ptr->pointer = ptr; diff --git a/lisp/alpha-arch.c b/lisp/alpha-arch.c index 1c2f9d41c..01a45d886 100644 --- a/lisp/alpha-arch.c +++ b/lisp/alpha-arch.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/alpha-arch.c,v 1.7 2005/09/05 06:09:12 cshapiro Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/alpha-arch.c,v 1.8 2005/09/15 18:26:50 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -27,84 +27,95 @@ extern char call_into_lisp_LRA[], call_into_lisp_end[]; #define BREAKPOINT_INST 0 -char *arch_init(void) +char * +arch_init(void) { - if(mmap((os_vm_address_t) call_into_lisp_LRA_page,OS_VM_DEFAULT_PAGESIZE, - OS_VM_PROT_ALL,MAP_PRIVATE|MAP_ANONYMOUS|MAP_FIXED,-1,0) - == (os_vm_address_t) -1) - perror("mmap"); - memcpy(call_into_lisp_LRA_page,call_into_lisp_LRA,OS_VM_DEFAULT_PAGESIZE); - os_flush_icache((os_vm_address_t)call_into_lisp_LRA_page, - OS_VM_DEFAULT_PAGESIZE); - return NULL; + if (mmap((os_vm_address_t) call_into_lisp_LRA_page, OS_VM_DEFAULT_PAGESIZE, + OS_VM_PROT_ALL, MAP_PRIVATE | MAP_ANONYMOUS | MAP_FIXED, -1, 0) + == (os_vm_address_t) - 1) + perror("mmap"); + memcpy(call_into_lisp_LRA_page, call_into_lisp_LRA, OS_VM_DEFAULT_PAGESIZE); + os_flush_icache((os_vm_address_t) call_into_lisp_LRA_page, + OS_VM_DEFAULT_PAGESIZE); + return NULL; } -os_vm_address_t arch_get_bad_addr(int sig, int code, struct sigcontext *scp) +os_vm_address_t +arch_get_bad_addr(int sig, int code, struct sigcontext * scp) { - unsigned int badinst; + unsigned int badinst; - if((scp->sc_pc & 3) != 0) return NULL; + if ((scp->sc_pc & 3) != 0) + return NULL; - if( (scp->sc_pc < READ_ONLY_SPACE_START || - scp->sc_pc >= READ_ONLY_SPACE_START+READ_ONLY_SPACE_SIZE) && - ((lispobj *)scp->sc_pc < current_dynamic_space || - (lispobj *)scp->sc_pc >= current_dynamic_space + dynamic_space_size)) - return NULL; + if ((scp->sc_pc < READ_ONLY_SPACE_START || + scp->sc_pc >= READ_ONLY_SPACE_START + READ_ONLY_SPACE_SIZE) && + ((lispobj *) scp->sc_pc < current_dynamic_space || + (lispobj *) scp->sc_pc >= current_dynamic_space + dynamic_space_size)) + return NULL; - badinst = *(unsigned int *)scp->sc_pc; + badinst = *(unsigned int *) scp->sc_pc; - if(((badinst>>27)!=0x16) /* STL or STQ */ - && ((badinst>>27)!=0x13)) /* STS or STT */ - return NULL; /* Otherwise forget about address */ + if (((badinst >> 27) != 0x16) /* STL or STQ */ + &&((badinst >> 27) != 0x13)) /* STS or STT */ + return NULL; /* Otherwise forget about address */ - return (os_vm_address_t)(scp->sc_regs[(badinst>>16)&0x1f]+(badinst&0xffff)); + return (os_vm_address_t) (scp->sc_regs[(badinst >> 16) & 0x1f] + + (badinst & 0xffff)); } -void arch_skip_instruction(scp) -struct sigcontext *scp; +void +arch_skip_instruction(scp) + struct sigcontext *scp; { - scp->sc_pc=+4; + scp->sc_pc = +4; } -unsigned char *arch_internal_error_arguments(struct sigcontext *scp) +unsigned char * +arch_internal_error_arguments(struct sigcontext *scp) { - return (unsigned char *)(scp->sc_pc+4); + return (unsigned char *) (scp->sc_pc + 4); } -boolean arch_pseudo_atomic_atomic(struct sigcontext *scp) +boolean +arch_pseudo_atomic_atomic(struct sigcontext *scp) { - return (scp->sc_regs[reg_ALLOC] & 1); + return (scp->sc_regs[reg_ALLOC] & 1); } -void arch_set_pseudo_atomic_interrupted(struct sigcontext *scp) +void +arch_set_pseudo_atomic_interrupted(struct sigcontext *scp) { #ifdef __linux__ - scp->sc_regs[reg_ALLOC] |= (1<<63); + scp->sc_regs[reg_ALLOC] |= (1 << 63); #else - scp->sc_regs[reg_ALLOC] |= 2; + scp->sc_regs[reg_ALLOC] |= 2; #endif } -unsigned long arch_install_breakpoint(void *pc) +unsigned long +arch_install_breakpoint(void *pc) { - unsigned int *ptr = (unsigned int *)pc; - unsigned long result = (unsigned long) *ptr; - *ptr = BREAKPOINT_INST; - - os_flush_icache((os_vm_address_t)ptr, sizeof(unsigned long)); + unsigned int *ptr = (unsigned int *) pc; + unsigned long result = (unsigned long) *ptr; + + *ptr = BREAKPOINT_INST; + + os_flush_icache((os_vm_address_t) ptr, sizeof(unsigned long)); - return result; + return result; } -void arch_remove_breakpoint(void *pc, unsigned long orig_inst) +void +arch_remove_breakpoint(void *pc, unsigned long orig_inst) { - unsigned int *ptr=(unsigned int)pc; - *ptr = orig_inst; - os_flush_icache((os_vm_address_t)pc, sizeof(unsigned long)); + unsigned int *ptr = (unsigned int) pc; + + *ptr = orig_inst; + os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long)); } -static unsigned int *skipped_break_addr, displaced_after_inst, - after_breakpoint; +static unsigned int *skipped_break_addr, displaced_after_inst, after_breakpoint; #ifdef POSIX_SIGS static sigset_t orig_sigmask; @@ -113,211 +124,240 @@ static int orig_sigmask; #endif unsigned int -emulate_branch(struct sigcontext *scp,unsigned long orig_inst) +emulate_branch(struct sigcontext *scp, unsigned long orig_inst) { - int op = orig_inst >> 26; - int reg_a = (orig_inst >> 21) & 0x1f; - int reg_b = (orig_inst >> 16) & 0x1f; - int fn = orig_inst & 0xffff; - int disp = (orig_inst&(1<<20)) ? orig_inst | (-1 << 21) : orig_inst&0x1fffff; - int next_pc = scp->sc_pc; - int branch = NULL; - - switch(op) { - case 0x1a: /* jmp, jsr, jsr_coroutine, ret */ - scp->sc_regs[reg_a]=scp->sc_pc; - scp->sc_pc=scp->sc_regs[reg_b]& ~3; - break; - case 0x30: /* br */ - scp->sc_regs[reg_a]=scp->sc_pc; - branch = 1; - break; - case 0x31: /* fbeq */ - if(scp->sc_fpregs[reg_a]==0) branch = 1; - break; - case 0x32: /* fblt */ - if(scp->sc_fpregs[reg_a]<0) branch = 1; - break; - case 0x33: /* fble */ - if(scp->sc_fpregs[reg_a]<=0) branch = 1; - break; - case 0x34: /* bsr */ - scp->sc_regs[reg_a]=scp->sc_pc; - branch = 1; - break; - case 0x35: /* fbne */ - if(scp->sc_regs[reg_a]!=0) branch = 1; - break; - case 0x36: /* fbge */ - if(scp->sc_fpregs[reg_a]>=0) branch = 1; - break; - case 0x37: /* fbgt */ - if(scp->sc_fpregs[reg_a]>0) branch = 1; - break; - case 0x38: /* blbc */ - if((scp->sc_regs[reg_a]&1) == 0) branch = 1; - break; - case 0x39: /* beq */ - if(scp->sc_regs[reg_a]==0) branch = 1; - break; - case 0x3a: /* blt */ - if(scp->sc_regs[reg_a]<0) branch = 1; - break; - case 0x3b: /* ble */ - if(scp->sc_regs[reg_a]<=0) branch = 1; - break; - case 0x3c: /* blbs */ - if((scp->sc_regs[reg_a]&1)!=0) branch = 1; - break; - case 0x3d: /* bne */ - if(scp->sc_regs[reg_a]!=0) branch = 1; - break; - case 0x3e: /* bge */ - if(scp->sc_regs[reg_a]>=0) branch = 1; - break; - case 0x3f: /* bgt */ - if(scp->sc_regs[reg_a]>0) branch = 1; - break; - } - if(branch) next_pc += disp*4; - return next_pc; + int op = orig_inst >> 26; + int reg_a = (orig_inst >> 21) & 0x1f; + int reg_b = (orig_inst >> 16) & 0x1f; + int fn = orig_inst & 0xffff; + int disp = + + (orig_inst & (1 << 20)) ? orig_inst | (-1 << 21) : orig_inst & 0x1fffff; + int next_pc = scp->sc_pc; + int branch = NULL; + + switch (op) { + case 0x1a: /* jmp, jsr, jsr_coroutine, ret */ + scp->sc_regs[reg_a] = scp->sc_pc; + scp->sc_pc = scp->sc_regs[reg_b] & ~3; + break; + case 0x30: /* br */ + scp->sc_regs[reg_a] = scp->sc_pc; + branch = 1; + break; + case 0x31: /* fbeq */ + if (scp->sc_fpregs[reg_a] == 0) + branch = 1; + break; + case 0x32: /* fblt */ + if (scp->sc_fpregs[reg_a] < 0) + branch = 1; + break; + case 0x33: /* fble */ + if (scp->sc_fpregs[reg_a] <= 0) + branch = 1; + break; + case 0x34: /* bsr */ + scp->sc_regs[reg_a] = scp->sc_pc; + branch = 1; + break; + case 0x35: /* fbne */ + if (scp->sc_regs[reg_a] != 0) + branch = 1; + break; + case 0x36: /* fbge */ + if (scp->sc_fpregs[reg_a] >= 0) + branch = 1; + break; + case 0x37: /* fbgt */ + if (scp->sc_fpregs[reg_a] > 0) + branch = 1; + break; + case 0x38: /* blbc */ + if ((scp->sc_regs[reg_a] & 1) == 0) + branch = 1; + break; + case 0x39: /* beq */ + if (scp->sc_regs[reg_a] == 0) + branch = 1; + break; + case 0x3a: /* blt */ + if (scp->sc_regs[reg_a] < 0) + branch = 1; + break; + case 0x3b: /* ble */ + if (scp->sc_regs[reg_a] <= 0) + branch = 1; + break; + case 0x3c: /* blbs */ + if ((scp->sc_regs[reg_a] & 1) != 0) + branch = 1; + break; + case 0x3d: /* bne */ + if (scp->sc_regs[reg_a] != 0) + branch = 1; + break; + case 0x3e: /* bge */ + if (scp->sc_regs[reg_a] >= 0) + branch = 1; + break; + case 0x3f: /* bgt */ + if (scp->sc_regs[reg_a] > 0) + branch = 1; + break; + } + if (branch) + next_pc += disp * 4; + return next_pc; } -void arch_do_displaced_inst(struct sigcontext *scp, - unsigned long orig_inst) +void +arch_do_displaced_inst(struct sigcontext *scp, unsigned long orig_inst) { - unsigned int *pc=scp->sc_pc; - unsigned int *next_pc; - unsigned int next_inst; - int op = orig_inst >> 26;; - + unsigned int *pc = scp->sc_pc; + unsigned int *next_pc; + unsigned int next_inst; + int op = orig_inst >> 26;; + #ifdef POSIX_SIGS #if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) - orig_sigmask = context->uc_sigmask; - FILLBLOCKSET(&context->uc_sigmask); + orig_sigmask = context->uc_sigmask; + FILLBLOCKSET(&context->uc_sigmask); #else - { - sigset_t temp; - sigemptyset(&temp); - orig_sigmask.__val[0] = scp->uc_sigmask; - temp.__val[0] = scp->uc_sigmask; - FILLBLOCKSET(&temp); - - scp->uc_sigmask = temp.__val[0]; - } + { + sigset_t temp; + + sigemptyset(&temp); + orig_sigmask.__val[0] = scp->uc_sigmask; + temp.__val[0] = scp->uc_sigmask; + FILLBLOCKSET(&temp); + + scp->uc_sigmask = temp.__val[0]; + } #endif #else - orig_sigmask = scp->sc_mask; - scp->sc_mask = BLOCKABLE; + orig_sigmask = scp->sc_mask; + scp->sc_mask = BLOCKABLE; #endif - /* Figure out where the displaced inst is going */ - if(op == 0x1a || op&0xf == 0x30) /* branch...ugh */ - next_pc = (unsigned int *)emulate_branch(scp,orig_inst); - else - next_pc = pc+1; + /* Figure out where the displaced inst is going */ + if (op == 0x1a || op & 0xf == 0x30) /* branch...ugh */ + next_pc = (unsigned int *) emulate_branch(scp, orig_inst); + else + next_pc = pc + 1; - /* Put the original instruction back. */ - *pc = orig_inst; - os_flush_icache((os_vm_address_t)pc, sizeof(unsigned long)); - skipped_break_addr = pc; + /* Put the original instruction back. */ + *pc = orig_inst; + os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long)); - /* set the after breakpoint */ - displaced_after_inst = *next_pc; - *next_pc = BREAKPOINT_INST; - after_breakpoint=1; - os_flush_icache((os_vm_address_t)next_pc, sizeof(unsigned long)); + skipped_break_addr = pc; - sigreturn(scp); + /* set the after breakpoint */ + displaced_after_inst = *next_pc; + *next_pc = BREAKPOINT_INST; + after_breakpoint = 1; + os_flush_icache((os_vm_address_t) next_pc, sizeof(unsigned long)); + + sigreturn(scp); } #define AfterBreakpoint 100 -static void sigtrap_handler(int signal, int code, struct sigcontext *scp) +static void +sigtrap_handler(int signal, int code, struct sigcontext *scp) { /* Don't disallow recursive breakpoint traps. Otherwise, we can't */ /* use debugger breakpoints anywhere in here. */ sigsetmask(scp->sc_mask); - if( *(unsigned int*)(scp->sc_pc-4) == BREAKPOINT_INST) { - if(after_breakpoint) code = AfterBreakpoint; - else code = trap_Breakpoint; - } else code=*(u32 *)scp->sc_pc; + if (*(unsigned int *) (scp->sc_pc - 4) == BREAKPOINT_INST) { + if (after_breakpoint) + code = AfterBreakpoint; + else + code = trap_Breakpoint; + } else + code = *(u32 *) scp->sc_pc; switch (code) { case trap_PendingInterrupt: - arch_skip_instruction(scp); - interrupt_handle_pending(scp); - break; + arch_skip_instruction(scp); + interrupt_handle_pending(scp); + break; case trap_Halt: - fake_foreign_function_call(scp); - lose("%%primitive halt called; the party is over.\n"); + fake_foreign_function_call(scp); + lose("%%primitive halt called; the party is over.\n"); case trap_Error: case trap_Cerror: - interrupt_internal_error(signal, code, scp, code==trap_Cerror); - break; + interrupt_internal_error(signal, code, scp, code == trap_Cerror); + break; case trap_Breakpoint: - scp->sc_pc -=4; - handle_breakpoint(signal, code, scp); - break; + scp->sc_pc -= 4; + handle_breakpoint(signal, code, scp); + break; case trap_FunctionEndBreakpoint: - scp->sc_pc -=4; - scp->sc_pc = (int)handle_function_end_breakpoint(signal, code, scp); - break; + scp->sc_pc -= 4; + scp->sc_pc = (int) handle_function_end_breakpoint(signal, code, scp); + break; case AfterBreakpoint: - scp->sc_pc -=4; - *skipped_break_addr = BREAKPOINT_INST; - os_flush_icache((os_vm_address_t)skipped_break_addr, - sizeof(unsigned long)); - skipped_break_addr = NULL; - *(unsigned int *)scp->sc_pc = displaced_after_inst; - os_flush_icache((os_vm_address_t)scp->sc_pc, sizeof(unsigned long)); + scp->sc_pc -= 4; + *skipped_break_addr = BREAKPOINT_INST; + os_flush_icache((os_vm_address_t) skipped_break_addr, + + sizeof(unsigned long)); + skipped_break_addr = NULL; + *(unsigned int *) scp->sc_pc = displaced_after_inst; + os_flush_icache((os_vm_address_t) scp->sc_pc, sizeof(unsigned long)); + #ifdef POSIX_SIGS #if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) - scp->sc_mask = orig_sigmask; + scp->sc_mask = orig_sigmask; #else - scp->sc_mask = orig_sigmask.__val[0]; + scp->sc_mask = orig_sigmask.__val[0]; #endif #else - scp->sc_mask = orig_sigmask; + scp->sc_mask = orig_sigmask; #endif - after_breakpoint=NULL; - break; + after_breakpoint = NULL; + break; default: - interrupt_handle_now(signal, code, scp); - break; + interrupt_handle_now(signal, code, scp); + break; } } #define FIXNUM_VALUE(lispobj) (((int)lispobj)>>2) -static void sigfpe_handler(int signal, int code, struct sigcontext *scp) +static void +sigfpe_handler(int signal, int code, struct sigcontext *scp) { } -void arch_install_interrupt_handlers() +void +arch_install_interrupt_handlers() { - interrupt_install_low_level_handler(SIGILL,sigtrap_handler); - interrupt_install_low_level_handler(SIGTRAP,sigtrap_handler); - interrupt_install_low_level_handler(SIGFPE,sigfpe_handler); + interrupt_install_low_level_handler(SIGILL, sigtrap_handler); + interrupt_install_low_level_handler(SIGTRAP, sigtrap_handler); + interrupt_install_low_level_handler(SIGFPE, sigfpe_handler); } -extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs); +extern lispobj call_into_lisp(lispobj fun, lispobj * args, int nargs); -lispobj funcall0(lispobj function) +lispobj +funcall0(lispobj function) { lispobj *args = current_control_stack_pointer; return call_into_lisp(function, args, 0); } -lispobj funcall1(lispobj function, lispobj arg0) +lispobj +funcall1(lispobj function, lispobj arg0) { lispobj *args = current_control_stack_pointer; @@ -327,7 +367,8 @@ lispobj funcall1(lispobj function, lispobj arg0) return call_into_lisp(function, args, 1); } -lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1) +lispobj +funcall2(lispobj function, lispobj arg0, lispobj arg1) { lispobj *args = current_control_stack_pointer; @@ -338,7 +379,8 @@ lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1) return call_into_lisp(function, args, 2); } -lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) +lispobj +funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) { lispobj *args = current_control_stack_pointer; @@ -354,6 +396,7 @@ lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) /* This is apparently called by emulate_branch, but isn't defined. So */ /* just do nothing and hope it works... */ -void cacheflush(void) +void +cacheflush(void) { } diff --git a/lisp/amd64-arch.c b/lisp/amd64-arch.c index a96e3516a..092448fbd 100644 --- a/lisp/amd64-arch.c +++ b/lisp/amd64-arch.c @@ -1,6 +1,6 @@ /* x86-arch.c -*- Mode: C; comment-column: 40 -*- * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/amd64-arch.c,v 1.3 2004/06/22 22:38:27 cwang Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/amd64-arch.c,v 1.4 2005/09/15 18:26:50 rtoy Exp $ * */ @@ -23,15 +23,16 @@ #define BREAKPOINT_INST 0xcc /* INT3 */ -unsigned long fast_random_state = 1; +unsigned long fast_random_state = 1; -char * arch_init(void) +char * +arch_init(void) { - return "lisp.core"; + return "lisp.core"; } - + /* * Assuming we get here via an INT3 xxx instruction, the PC now * points to the interrupt code (lisp value) so we just move past @@ -39,282 +40,293 @@ char * arch_init(void) * Cerror-trap then skip the data bytes that follow. */ -void arch_skip_instruction(struct sigcontext *context) +void +arch_skip_instruction(struct sigcontext *context) { - int vlen,code; - - DPRINTF(0,(stderr,"[arch_skip_inst at %x>]\n", context->sc_pc)); - - /* Get and skip the lisp error code. */ - code = *(char*) context->sc_pc++; - switch (code) - { - case trap_Error: - case trap_Cerror: - /* Lisp error arg vector length */ - vlen = *(char*) context->sc_pc++; - /* Skip lisp error arg data bytes */ - while(vlen-- > 0) - ((char*) context->sc_pc)++; - break; - - case trap_Breakpoint: - case trap_FunctionEndBreakpoint: - break; - - case trap_PendingInterrupt: - case trap_Halt: - /* Only needed to skip the Code. */ - break; - - default: - fprintf(stderr, "[arch_skip_inst invalid code %d\n]\n", code); - break; + int vlen, code; + + DPRINTF(0, (stderr, "[arch_skip_inst at %x>]\n", context->sc_pc)); + + /* Get and skip the lisp error code. */ + code = *(char *) context->sc_pc++; + switch (code) { + case trap_Error: + case trap_Cerror: + /* Lisp error arg vector length */ + vlen = *(char *) context->sc_pc++; + /* Skip lisp error arg data bytes */ + while (vlen-- > 0) + ((char *) context->sc_pc)++; + break; + + case trap_Breakpoint: + case trap_FunctionEndBreakpoint: + break; + + case trap_PendingInterrupt: + case trap_Halt: + /* Only needed to skip the Code. */ + break; + + default: + fprintf(stderr, "[arch_skip_inst invalid code %d\n]\n", code); + break; } - DPRINTF(0,(stderr,"[arch_skip_inst resuming at %x>]\n", context->sc_pc)); + DPRINTF(0, (stderr, "[arch_skip_inst resuming at %x>]\n", context->sc_pc)); } -unsigned char * arch_internal_error_arguments(struct sigcontext *context) +unsigned char * +arch_internal_error_arguments(struct sigcontext *context) { - return (unsigned char *) (context->sc_pc + 1); + return (unsigned char *) (context->sc_pc + 1); } -boolean arch_pseudo_atomic_atomic(struct sigcontext *context) +boolean +arch_pseudo_atomic_atomic(struct sigcontext *context) { - return SymbolValue(PSEUDO_ATOMIC_ATOMIC); + return SymbolValue(PSEUDO_ATOMIC_ATOMIC); } -void arch_set_pseudo_atomic_interrupted(struct sigcontext *context) +void +arch_set_pseudo_atomic_interrupted(struct sigcontext *context) { - SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1)); + SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1)); } - -unsigned long arch_install_breakpoint(void *pc) + +unsigned long +arch_install_breakpoint(void *pc) { - unsigned long result = *(unsigned long*)pc; + unsigned long result = *(unsigned long *) pc; - *(char*)pc = BREAKPOINT_INST; /* x86 INT3 */ - *((char*)pc+1) = trap_Breakpoint; /* Lisp trap code */ - - return result; + *(char *) pc = BREAKPOINT_INST; /* x86 INT3 */ + *((char *) pc + 1) = trap_Breakpoint; /* Lisp trap code */ + + return result; } -void arch_remove_breakpoint(void *pc, unsigned long orig_inst) +void +arch_remove_breakpoint(void *pc, unsigned long orig_inst) { - *((char *) pc) = orig_inst & 0xff; - *((char *) pc + 1) = (orig_inst & 0xff00) >> 8; + *((char *) pc) = orig_inst & 0xff; + *((char *) pc + 1) = (orig_inst & 0xff00) >> 8; } - + /* * When single stepping single_stepping holds the original instruction * pc location. */ unsigned int *single_stepping = NULL; + #ifndef __linux__ -unsigned int single_step_save1; -unsigned int single_step_save2; -unsigned int single_step_save3; +unsigned int single_step_save1; +unsigned int single_step_save2; +unsigned int single_step_save3; #endif -void arch_do_displaced_inst(struct sigcontext *context, - unsigned long orig_inst) +void +arch_do_displaced_inst(struct sigcontext *context, unsigned long orig_inst) { - unsigned int *pc = (unsigned int*) context->sc_pc; + unsigned int *pc = (unsigned int *) context->sc_pc; - /* - * Put the original instruction back. - */ + /* + * Put the original instruction back. + */ - *((char *) pc) = orig_inst & 0xff; - *((char *) pc + 1) = (orig_inst & 0xff00) >> 8; + *((char *) pc) = orig_inst & 0xff; + *((char *) pc + 1) = (orig_inst & 0xff00) >> 8; #ifdef __linux__ - context->eflags |= 0x100; + context->eflags |= 0x100; #else - /* - * Install helper instructions for the single step: - * pushf; or [esp],0x100; popf. - */ - - single_step_save1 = *(pc - 3); - single_step_save2 = *(pc - 2); - single_step_save3 = *(pc - 1); - *(pc - 3) = 0x9c909090; - *(pc - 2) = 0x00240c81; - *(pc - 1) = 0x9d000001; + /* + * Install helper instructions for the single step: + * pushf; or [esp],0x100; popf. + */ + + single_step_save1 = *(pc - 3); + single_step_save2 = *(pc - 2); + single_step_save3 = *(pc - 1); + *(pc - 3) = 0x9c909090; + *(pc - 2) = 0x00240c81; + *(pc - 1) = 0x9d000001; #endif - single_stepping = (unsigned int*) pc; + single_stepping = (unsigned int *) pc; #ifndef __linux__ - (unsigned int*) context->sc_pc = (char *) pc - 9; + (unsigned int *) context->sc_pc = (char *) pc - 9; #endif } -void sigtrap_handler(HANDLER_ARGS) +void +sigtrap_handler(HANDLER_ARGS) { - unsigned int trap; - + unsigned int trap; + #ifdef __linux__ - GET_CONTEXT + GET_CONTEXT #endif - #if 0 - fprintf(stderr,"x86sigtrap: %8x %x\n", - context->sc_pc, *(unsigned char *)(context->sc_pc-1)); - fprintf(stderr,"sigtrap(%d %d %x)\n",signal,code,context); + fprintf(stderr, "x86sigtrap: %8x %x\n", + context->sc_pc, *(unsigned char *) (context->sc_pc - 1)); + fprintf(stderr, "sigtrap(%d %d %x)\n", signal, code, context); #endif - if (single_stepping && (signal == SIGTRAP)) - { + if (single_stepping && (signal == SIGTRAP)) { #if 0 - fprintf(stderr,"* Single step trap %x\n", single_stepping); + fprintf(stderr, "* Single step trap %x\n", single_stepping); #endif #ifndef __linux__ - /* Un-install single step helper instructions. */ - *(single_stepping-3) = single_step_save1; - *(single_stepping-2) = single_step_save2; - *(single_stepping-1) = single_step_save3; -#else - context->eflags ^= 0x100; + /* Un-install single step helper instructions. */ + *(single_stepping - 3) = single_step_save1; + *(single_stepping - 2) = single_step_save2; + *(single_stepping - 1) = single_step_save3; +#else + context->eflags ^= 0x100; #endif - /* - * Re-install the breakpoint if possible. - */ - - if ((int) context->sc_pc == (int) single_stepping + 1) - fprintf(stderr, "* Breakpoint not re-install\n"); - else - { - char *ptr = (char *) single_stepping; - ptr[0] = BREAKPOINT_INST; /* x86 INT3 */ - ptr[1] = trap_Breakpoint; + /* + * Re-install the breakpoint if possible. + */ + + if ((int) context->sc_pc == (int) single_stepping + 1) + fprintf(stderr, "* Breakpoint not re-install\n"); + else { + char *ptr = (char *) single_stepping; + + ptr[0] = BREAKPOINT_INST; /* x86 INT3 */ + ptr[1] = trap_Breakpoint; } - single_stepping = NULL; - return; + single_stepping = NULL; + return; } - SAVE_CONTEXT(); + SAVE_CONTEXT(); - /* This is just for info in case monitor wants to print an approx */ - current_control_stack_pointer = (unsigned long*) context->sc_sp; + /* This is just for info in case monitor wants to print an approx */ + current_control_stack_pointer = (unsigned long *) context->sc_sp; #if defined(__linux__) && (defined(i386) || defined(__x86_64)) - /* - * Restore the FPU control word, setting the rounding mode to nearest. - */ + /* + * Restore the FPU control word, setting the rounding mode to nearest. + */ - if (contextstruct.fpstate) + if (contextstruct.fpstate) #if defined(__x86_64) - setfpucw(contextstruct.fpstate->cwd & ~0xc00); + setfpucw(contextstruct.fpstate->cwd & ~0xc00); #else - setfpucw(contextstruct.fpstate->cw & ~0xc00); + setfpucw(contextstruct.fpstate->cw & ~0xc00); #endif #endif - /* - * On entry %eip points just after the INT3 byte and aims at the - * 'kind' value (eg trap_Cerror). For error-trap and Cerror-trap a - * number of bytes will follow, the first is the length of the byte - * arguments to follow. - */ - - trap = *(unsigned char *) (context->sc_pc); - - switch (trap) - { - case trap_PendingInterrupt: - DPRINTF(0,(stderr,"<trap Pending Interrupt.>\n")); - arch_skip_instruction(context); - interrupt_handle_pending(context); - break; - - case trap_Halt: - { + /* + * On entry %eip points just after the INT3 byte and aims at the + * 'kind' value (eg trap_Cerror). For error-trap and Cerror-trap a + * number of bytes will follow, the first is the length of the byte + * arguments to follow. + */ + + trap = *(unsigned char *) (context->sc_pc); + + switch (trap) { + case trap_PendingInterrupt: + DPRINTF(0, (stderr, "<trap Pending Interrupt.>\n")); + arch_skip_instruction(context); + interrupt_handle_pending(context); + break; + + case trap_Halt: + { #if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) - int fpu_state[27]; - fpu_save(fpu_state); + int fpu_state[27]; + + fpu_save(fpu_state); #endif - fake_foreign_function_call(context); - lose("%%primitive halt called; the party is over.\n"); - undo_fake_foreign_function_call(context); + fake_foreign_function_call(context); + lose("%%primitive halt called; the party is over.\n"); + undo_fake_foreign_function_call(context); #if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) - fpu_restore(fpu_state); + fpu_restore(fpu_state); #endif - arch_skip_instruction(context); - break; - } - - case trap_Error: - case trap_Cerror: - DPRINTF(0, (stderr, "<trap Error %d>\n",code)); + arch_skip_instruction(context); + break; + } + + case trap_Error: + case trap_Cerror: + DPRINTF(0, (stderr, "<trap Error %d>\n", code)); #ifdef __linux__ - interrupt_internal_error(signal, contextstruct, code == trap_Cerror); + interrupt_internal_error(signal, contextstruct, code == trap_Cerror); #else - interrupt_internal_error(signal, code, context, code == trap_Cerror); + interrupt_internal_error(signal, code, context, code == trap_Cerror); #endif - break; + break; - case trap_Breakpoint: + case trap_Breakpoint: #if 0 - fprintf(stderr,"*C break\n"); + fprintf(stderr, "*C break\n"); #endif - (char*) context->sc_pc -= 1; - handle_breakpoint(signal, code, context); + (char *) context->sc_pc -= 1; + handle_breakpoint(signal, code, context); #if 0 - fprintf(stderr,"*C break return\n"); + fprintf(stderr, "*C break return\n"); #endif - break; - - case trap_FunctionEndBreakpoint: - (char*) context->sc_pc -= 1; - context->sc_pc = (int) handle_function_end_breakpoint(signal, code, context); - break; - + break; + + case trap_FunctionEndBreakpoint: + (char *) context->sc_pc -= 1; + context->sc_pc = + (int) handle_function_end_breakpoint(signal, code, context); + break; + #ifdef DYNAMIC_SPACE_OVERFLOW_WARNING_HIT - case trap_DynamicSpaceOverflowWarning: - interrupt_handle_space_overflow(SymbolFunction(DYNAMIC_SPACE_OVERFLOW_WARNING_HIT), - context); - break; + case trap_DynamicSpaceOverflowWarning: + interrupt_handle_space_overflow(SymbolFunction + (DYNAMIC_SPACE_OVERFLOW_WARNING_HIT), + context); + break; #endif #ifdef DYNAMIC_SPACE_OVERFLOW_ERROR_HIT - case trap_DynamicSpaceOverflowError: - interrupt_handle_space_overflow(SymbolFunction(DYNAMIC_SPACE_OVERFLOW_ERROR_HIT), - context); - break; + case trap_DynamicSpaceOverflowError: + interrupt_handle_space_overflow(SymbolFunction + (DYNAMIC_SPACE_OVERFLOW_ERROR_HIT), + context); + break; #endif - default: - DPRINTF(0,(stderr,"[C--trap default %d %d %x]\n", signal, code,context)); + default: + DPRINTF(0, + (stderr, "[C--trap default %d %d %x]\n", signal, code, + context)); #ifdef __linux__ - interrupt_handle_now(signal, contextstruct); + interrupt_handle_now(signal, contextstruct); #else - interrupt_handle_now(signal, code, context); + interrupt_handle_now(signal, code, context); #endif - break; + break; } } #define FIXNUM_VALUE(lispobj) (((int) lispobj) >> 2) -void arch_install_interrupt_handlers() +void +arch_install_interrupt_handlers() { interrupt_install_low_level_handler(SIGILL, sigtrap_handler); interrupt_install_low_level_handler(SIGTRAP, sigtrap_handler); } -extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs); +extern lispobj call_into_lisp(lispobj fun, lispobj * args, int nargs); /* These next four functions are an interface to the * Lisp call-in facility. Since this is C we can know @@ -328,31 +340,38 @@ extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs); * call-in function figure it out. */ -lispobj funcall0(lispobj function) +lispobj +funcall0(lispobj function) { lispobj *args = NULL; return call_into_lisp(function, args, 0); } -lispobj funcall1(lispobj function, lispobj arg0) +lispobj +funcall1(lispobj function, lispobj arg0) { lispobj args[1]; + args[0] = arg0; return call_into_lisp(function, args, 1); } -lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1) +lispobj +funcall2(lispobj function, lispobj arg0, lispobj arg1) { lispobj args[2]; + args[0] = arg0; args[1] = arg1; return call_into_lisp(function, args, 2); } -lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) +lispobj +funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) { lispobj args[3]; + args[0] = arg0; args[1] = arg1; args[2] = arg2; @@ -365,43 +384,47 @@ lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) #define LinkageEntrySize 16 #endif -void arch_make_linkage_entry(long linkage_entry, void *target_addr, long type) +void +arch_make_linkage_entry(long linkage_entry, void *target_addr, long type) { - char *reloc_addr = (char *)(FOREIGN_LINKAGE_SPACE_START - + linkage_entry * LinkageEntrySize); + char *reloc_addr = (char *) (FOREIGN_LINKAGE_SPACE_START - if (type == 1) { /* code reference */ - /* Make JMP to function entry. */ - long offset = (char *)target_addr; + + linkage_entry * LinkageEntrySize); + + if (type == 1) { /* code reference */ + /* Make JMP to function entry. */ + long offset = (char *) target_addr; int i; - + /* %r11 is a temp register */ - *reloc_addr++ = 0x49; /* opcode for MOV */ - *reloc_addr++ = 0xbb; /* %r11 */ + *reloc_addr++ = 0x49; /* opcode for MOV */ + *reloc_addr++ = 0xbb; /* %r11 */ for (i = 0; i < 8; i++) { *reloc_addr++ = offset & 0xff; offset >>= 8; } - *reloc_addr++ = 0x41; /* jmpq */ + *reloc_addr++ = 0x41; /* jmpq */ *reloc_addr++ = 0xff; - *reloc_addr++ = 0xe3; /* %r11 */ + *reloc_addr++ = 0xe3; /* %r11 */ /* write a nop for good measure. */ *reloc_addr = 0x90; } else if (type == 2) { - *(unsigned long *)reloc_addr = (unsigned long)target_addr; + *(unsigned long *) reloc_addr = (unsigned long) target_addr; } } /* Make a call to the first function in the linkage table, which is resolve_linkage_tramp. */ -void arch_make_lazy_linkage(long linkage_entry) +void +arch_make_lazy_linkage(long linkage_entry) { - char *reloc_addr = (char *)(FOREIGN_LINKAGE_SPACE_START - + linkage_entry * LinkageEntrySize); - long offset = (char *)(FOREIGN_LINKAGE_SPACE_START) - (reloc_addr + 5); + char *reloc_addr = (char *) (FOREIGN_LINKAGE_SPACE_START + + + linkage_entry * LinkageEntrySize); + long offset = (char *) (FOREIGN_LINKAGE_SPACE_START) - (reloc_addr + 5); int i; - *reloc_addr++ = 0xe8; /* opcode for CALL rel32 */ + *reloc_addr++ = 0xe8; /* opcode for CALL rel32 */ for (i = 0; i < 4; i++) { *reloc_addr++ = offset & 0xff; offset >>= 8; @@ -414,7 +437,8 @@ void arch_make_lazy_linkage(long linkage_entry) entry is a CALL; the return address we're passed points to the next instruction. */ -long arch_linkage_entry(unsigned long retaddr) +long +arch_linkage_entry(unsigned long retaddr) { return ((retaddr - 5) - FOREIGN_LINKAGE_SPACE_START) / LinkageEntrySize; } diff --git a/lisp/arch.h b/lisp/arch.h index 9e94adee1..a862a9252 100644 --- a/lisp/arch.h +++ b/lisp/arch.h @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/arch.h,v 1.7 2004/07/07 15:03:11 rtoy Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/arch.h,v 1.8 2005/09/15 18:26:51 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -14,20 +14,20 @@ #include "signal.h" extern char *arch_init(void); -extern void arch_skip_instruction(os_context_t *scp); -extern boolean arch_pseudo_atomic_atomic(os_context_t *scp); -extern void arch_set_pseudo_atomic_interrupted(os_context_t *scp); +extern void arch_skip_instruction(os_context_t * scp); +extern boolean arch_pseudo_atomic_atomic(os_context_t * scp); +extern void arch_set_pseudo_atomic_interrupted(os_context_t * scp); extern os_vm_address_t arch_get_bad_addr(HANDLER_ARGS); -extern unsigned char *arch_internal_error_arguments(os_context_t *scp); +extern unsigned char *arch_internal_error_arguments(os_context_t * scp); extern unsigned long arch_install_breakpoint(void *pc); extern void arch_remove_breakpoint(void *pc, unsigned long orig_inst); extern void arch_install_interrupt_handlers(void); -extern void arch_do_displaced_inst(os_context_t *scp, - unsigned long orig_inst); +extern void arch_do_displaced_inst(os_context_t * scp, unsigned long orig_inst); extern lispobj funcall0(lispobj function); extern lispobj funcall1(lispobj function, lispobj arg0); extern lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1); extern lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, + lispobj arg2); extern void fpu_save(void *); diff --git a/lisp/backtrace.c b/lisp/backtrace.c index ddb4f74ab..528fbbc4a 100644 --- a/lisp/backtrace.c +++ b/lisp/backtrace.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/backtrace.c,v 1.13 2004/08/04 18:33:58 cwang Exp $ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/backtrace.c,v 1.14 2005/09/15 18:26:51 rtoy Exp $ * * Simple backtrace facility. More or less from Rob's lisp version. */ @@ -19,13 +19,13 @@ struct call_frame { #ifndef alpha - struct call_frame *old_cont; + struct call_frame *old_cont; #else - u32 old_cont; + u32 old_cont; #endif - lispobj saved_lra; - lispobj code; - lispobj other_state[5]; + lispobj saved_lra; + lispobj code; + lispobj other_state[5]; }; struct call_info { @@ -41,7 +41,7 @@ struct call_info { u32 code; #endif lispobj lra; - int pc; /* Note: this is the trace file offset, not the actual pc. */ + int pc; /* Note: this is the trace file offset, not the actual pc. */ }; #define HEADER_LENGTH(header) ((header)>>8) @@ -59,19 +59,19 @@ code_pointer(lispobj object) type = TypeOf(header); switch (type) { - case type_CodeHeader: - break; - case type_ReturnPcHeader: - case type_FunctionHeader: - case type_ClosureFunctionHeader: - len = HEADER_LENGTH(header); - if (len == 0) - headerp = NULL; - else - headerp -= len; - break; - default: - headerp = NULL; + case type_CodeHeader: + break; + case type_ReturnPcHeader: + case type_FunctionHeader: + case type_ClosureFunctionHeader: + len = HEADER_LENGTH(header); + if (len == 0) + headerp = NULL; + else + headerp -= len; + break; + default: + headerp = NULL; } return (struct code *) headerp; @@ -80,14 +80,14 @@ code_pointer(lispobj object) static boolean cs_valid_pointer_p(struct call_frame *pointer) { - return (((char *) control_stack <= (char *) pointer) && - ((char *) pointer < (char *) current_control_stack_pointer)); + return (((char *) control_stack <= (char *) pointer) && + ((char *) pointer < (char *) current_control_stack_pointer)); } static void info_from_lisp_state(struct call_info *info) { - info->frame = (struct call_frame *)current_control_frame_pointer; + info->frame = (struct call_frame *) current_control_frame_pointer; info->interrupted = 0; info->code = NULL; info->lra = 0; @@ -97,33 +97,32 @@ info_from_lisp_state(struct call_info *info) } static void -info_from_sigcontext(struct call_info *info, os_context_t *csp) +info_from_sigcontext(struct call_info *info, os_context_t * csp) { unsigned long pc; info->interrupted = 1; if (LowtagOf(SC_REG(csp, reg_CODE)) == type_FunctionPointer) { - /* We tried to call a function, but crapped out before $CODE could be fixed up. Probably an undefined function. */ - info->frame = (struct call_frame *)SC_REG(csp, reg_OCFP); - info->lra = (lispobj)SC_REG(csp, reg_LRA); - info->code = code_pointer(info->lra); - pc = (unsigned long)PTR(info->lra); - } - else { - info->frame = (struct call_frame *)SC_REG(csp, reg_CFP); - info->code = code_pointer(SC_REG(csp, reg_CODE)); - info->lra = NIL; - pc = SC_PC(csp); + /* We tried to call a function, but crapped out before $CODE could be fixed up. Probably an undefined function. */ + info->frame = (struct call_frame *) SC_REG(csp, reg_OCFP); + info->lra = (lispobj) SC_REG(csp, reg_LRA); + info->code = code_pointer(info->lra); + pc = (unsigned long) PTR(info->lra); + } else { + info->frame = (struct call_frame *) SC_REG(csp, reg_CFP); + info->code = code_pointer(SC_REG(csp, reg_CODE)); + info->lra = NIL; + pc = SC_PC(csp); } if (info->code != NULL) - info->pc = pc - (unsigned long) info->code - + info->pc = pc - (unsigned long) info->code - #ifndef alpha - (HEADER_LENGTH(info->code->header) * sizeof(lispobj)); + (HEADER_LENGTH(info->code->header) * sizeof(lispobj)); #else - (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj)); + (HEADER_LENGTH(((struct code *) info->code)->header) * sizeof(lispobj)); #endif else - info->pc = 0; + info->pc = 0; } static int @@ -134,8 +133,8 @@ previous_info(struct call_info *info) os_context_t *csp; if (!cs_valid_pointer_p(info->frame)) { - printf("Bogus callee value (0x%08lx).\n", (unsigned long)info->frame); - return 0; + printf("Bogus callee value (0x%08lx).\n", (unsigned long) info->frame); + return 0; } this_frame = info->frame; @@ -144,31 +143,30 @@ previous_info(struct call_info *info) info->interrupted = 0; if (info->frame == NULL || info->frame == this_frame) - return 0; + return 0; if (info->lra == NIL) { - /* We were interrupted. Find the correct sigcontext. */ - free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2; - while (free-- > 0) { - csp = lisp_interrupt_contexts[free]; - if ((struct call_frame *)(SC_REG(csp, reg_CFP)) == info->frame) { - info_from_sigcontext(info, csp); - break; - } - } - } - else { - info->code = code_pointer(info->lra); - if (info->code != NULL) - info->pc = (unsigned long)PTR(info->lra) - - (unsigned long)info->code - + /* We were interrupted. Find the correct sigcontext. */ + free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX) >> 2; + while (free-- > 0) { + csp = lisp_interrupt_contexts[free]; + if ((struct call_frame *) (SC_REG(csp, reg_CFP)) == info->frame) { + info_from_sigcontext(info, csp); + break; + } + } + } else { + info->code = code_pointer(info->lra); + if (info->code != NULL) + info->pc = (unsigned long) PTR(info->lra) - + (unsigned long) info->code - #ifndef alpha - (HEADER_LENGTH(info->code->header) * sizeof(lispobj)); + (HEADER_LENGTH(info->code->header) * sizeof(lispobj)); #else - (HEADER_LENGTH(((struct code *)info->code)->header) * sizeof(lispobj)); + (HEADER_LENGTH(((struct code *) info->code)->header) * sizeof(lispobj)); #endif - else - info->pc = 0; + else + info->pc = 0; } return 1; @@ -178,67 +176,67 @@ void backtrace(int nframes) { struct call_info info; - + info_from_lisp_state(&info); do { - printf("<Frame 0x%08lx%s, ", (unsigned long) info.frame, - info.interrupted ? " [interrupted]" : ""); - - if (info.code != (struct code *) 0) { - lispobj function; + printf("<Frame 0x%08lx%s, ", (unsigned long) info.frame, + info.interrupted ? " [interrupted]" : ""); + + if (info.code != (struct code *) 0) { + lispobj function; - printf("CODE: 0x%08lX, ", (unsigned long) info.code | type_OtherPointer); + printf("CODE: 0x%08lX, ", + (unsigned long) info.code | type_OtherPointer); #ifndef alpha - function = info.code->entry_points; + function = info.code->entry_points; #else - function = ((struct code *)info.code)->entry_points; + function = ((struct code *) info.code)->entry_points; #endif - while (function != NIL) { - struct function *header; - lispobj name; + while (function != NIL) { + struct function *header; + lispobj name; - header = (struct function *) PTR(function); - name = header->name; + header = (struct function *) PTR(function); + name = header->name; - if (LowtagOf(name) == type_OtherPointer) { - lispobj *object; + if (LowtagOf(name) == type_OtherPointer) { + lispobj *object; - object = (lispobj *) PTR(name); + object = (lispobj *) PTR(name); - if (TypeOf(*object) == type_SymbolHeader) { - struct symbol *symbol; + if (TypeOf(*object) == type_SymbolHeader) { + struct symbol *symbol; - symbol = (struct symbol *) object; - object = (lispobj *) PTR(symbol->name); - } - if (TypeOf(*object) == type_SimpleString) { - struct vector *string; + symbol = (struct symbol *) object; + object = (lispobj *) PTR(symbol->name); + } + if (TypeOf(*object) == type_SimpleString) { + struct vector *string; - string = (struct vector *) object; - printf("%s, ", (char *) string->data); - } else - printf("(Not simple string??\?), "); - } else - printf("(Not other pointer??\?), "); + string = (struct vector *) object; + printf("%s, ", (char *) string->data); + } else + printf("(Not simple string??\?), "); + } else + printf("(Not other pointer??\?), "); - function = header->next; - } - } - else - printf("CODE: ???, "); + function = header->next; + } + } else + printf("CODE: ???, "); - if (info.lra != NIL) - printf("LRA: 0x%08lx, ", (unsigned long)info.lra); - else - printf("<no LRA>, "); + if (info.lra != NIL) + printf("LRA: 0x%08lx, ", (unsigned long) info.lra); + else + printf("<no LRA>, "); - if (info.pc) - printf("PC: 0x%x>\n", info.pc); - else - printf("PC: ??\?>\n"); + if (info.pc) + printf("PC: 0x%x>\n", info.pc); + else + printf("PC: ??\?>\n"); } while (--nframes > 0 && previous_info(&info)); } @@ -252,278 +250,255 @@ backtrace(int nframes) #define VM_RETURN_PC_SAVE_OFFSET 1 static int -stack_pointer_p (unsigned long p) +stack_pointer_p(unsigned long p) { - return (p < CONTROL_STACK_START + CONTROL_STACK_SIZE - && p > (unsigned long) &p - && (p & 3) == 0); + return (p < CONTROL_STACK_START + CONTROL_STACK_SIZE + && p > (unsigned long) &p && (p & 3) == 0); } static int -ra_pointer_p (unsigned ra) +ra_pointer_p(unsigned ra) { - return ra > 4096 && !stack_pointer_p (ra); + return ra > 4096 && !stack_pointer_p(ra); } static unsigned -deref (unsigned long p, int offset) +deref(unsigned long p, int offset) { - return *((unsigned long *) p + offset); + return *((unsigned long *) p + offset); } static void -print_entry_name (lispobj name) +print_entry_name(lispobj name) { - if (LowtagOf (name) == type_ListPointer) - { - putchar ('('); - while (name != NIL) - { - struct cons *cons = (struct cons *) PTR (name); - print_entry_name (cons->car); - name = cons->cdr; - if (name != NIL) - putchar (' '); + if (LowtagOf(name) == type_ListPointer) { + putchar('('); + while (name != NIL) { + struct cons *cons = (struct cons *) PTR(name); + + print_entry_name(cons->car); + name = cons->cdr; + if (name != NIL) + putchar(' '); } - putchar (')'); - } - else if (LowtagOf (name) == type_OtherPointer) - { - lispobj *object = (lispobj *) PTR (name); - - if (TypeOf (*object) == type_SymbolHeader) - { - struct symbol *symbol = (struct symbol *) object; - struct vector *string; - - if (symbol->package != NIL) - { - struct instance *pkg = (struct instance *) PTR (symbol->package); - lispobj pkg_name = pkg->slots[2]; - string = (struct vector *) PTR (pkg_name); - printf ("%s::", (char *) string->data); + putchar(')'); + } else if (LowtagOf(name) == type_OtherPointer) { + lispobj *object = (lispobj *) PTR(name); + + if (TypeOf(*object) == type_SymbolHeader) { + struct symbol *symbol = (struct symbol *) object; + struct vector *string; + + if (symbol->package != NIL) { + struct instance *pkg = (struct instance *) PTR(symbol->package); + lispobj pkg_name = pkg->slots[2]; + + string = (struct vector *) PTR(pkg_name); + printf("%s::", (char *) string->data); } - - object = (lispobj *) PTR (symbol->name); - string = (struct vector *) object; - printf ("%s", (char *) string->data); - } - else if (TypeOf (*object) == type_SimpleString) - { - struct vector *string = (struct vector *) object; - printf ("\"%s\"", (char *) string->data); - } - else - printf ("<??? type %d>", (int) TypeOf (*object)); - } - else - printf ("<??? lowtag %d>", (int) LowtagOf (name)); + + object = (lispobj *) PTR(symbol->name); + string = (struct vector *) object; + printf("%s", (char *) string->data); + } else if (TypeOf(*object) == type_SimpleString) { + struct vector *string = (struct vector *) object; + + printf("\"%s\"", (char *) string->data); + } else + printf("<??? type %d>", (int) TypeOf(*object)); + } else + printf("<??? lowtag %d>", (int) LowtagOf(name)); } - + static void -print_entry_points (struct code *code) +print_entry_points(struct code *code) { - lispobj function = code->entry_points; - - while (function != NIL) - { - struct function *header = (struct function *) PTR (function); - print_entry_name (header->name); - - function = header->next; - if (function != NIL) - printf (", "); + lispobj function = code->entry_points; + + while (function != NIL) { + struct function *header = (struct function *) PTR(function); + + print_entry_name(header->name); + + function = header->next; + if (function != NIL) + printf(", "); } } /* See also X86-CALL-CONTEXT in code:debug-int. */ static int -x86_call_context (unsigned fp, unsigned *ra, unsigned *ocfp) +x86_call_context(unsigned fp, unsigned *ra, unsigned *ocfp) { - unsigned lisp_ocfp, lisp_ra, c_ocfp, c_ra; - int lisp_valid_p, c_valid_p; - - if (!stack_pointer_p (fp)) - return 0; - - lisp_ocfp = deref (fp, - (1 + VM_OCFP_SAVE_OFFSET)); - lisp_ra = deref (fp, - (1 + VM_RETURN_PC_SAVE_OFFSET)); - c_ocfp = deref (fp, 0); - c_ra = deref (fp, 1); - - lisp_valid_p = (lisp_ocfp > fp - && stack_pointer_p (lisp_ocfp) - && ra_pointer_p (lisp_ra)); - c_valid_p = (c_ocfp > fp - && stack_pointer_p (c_ocfp) - && ra_pointer_p (c_ra)); - - if (lisp_valid_p && c_valid_p) - { - unsigned lisp_path_fp, c_path_fp, dummy; - int lisp_path_p = x86_call_context (lisp_ocfp, &lisp_path_fp, &dummy); - int c_path_p = x86_call_context (c_ocfp, &c_path_fp, &dummy); - - if (lisp_path_p && c_path_p) - { + unsigned lisp_ocfp, lisp_ra, c_ocfp, c_ra; + int lisp_valid_p, c_valid_p; + + if (!stack_pointer_p(fp)) + return 0; + + lisp_ocfp = deref(fp, -(1 + VM_OCFP_SAVE_OFFSET)); + lisp_ra = deref(fp, -(1 + VM_RETURN_PC_SAVE_OFFSET)); + c_ocfp = deref(fp, 0); + c_ra = deref(fp, 1); + + lisp_valid_p = (lisp_ocfp > fp && stack_pointer_p(lisp_ocfp) + && ra_pointer_p(lisp_ra)); + c_valid_p = (c_ocfp > fp && stack_pointer_p(c_ocfp) + && ra_pointer_p(c_ra)); + + if (lisp_valid_p && c_valid_p) { + unsigned lisp_path_fp, c_path_fp, dummy; + int lisp_path_p = x86_call_context(lisp_ocfp, &lisp_path_fp, &dummy); + int c_path_p = x86_call_context(c_ocfp, &c_path_fp, &dummy); + + if (lisp_path_p && c_path_p) { #if defined __FreeBSD__ && __FreeBSD_version > 400000 - if (lisp_ocfp > c_ocfp) - *ra = lisp_ra, *ocfp = lisp_ocfp; - else - *ra = c_ra, *ocfp = c_ocfp; + if (lisp_ocfp > c_ocfp) + *ra = lisp_ra, *ocfp = lisp_ocfp; + else + *ra = c_ra, *ocfp = c_ocfp; #else - *ra = lisp_ra, *ocfp = lisp_ocfp; + *ra = lisp_ra, *ocfp = lisp_ocfp; #endif - } - else if (lisp_path_p) + } else if (lisp_path_p) + *ra = lisp_ra, *ocfp = lisp_ocfp; + else if (c_path_p) + *ra = c_ra, *ocfp = c_ocfp; + else + return 0; + } else if (lisp_valid_p) *ra = lisp_ra, *ocfp = lisp_ocfp; - else if (c_path_p) + else if (c_valid_p) *ra = c_ra, *ocfp = c_ocfp; - else + else return 0; - } - else if (lisp_valid_p) - *ra = lisp_ra, *ocfp = lisp_ocfp; - else if (c_valid_p) - *ra = c_ra, *ocfp = c_ocfp; - else - return 0; - - return 1; + + return 1; } -struct compiled_debug_info -{ - lispobj header; - lispobj layout; - lispobj name; - lispobj source; - lispobj package; - lispobj function_map; +struct compiled_debug_info { + lispobj header; + lispobj layout; + lispobj name; + lispobj source; + lispobj package; + lispobj function_map; }; -struct compiled_debug_function -{ - lispobj header; - lispobj layout; - lispobj name; - lispobj kind; - lispobj variables; - lispobj blocks; - lispobj tlf_number; - lispobj arguments; - lispobj returns; - lispobj return_pc; - lispobj old_fp; - lispobj nfp; - lispobj start_pc; - lispobj elsewhere_pc; +struct compiled_debug_function { + lispobj header; + lispobj layout; + lispobj name; + lispobj kind; + lispobj variables; + lispobj blocks; + lispobj tlf_number; + lispobj arguments; + lispobj returns; + lispobj return_pc; + lispobj old_fp; + lispobj nfp; + lispobj start_pc; + lispobj elsewhere_pc; }; static int -array_of_type_p (lispobj obj, int type) +array_of_type_p(lispobj obj, int type) { - return (LowtagOf (obj) == type_OtherPointer - && TypeOf (*(lispobj *) PTR (obj)) == type); + return (LowtagOf(obj) == type_OtherPointer + && TypeOf(*(lispobj *) PTR(obj)) == type); } struct compiled_debug_function * -debug_function_from_pc (struct code* code, unsigned long pc) +debug_function_from_pc(struct code *code, unsigned long pc) { - unsigned code_header_len = sizeof (lispobj) * HeaderValue (code->header); - unsigned offset = pc - (unsigned) code - code_header_len; - - if (LowtagOf (code->debug_info) == type_InstancePointer) - { - struct compiled_debug_info *di - = (struct compiled_debug_info *) PTR (code->debug_info); - - if (array_of_type_p (di->function_map, type_SimpleVector)) - { - struct vector *v = (struct vector *) PTR (di->function_map); - int i, len = fixnum_value (v->length); - struct compiled_debug_function *df - = (struct compiled_debug_function *) PTR (v->data[0]); - - if (len == 1) - return df; - else - { - int elsewhere_p = offset >= fixnum_value (df->elsewhere_pc); - for (i = 1;; i += 2) - { - unsigned next_pc; - - if (i == len) - return ((struct compiled_debug_function *) - PTR (v->data[i - 1])); - - if (elsewhere_p) - { - struct compiled_debug_function *p - = ((struct compiled_debug_function *) - PTR (v->data[i + 1])); - next_pc = fixnum_value (p->elsewhere_pc); - } - else - next_pc = fixnum_value (v->data[i]); + unsigned code_header_len = sizeof(lispobj) * HeaderValue(code->header); + unsigned offset = pc - (unsigned) code - code_header_len; + + if (LowtagOf(code->debug_info) == type_InstancePointer) { + struct compiled_debug_info *di + + = (struct compiled_debug_info *) PTR(code->debug_info); + + if (array_of_type_p(di->function_map, type_SimpleVector)) { + struct vector *v = (struct vector *) PTR(di->function_map); + int i, len = fixnum_value(v->length); + struct compiled_debug_function *df + = (struct compiled_debug_function *) PTR(v->data[0]); + + if (len == 1) + return df; + else { + int elsewhere_p = offset >= fixnum_value(df->elsewhere_pc); + + for (i = 1;; i += 2) { + unsigned next_pc; - if (offset < next_pc) - return ((struct compiled_debug_function *) - PTR (v->data[i - 1])); + if (i == len) + return ((struct compiled_debug_function *) + PTR(v->data[i - 1])); + + if (elsewhere_p) { + struct compiled_debug_function *p + = ((struct compiled_debug_function *) + PTR(v->data[i + 1])); + + next_pc = fixnum_value(p->elsewhere_pc); + } else + next_pc = fixnum_value(v->data[i]); + + if (offset < next_pc) + return ((struct compiled_debug_function *) + PTR(v->data[i - 1])); } } } - else if (array_of_type_p (di->function_map, - type_SimpleArrayUnsignedByte8)) - { - /* Minimal debug info as described in debug-int.lisp. - Not implemented. */ + else if (array_of_type_p(di->function_map, + type_SimpleArrayUnsignedByte8)) { + /* Minimal debug info as described in debug-int.lisp. + Not implemented. */ } } - return NULL; + return NULL; } void -backtrace (int nframes) +backtrace(int nframes) { - unsigned fp; - int i; - - asm ("movl %%ebp,%0" : "=g" (fp)); - - for (i = 0; i < nframes; ++i) - { - lispobj *p; - unsigned long ra; - unsigned next_fp; - - if (!x86_call_context (fp, &ra, &next_fp)) - break; - - printf ("%4d: ", i); - - p = (lispobj *) component_ptr_from_pc ((lispobj *) ra); - if (p && TypeOf (*p) == type_CodeHeader) - { - struct code *cp = (struct code *) p; - struct compiled_debug_function *df; - - df = debug_function_from_pc (cp, ra); - if (df) - print_entry_name (df->name); - else - print_entry_points (cp); - } - else if (p) - printf ("<Not implemented, type = %d>", (int) TypeOf (*p)); - else - printf ("Foreign fp = 0x%x, ra = 0x%lx", next_fp, ra); - - putchar ('\n'); - fp = next_fp; + unsigned fp; + int i; + + asm("movl %%ebp,%0":"=g"(fp)); + + for (i = 0; i < nframes; ++i) { + lispobj *p; + unsigned long ra; + unsigned next_fp; + + if (!x86_call_context(fp, &ra, &next_fp)) + break; + + printf("%4d: ", i); + + p = (lispobj *) component_ptr_from_pc((lispobj *) ra); + if (p && TypeOf(*p) == type_CodeHeader) { + struct code *cp = (struct code *) p; + struct compiled_debug_function *df; + + df = debug_function_from_pc(cp, ra); + if (df) + print_entry_name(df->name); + else + print_entry_points(cp); + } else if (p) + printf("<Not implemented, type = %d>", (int) TypeOf(*p)); + else + printf("Foreign fp = 0x%x, ra = 0x%lx", next_fp, ra); + + putchar('\n'); + fp = next_fp; } } diff --git a/lisp/breakpoint.c b/lisp/breakpoint.c index 750f89a9b..012c6652b 100644 --- a/lisp/breakpoint.c +++ b/lisp/breakpoint.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/breakpoint.c,v 1.17 2005/03/19 16:02:40 rtoy Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/breakpoint.c,v 1.18 2005/09/15 18:26:51 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -36,28 +36,30 @@ #define BOGUS_LRA_CONSTANTS 3 #endif -static void *compute_pc(lispobj code_obj, int pc_offset) +static void * +compute_pc(lispobj code_obj, int pc_offset) { struct code *code; - code = (struct code *)PTR(code_obj); - return (void *)((char *)code + HeaderValue(code->header) * sizeof(lispobj) - + pc_offset); + code = (struct code *) PTR(code_obj); + return (void *) ((char *) code + HeaderValue(code->header) * sizeof(lispobj) + + pc_offset); } -unsigned long breakpoint_install(lispobj code_obj, int pc_offset) +unsigned long +breakpoint_install(lispobj code_obj, int pc_offset) { return arch_install_breakpoint(compute_pc(code_obj, pc_offset)); } -void breakpoint_remove(lispobj code_obj, int pc_offset, - unsigned long orig_inst) +void +breakpoint_remove(lispobj code_obj, int pc_offset, unsigned long orig_inst) { arch_remove_breakpoint(compute_pc(code_obj, pc_offset), orig_inst); } -void breakpoint_do_displaced_inst(os_context_t *scp, - unsigned long orig_inst) +void +breakpoint_do_displaced_inst(os_context_t * scp, unsigned long orig_inst) { #if !defined(hpux) && !defined(irix) && !defined(i386) undo_fake_foreign_function_call(scp); @@ -66,7 +68,8 @@ void breakpoint_do_displaced_inst(os_context_t *scp, } #if !defined(i386) -static lispobj find_code(os_context_t *scp) +static lispobj +find_code(os_context_t * scp) { #ifdef reg_CODE lispobj code = SC_REG(scp, reg_CODE), header; @@ -74,12 +77,12 @@ static lispobj find_code(os_context_t *scp) if (LowtagOf(code) != type_OtherPointer) return NIL; - header = *(lispobj *)(code-type_OtherPointer); + header = *(lispobj *) (code - type_OtherPointer); if (TypeOf(header) == type_CodeHeader) return code; else - return code - HeaderValue(header)*sizeof(lispobj); + return code - HeaderValue(header) * sizeof(lispobj); #else return NIL; #endif @@ -87,67 +90,74 @@ static lispobj find_code(os_context_t *scp) #endif #if defined(i386) -static lispobj find_code(os_context_t *scp) +static lispobj +find_code(os_context_t * scp) { - lispobj *codeptr = component_ptr_from_pc(SC_PC(scp)); + lispobj *codeptr = component_ptr_from_pc(SC_PC(scp)); - if (codeptr == NULL) - return NIL; - else - return (lispobj) codeptr | type_OtherPointer; + if (codeptr == NULL) + return NIL; + else + return (lispobj) codeptr | type_OtherPointer; } #endif -static int compute_offset(os_context_t *scp, lispobj code, boolean function_end) +static int +compute_offset(os_context_t * scp, lispobj code, boolean function_end) { if (code == NIL) return 0; else { unsigned long code_start; - struct code *codeptr = (struct code *)PTR(code); + struct code *codeptr = (struct code *) PTR(code); + #ifdef parisc unsigned long pc = SC_PC(scp) & ~3; #else unsigned long pc = SC_PC(scp); #endif - code_start = (unsigned long)codeptr - + HeaderValue(codeptr->header)*sizeof(lispobj); + code_start = (unsigned long) codeptr + + HeaderValue(codeptr->header) * sizeof(lispobj); if (pc < code_start) return 0; else { int offset = pc - code_start; + if (offset >= codeptr->code_size) { - if (function_end) { + if (function_end) { #if defined(sparc) || defined(DARWIN) - /* - * We're in a function end breakpoint. Compute the - * offset from the (known) breakpoint location and the - * beginning of the breakpoint guts. (See *-assem.S.) - * - * Then make the offset negative so the caller knows - * that the offset is not from the code object. - */ - extern char function_end_breakpoint_trap; - extern char function_end_breakpoint_guts; - - offset = &function_end_breakpoint_trap - &function_end_breakpoint_guts; - return make_fixnum(-offset); + /* + * We're in a function end breakpoint. Compute the + * offset from the (known) breakpoint location and the + * beginning of the breakpoint guts. (See *-assem.S.) + * + * Then make the offset negative so the caller knows + * that the offset is not from the code object. + */ + extern char function_end_breakpoint_trap; + extern char function_end_breakpoint_guts; + + offset = + &function_end_breakpoint_trap - + &function_end_breakpoint_guts; + return make_fixnum(-offset); #else - return 0; -#endif - } else { - return 0; - } + return 0; +#endif + } else { + return 0; + } } else { - return make_fixnum(offset); - } + return make_fixnum(offset); + } } } } #ifndef i386 -void handle_breakpoint(int signal, int subcode, os_context_t *scp) +void +handle_breakpoint(int signal, int subcode, os_context_t * scp) { lispobj code; @@ -156,16 +166,15 @@ void handle_breakpoint(int signal, int subcode, os_context_t *scp) code = find_code(scp); funcall3(SymbolFunction(HANDLE_BREAKPOINT), - compute_offset(scp, code, 0), - code, - alloc_sap(scp)); + compute_offset(scp, code, 0), code, alloc_sap(scp)); undo_fake_foreign_function_call(scp); } #else -void handle_breakpoint(int signal, int subcode, os_context_t *scp) +void +handle_breakpoint(int signal, int subcode, os_context_t * scp) { - lispobj code, scp_sap=alloc_sap(scp); + lispobj code, scp_sap = alloc_sap(scp); fake_foreign_function_call(scp); @@ -177,31 +186,29 @@ void handle_breakpoint(int signal, int subcode, os_context_t *scp) */ #if defined POSIX_SIGS - sigprocmask(SIG_SETMASK,&scp->uc_sigmask,NULL); + sigprocmask(SIG_SETMASK, &scp->uc_sigmask, NULL); #else sigsetmask(scp->sc_mask); #endif funcall3(SymbolFunction(HANDLE_BREAKPOINT), - compute_offset(scp, code, 0), - code, - scp_sap); + compute_offset(scp, code, 0), code, scp_sap); undo_fake_foreign_function_call(scp); } #endif #ifndef i386 -void *handle_function_end_breakpoint(int signal, int subcode, - os_context_t *scp) +void * +handle_function_end_breakpoint(int signal, int subcode, os_context_t * scp) { lispobj code, lra; struct code *codeptr; int offset; - + fake_foreign_function_call(scp); code = find_code(scp); - codeptr = (struct code *)PTR(code); + codeptr = (struct code *) PTR(code); offset = compute_offset(scp, code, 1); #if 0 printf("handle_function_end:\n"); @@ -211,42 +218,39 @@ void *handle_function_end_breakpoint(int signal, int subcode, fflush(stdout); #endif - if (offset < 0) - { - /* - * We were in the function end breakpoint. Which means we are - * in a bogus LRA, so compute where the code-component of this - * bogus lra object starts. Adjust code, and codeptr - * appropriately so the breakpoint handler can do the right - * thing. - */ - unsigned int pc; - - pc = SC_PC(scp); - - offset = -offset; - /* - * Some magic here. pc points to the trap instruction. The - * offset gives us where the function_end_breakpoint_guts - * begins. But we need to back up some more to get to the - * code-component object. The magic 2 below is - */ - code = pc - fixnum_value(offset); - code -= sizeof(struct code) + BOGUS_LRA_CONSTANTS*sizeof(lispobj); - code += type_OtherPointer; - codeptr = (struct code *) PTR(code); + if (offset < 0) { + /* + * We were in the function end breakpoint. Which means we are + * in a bogus LRA, so compute where the code-component of this + * bogus lra object starts. Adjust code, and codeptr + * appropriately so the breakpoint handler can do the right + * thing. + */ + unsigned int pc; + + pc = SC_PC(scp); + + offset = -offset; + /* + * Some magic here. pc points to the trap instruction. The + * offset gives us where the function_end_breakpoint_guts + * begins. But we need to back up some more to get to the + * code-component object. The magic 2 below is + */ + code = pc - fixnum_value(offset); + code -= sizeof(struct code) + BOGUS_LRA_CONSTANTS * sizeof(lispobj); + + code += type_OtherPointer; + codeptr = (struct code *) PTR(code); #if 0 printf(" pc = 0x%08x\n", pc); printf(" code = 0x%08x\n", code); printf(" codeptr = %p\n", codeptr); fflush(stdout); #endif - } - - funcall3(SymbolFunction(HANDLE_BREAKPOINT), - offset, - code, - alloc_sap(scp)); + } + + funcall3(SymbolFunction(HANDLE_BREAKPOINT), offset, code, alloc_sap(scp)); /* * Breakpoint handling done, so get the real LRA where we're @@ -263,13 +267,13 @@ void *handle_function_end_breakpoint(int signal, int subcode, SC_REG(scp, reg_CODE) = lra; #endif undo_fake_foreign_function_call(scp); - return (void *)(lra-type_OtherPointer+sizeof(lispobj)); + return (void *) (lra - type_OtherPointer + sizeof(lispobj)); } #else -void *handle_function_end_breakpoint(int signal, int subcode, - os_context_t *scp) +void * +handle_function_end_breakpoint(int signal, int subcode, os_context_t * scp) { - lispobj code, scp_sap=alloc_sap(scp); + lispobj code, scp_sap = alloc_sap(scp); struct code *codeptr; fake_foreign_function_call(scp); @@ -283,14 +287,12 @@ void *handle_function_end_breakpoint(int signal, int subcode, */ #if defined POSIX_SIGS - sigprocmask(SIG_SETMASK,&scp->uc_sigmask,NULL); + sigprocmask(SIG_SETMASK, &scp->uc_sigmask, NULL); #else sigsetmask(scp->sc_mask); #endif funcall3(SymbolFunction(HANDLE_BREAKPOINT), - compute_offset(scp, code, 1), - code, - scp_sap); + compute_offset(scp, code, 1), code, scp_sap); undo_fake_foreign_function_call(scp); diff --git a/lisp/breakpoint.h b/lisp/breakpoint.h index 3ac2af6e3..c8b857449 100644 --- a/lisp/breakpoint.h +++ b/lisp/breakpoint.h @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/breakpoint.h,v 1.3 2005/01/13 19:55:00 fgilham Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/breakpoint.h,v 1.4 2005/09/15 18:26:51 rtoy Rel $ */ #ifndef _BREAKPOINT_H_ @@ -7,11 +7,13 @@ extern unsigned long breakpoint_install(lispobj code_obj, int pc_offset); extern void breakpoint_remove(lispobj code_obj, int pc_offset, + unsigned long orig_inst); -extern void breakpoint_do_displaced_inst(os_context_t *scp, +extern void breakpoint_do_displaced_inst(os_context_t * scp, + unsigned long orig_inst); -extern void handle_breakpoint(int signal, int subcode, os_context_t *scp); +extern void handle_breakpoint(int signal, int subcode, os_context_t * scp); extern void *handle_function_end_breakpoint(int signal, int subcode, - os_context_t *scp); + os_context_t * scp); #endif /* _BREAKPOINT_H_ */ diff --git a/lisp/cgc.c b/lisp/cgc.c index e87a2a9bc..01f1482c1 100644 --- a/lisp/cgc.c +++ b/lisp/cgc.c @@ -1,5 +1,5 @@ /* cgc.c -*- Mode: C; comment-column: 40; -*- - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/cgc.c,v 1.12 2005/09/05 06:09:12 cshapiro Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/cgc.c,v 1.13 2005/09/15 18:26:51 rtoy Exp $ * * Conservative Garbage Collector for CMUCL x86. * @@ -17,12 +17,12 @@ #include <assert.h> #include <signal.h> #include <string.h> -#include "os.h" /* for SetSymbolValue */ -#include "globals.h" /* For dynamic_space_size */ -#include "x86-validate.h" /* for memory layout */ +#include "os.h" /* for SetSymbolValue */ +#include "globals.h" /* For dynamic_space_size */ +#include "x86-validate.h" /* for memory layout */ #include "x86-lispregs.h" -#include "lisp.h" /* for object defs */ -#include "interrupt.h" /* interrupt_handlers */ +#include "lisp.h" /* for object defs */ +#include "interrupt.h" /* interrupt_handlers */ #include "internals.h" #include "cgc.h" @@ -52,16 +52,15 @@ #define ALIGNEDP(addr) ((((int)addr)&(ALIGN_BYTES-1)) == 0) /* Type of an object. */ -typedef struct object -{ - long header; - struct object*data[1]; +typedef struct object { + long header; + struct object *data[1]; } *obj_t; /* Just leave unused space */ #define NOTE_EMPTY(ptr,bytes) {} - + /* Collector datastructures */ #define BLOCK_BITS 16 @@ -89,9 +88,9 @@ typedef struct object #define gc_assert(ex) #endif -char*alloc(int); - +char *alloc(int); + struct cluster { /* Link to the next cluster. */ struct cluster *next; @@ -114,11 +113,11 @@ struct cluster { * so as not to confuse 'room'. */ struct region { - unsigned - res1 :2, num_chunks :16, contains_small_objects :1, clean :1, hole :7; - struct region **prev; - struct region *next; - struct space *space; + unsigned + res1:2, num_chunks:16, contains_small_objects:1, clean:1, hole:7; + struct region **prev; + struct region *next; + struct space *space; }; #define REGION_OVERHEAD ROUNDUP(sizeof(struct region), ALIGN_BYTES) @@ -133,8 +132,9 @@ struct space { /* Chain of all the clusters. */ struct cluster *clusters = NULL; -static int num_clusters = 0; /* for debugging */ -int cgc_debug = 0; /* maybe set from Lisp */ +static int num_clusters = 0; /* for debugging */ +int cgc_debug = 0; /* maybe set from Lisp */ + /* Table indexed by block number giving the cluster that block is part of. */ static struct cluster **block_table = NULL; @@ -148,83 +148,99 @@ static void *heap_end = NULL; /* The two dynamic spaces. */ static struct space space_0 = { NULL }; static struct space space_1 = { NULL }; + /* Pointers it whichever dynamic space is currently newspace and oldspace */ static struct space *newspace = NULL; static struct space *oldspace = NULL; + /* Free lists of regions. */ static struct region *small_region_free_list = NULL; static struct region *large_region_free_list = NULL; static void move_to_newspace(struct region *region); #if defined TESTING -static void print_region(struct region*r) +static void +print_region(struct region *r) { - dprintf(1,("[region %x %d <%x %x> %x]\n", - r,r->num_chunks,r->prev,r->next,r->space)); + dprintf(1, ("[region %x %d <%x %x> %x]\n", + r, r->num_chunks, r->prev, r->next, r->space)); } -static void print_regions(struct region*r, char*str) +static void +print_regions(struct region *r, char *str) { - printf("Regions %s:\n",str); - for(; r != NULL; r = r->next) - print_region(r); + printf("Regions %s:\n", str); + for (; r != NULL; r = r->next) + print_region(r); } -static void print_space(struct space*s) +static void +print_space(struct space *s) { - struct region*r = s->regions; - dprintf(1,("[space %x %s %s <%x - %x>]\n", - s, - (s == &space_0)? "S0" : "S1", - (s == newspace)? "NewSpace" : "OldSpace", - s->alloc_ptr, s->alloc_end)); - print_regions(r,""); + struct region *r = s->regions; + + dprintf(1, ("[space %x %s %s <%x - %x>]\n", + s, + (s == &space_0) ? "S0" : "S1", + (s == newspace) ? "NewSpace" : "OldSpace", + s->alloc_ptr, s->alloc_end)); + print_regions(r, ""); } -void print_spaces() + +void +print_spaces() { - print_space(&space_0); - print_space(&space_1); - print_regions(large_region_free_list,"LRFL"); - print_regions(small_region_free_list,"SRFL"); + print_space(&space_0); + print_space(&space_1); + print_regions(large_region_free_list, "LRFL"); + print_regions(small_region_free_list, "SRFL"); } -void print_cluster(struct cluster*cluster) + +void +print_cluster(struct cluster *cluster) { - printf("[cluster %x >%x %d]\n",cluster,cluster->next,cluster->num_blocks); - print_regions(cluster->first_region,"cluster"); + printf("[cluster %x >%x %d]\n", cluster, cluster->next, + cluster->num_blocks); + print_regions(cluster->first_region, "cluster"); } -void print_clusters() + +void +print_clusters() { - struct cluster*cluster; - for(cluster=clusters; cluster != NULL; cluster = cluster->next) - print_cluster(cluster); + struct cluster *cluster; + + for (cluster = clusters; cluster != NULL; cluster = cluster->next) + print_cluster(cluster); } #endif /* TESTING */ - + /* Allocation/deallocation routines */ -static void init_region(struct region *region, int nchunks) +static void +init_region(struct region *region, int nchunks) { int region_block = BLOCK_NUMBER(region); struct cluster *cluster = block_table[region_block]; int offset = CHUNK_NUMBER(region) - CHUNK_NUMBER(cluster->first_region); int i; - dprintf(0,("init region %x %d\n",region,nchunks)); - *(long*)region = 0; /* clear fields */ + + dprintf(0, ("init region %x %d\n", region, nchunks)); + *(long *) region = 0; /* clear fields */ region->num_chunks = nchunks; if (nchunks > UCHAR_MAX) { for (i = 0; i < UCHAR_MAX; i++) cluster->region_offset[offset + i] = i; for (; i < nchunks; i++) cluster->region_offset[offset + i] = UCHAR_MAX; - } - else { + } else { for (i = 0; i < nchunks; i++) cluster->region_offset[offset + i] = i; } } -static struct region *maybe_alloc_large_region(int nchunks) +static struct region * +maybe_alloc_large_region(int nchunks) { struct region *region, **prev; @@ -235,7 +251,9 @@ static struct region *maybe_alloc_large_region(int nchunks) *prev = region->next; else { struct region *new - = (struct region *)((char *)region + nchunks*CHUNK_BYTES); + = + + (struct region *) ((char *) region + nchunks * CHUNK_BYTES); init_region(new, region->num_chunks - nchunks); new->next = region->next; new->prev = NULL; @@ -255,106 +273,112 @@ static struct region *maybe_alloc_large_region(int nchunks) /* from os_zero */ -static void cgc_zero(addr, length) -os_vm_address_t addr; -os_vm_size_t length; -{ - os_vm_address_t block_start = os_round_up_to_page(addr); - os_vm_address_t end = addr + length; - os_vm_size_t block_size; - - - if(block_start > addr) - memset((char *)addr, 0, MIN(block_start - addr, length)) - - if(block_start < end) - { - length -= block_start - addr; - - block_size =os_trunc_size_to_page(length); - - if(block_size < length) - memset((char *)block_start + block_size,0,length - block_size); - - if (block_size != 0) - { - /* Now deallocate and allocate the block so that it */ - /* faults in zero-filled. */ - - os_invalidate(block_start,block_size); - addr=os_validate(block_start,block_size); - - if(addr == NULL || addr != block_start) - fprintf(stderr,"cgc_zero: block moved, 0x%08x ==> 0x%08x!\n", - block_start,addr); +static void +cgc_zero(addr, length) + os_vm_address_t addr; + os_vm_size_t length; +{ + os_vm_address_t block_start = os_round_up_to_page(addr); + os_vm_address_t end = addr + length; + os_vm_size_t block_size; + + + if (block_start > addr) + memset((char *) addr, 0, MIN(block_start - addr, length)) + + if (block_start < end) { + length -= block_start - addr; + + block_size = os_trunc_size_to_page(length); + + if (block_size < length) + memset((char *) block_start + block_size, 0, + length - block_size); + + if (block_size != 0) { + /* Now deallocate and allocate the block so that it */ + /* faults in zero-filled. */ + + os_invalidate(block_start, block_size); + addr = os_validate(block_start, block_size); + + if (addr == NULL || addr != block_start) + fprintf(stderr, + "cgc_zero: block moved, 0x%08x ==> 0x%08x!\n", + block_start, addr); + } } - } } -static void compact_cluster(struct cluster *cluster) -{ - int show = 0; - struct region *region = cluster->first_region; - struct region *end = - (struct region *)((char *)region + cluster->num_blocks * BLOCK_BYTES); - int grown = 0; - unsigned max_chunks = cluster->num_blocks * BLOCK_CHUNKS; - struct region *large_additions = NULL; - struct region **large_prev = &large_additions; - struct region *small_additions = NULL; - struct region **small_prev = &small_additions; - - dprintf(show,("compact cluster %x\n",cluster)); - while (region < end) { - struct region *next = - (struct region *) ((char *)region + region->num_chunks*CHUNK_BYTES); - if (region->space != newspace) { /* was == NULL */ - if (next < end && next->space != newspace) { /* was == NULL */ - gc_assert(region >= cluster->first_region); - gc_assert(region->space == NULL); - gc_assert(next ->space == NULL); - gc_assert(region->num_chunks > 0); - gc_assert(next ->num_chunks > 0); - gc_assert((region->num_chunks+next->num_chunks) <= max_chunks); - region->num_chunks += next->num_chunks; - grown = 1; - } - else { - if (grown) { - init_region(region, region->num_chunks); - region->space = NULL; - grown = 0; - } - { - int ovh = REGION_OVERHEAD; - cgc_zero((os_vm_address_t)((char*)region + ovh), - (os_vm_size_t)(region->num_chunks*CHUNK_BYTES) - ovh); - } +static void +compact_cluster(struct cluster *cluster) +{ + int show = 0; + struct region *region = cluster->first_region; + struct region *end = + (struct region *) ((char *) region + cluster->num_blocks * BLOCK_BYTES); + int grown = 0; + unsigned max_chunks = cluster->num_blocks * BLOCK_CHUNKS; + struct region *large_additions = NULL; + struct region **large_prev = &large_additions; + struct region *small_additions = NULL; + struct region **small_prev = &small_additions; + + dprintf(show, ("compact cluster %x\n", cluster)); + while (region < end) { + struct region *next = + (struct region *) ((char *) region + + + region->num_chunks * CHUNK_BYTES); + if (region->space != newspace) { /* was == NULL */ + if (next < end && next->space != newspace) { /* was == NULL */ + gc_assert(region >= cluster->first_region); + gc_assert(region->space == NULL); + gc_assert(next->space == NULL); + gc_assert(region->num_chunks > 0); + gc_assert(next->num_chunks > 0); + gc_assert((region->num_chunks + next->num_chunks) <= + max_chunks); + region->num_chunks += next->num_chunks; + grown = 1; + } else { + if (grown) { + init_region(region, region->num_chunks); + region->space = NULL; + grown = 0; + } + { + int ovh = REGION_OVERHEAD; - if(region->num_chunks == 1) { - *small_prev = region; - small_prev = ®ion->next; - } - else { - *large_prev = region; - large_prev = ®ion->next; - } - region = next; - } + cgc_zero((os_vm_address_t) ((char *) region + ovh), + (os_vm_size_t) (region->num_chunks * CHUNK_BYTES) - + ovh); + } + + if (region->num_chunks == 1) { + *small_prev = region; + small_prev = ®ion->next; + } else { + *large_prev = region; + large_prev = ®ion->next; + } + region = next; + } + } else + region = next; } - else - region = next; - } - - *large_prev = large_region_free_list; - large_region_free_list = large_additions; - *small_prev = small_region_free_list; - small_region_free_list = small_additions; + + *large_prev = large_region_free_list; + large_region_free_list = large_additions; + *small_prev = small_region_free_list; + small_region_free_list = small_additions; } -static void compact_free_regions() +static void +compact_free_regions() { - struct cluster*cluster; + struct cluster *cluster; + large_region_free_list = NULL; small_region_free_list = NULL; @@ -368,29 +392,35 @@ static void compact_free_regions() * system build and switch to the cgc allocator when starting up a * saved image when dynamic space is hopefully clean. */ -static struct region*new_region(int nblocks) -{ - /* take from existing dynamic space */ - char*new = (char*)SymbolValue(ALLOCATION_POINTER); - struct region*region = (struct region*)(ROUNDUP((long)new,BLOCK_BYTES)); - int bn = BLOCK_NUMBER(region); - new += (nblocks * BLOCK_BYTES + ((char*)region - new)); - SetSymbolValue(ALLOCATION_POINTER,(lispobj)new); +static struct region * +new_region(int nblocks) +{ + /* take from existing dynamic space */ + char *new = (char *) SymbolValue(ALLOCATION_POINTER); + struct region *region = + + (struct region *) (ROUNDUP((long) new, BLOCK_BYTES)); + int bn = BLOCK_NUMBER(region); + + new += (nblocks * BLOCK_BYTES + ((char *) region - new)); + SetSymbolValue(ALLOCATION_POINTER, (lispobj) new); return region; } -static void new_cluster(int min_blocks) +static void +new_cluster(int min_blocks) { int nblocks = min_blocks < 4 ? 4 : min_blocks; - int nchunks = nblocks << (BLOCK_BITS-CHUNK_BITS); + int nchunks = nblocks << (BLOCK_BITS - CHUNK_BITS); int i; - struct cluster *cluster = malloc(sizeof(struct cluster) + nchunks-1); - struct region*region = new_region(nblocks); + struct cluster *cluster = malloc(sizeof(struct cluster) + nchunks - 1); + struct region *region = new_region(nblocks); int bn = BLOCK_NUMBER(region); - dprintf(cgc_debug,("new cluster %x region@%x\n",cluster,region)); + + dprintf(cgc_debug, ("new cluster %x region@%x\n", cluster, region)); for (i = 0; i < nblocks; i++) - block_table[bn+i] = cluster; + block_table[bn + i] = cluster; num_clusters++; cluster->next = clusters; @@ -410,24 +440,27 @@ unsigned long bytes_allocated = 0; /* Seen by (dynamic-usage) */ static unsigned long auto_gc_trigger = 0; static int maybe_gc_called = 0; -static struct region *alloc_large_region(int nchunks) +static struct region * +alloc_large_region(int nchunks) { - struct region *region; - { - region = maybe_alloc_large_region(nchunks); + struct region *region; - if (region == NULL) - { - new_cluster((nchunks + BLOCK_CHUNKS - 1) >> (BLOCK_BITS-CHUNK_BITS)); + { region = maybe_alloc_large_region(nchunks); - gc_assert(region != NULL); - } - } - gc_assert(region->space == NULL); - return region; + + if (region == NULL) { + new_cluster((nchunks + BLOCK_CHUNKS - 1) >> + (BLOCK_BITS - CHUNK_BITS)); + region = maybe_alloc_large_region(nchunks); + gc_assert(region != NULL); + } + } + gc_assert(region->space == NULL); + return region; } -static struct region *alloc_small_region() +static struct region * +alloc_small_region() { struct region *region = small_region_free_list; @@ -444,118 +477,121 @@ static struct region *alloc_small_region() static int chunks_freed = 0; -static void free_region(struct region *region) +static void +free_region(struct region *region) { - gc_assert(region->space && region->space == oldspace); - gc_assert(region->num_chunks > 0); + gc_assert(region->space && region->space == oldspace); + gc_assert(region->num_chunks > 0); - region->space = NULL; /* for compact_cluster? */ - region->prev = NULL; /* housekeeping I hope */ - chunks_freed += region->num_chunks; + region->space = NULL; /* for compact_cluster? */ + region->prev = NULL; /* housekeeping I hope */ + chunks_freed += region->num_chunks; - if (region->num_chunks == 1) - { - region->next = small_region_free_list; - small_region_free_list = region; - } - else - { - region->next = large_region_free_list; - large_region_free_list = region; + if (region->num_chunks == 1) { + region->next = small_region_free_list; + small_region_free_list = region; + } else { + region->next = large_region_free_list; + large_region_free_list = region; } } -static void *alloc_large(int nbytes) +static void * +alloc_large(int nbytes) { - int nchunks = (nbytes+REGION_OVERHEAD+CHUNK_BYTES-1) >> CHUNK_BITS; + int nchunks = (nbytes + REGION_OVERHEAD + CHUNK_BYTES - 1) >> CHUNK_BITS; struct region *region = alloc_large_region(nchunks); + region->contains_small_objects = 0; region->next = NULL; region->prev = NULL; region->space = NULL; - bytes_allocated += region->num_chunks*CHUNK_BYTES; + bytes_allocated += region->num_chunks * CHUNK_BYTES; move_to_newspace(region); - return (char *)region + REGION_OVERHEAD; + return (char *) region + REGION_OVERHEAD; } -void *cgc_alloc(int nbytes) +void * +cgc_alloc(int nbytes) { - void*res; - dprintf(0,("alloc %d\n", nbytes)); + void *res; - if (nbytes > (CHUNK_BYTES - REGION_OVERHEAD)) - res = alloc_large(nbytes); - else - { - struct space *space = newspace; - if ((space->alloc_ptr + nbytes) > space->alloc_end) - { - struct region *region; - if(space->alloc_ptr != NULL) - { - int hole = space->alloc_end - space->alloc_ptr; - if(hole >= ALIGN_BYTES) - /* This wastes the space, eg suppose one cons - * has been allocated then a request for - * a maximum sized small obj comes in. I'd like - * to remember that there is still a lot of - * room left in this region. Maybe I could actually - * use the small_region_free_list in some way. - */ - NOTE_EMPTY(space->alloc_ptr, hole); + dprintf(0, ("alloc %d\n", nbytes)); + + if (nbytes > (CHUNK_BYTES - REGION_OVERHEAD)) + res = alloc_large(nbytes); + else { + struct space *space = newspace; + + if ((space->alloc_ptr + nbytes) > space->alloc_end) { + struct region *region; + + if (space->alloc_ptr != NULL) { + int hole = space->alloc_end - space->alloc_ptr; + + if (hole >= ALIGN_BYTES) + /* This wastes the space, eg suppose one cons + * has been allocated then a request for + * a maximum sized small obj comes in. I'd like + * to remember that there is still a lot of + * room left in this region. Maybe I could actually + * use the small_region_free_list in some way. + */ + NOTE_EMPTY(space->alloc_ptr, hole); } - region = alloc_small_region(); - region->contains_small_objects = 1; - space->alloc_ptr = (char *)region + REGION_OVERHEAD; - space->alloc_end = (char *)region + CHUNK_BYTES; - bytes_allocated += region->num_chunks*CHUNK_BYTES; + region = alloc_small_region(); + region->contains_small_objects = 1; + space->alloc_ptr = (char *) region + REGION_OVERHEAD; + space->alloc_end = (char *) region + CHUNK_BYTES; + bytes_allocated += region->num_chunks * CHUNK_BYTES; } - - res = space->alloc_ptr; - space->alloc_ptr += ROUNDUP(nbytes, ALIGN_BYTES); + + res = space->alloc_ptr; + space->alloc_ptr += ROUNDUP(nbytes, ALIGN_BYTES); } - return res; + return res; } - -static void move_to_newspace(struct region *region) + +static void +move_to_newspace(struct region *region) { - /* (maybe) unlink region from oldspace and add to tail of - * newspace regions. Don't attempt to move a region that - * is already in newspace. - */ + /* (maybe) unlink region from oldspace and add to tail of + * newspace regions. Don't attempt to move a region that + * is already in newspace. + */ struct space *space = newspace; - if(region->space == oldspace) - { + + if (region->space == oldspace) { /* Remove region from list. The prev slot holds * the address of the 'next' slot of the previous * list entry, not a pointer to that region (why?) */ *region->prev = region->next; - if(region->next) - region->next->prev = region->prev; - if(region->space->regions_tail == ®ion->next) - region->space->regions_tail = region->prev; - } + if (region->next) + region->next->prev = region->prev; + if (region->space->regions_tail == ®ion->next) + region->space->regions_tail = region->prev; + } /* Append to newspace unless it has already been promoted. */ - if(region->space != newspace) - { + if (region->space != newspace) { region->prev = space->regions_tail; region->next = NULL; *space->regions_tail = region; space->regions_tail = ®ion->next; region->space = space; - } + } } -static struct region *find_region(void *ptr) +static struct region * +find_region(void *ptr) { struct cluster *cluster; int cluster_chunk_num; int chunk_num; unsigned char delta; - ptr = (void*)((int) ptr & ~0x3); + ptr = (void *) ((int) ptr & ~0x3); if (ptr < heap_base || ptr >= heap_end) return NULL; @@ -563,7 +599,7 @@ static struct region *find_region(void *ptr) if (cluster == NULL) return NULL; - if (ptr < (void*)cluster->first_region) + if (ptr < (void *) cluster->first_region) return NULL; cluster_chunk_num = CHUNK_NUMBER(cluster->first_region); @@ -579,20 +615,22 @@ static struct region *find_region(void *ptr) static inline boolean from_space_p(lispobj obj) { - struct region*region=find_region((void*)obj); - return (region != NULL && region->space == oldspace); + struct region *region = find_region((void *) obj); + + return (region != NULL && region->space == oldspace); } static inline boolean new_space_p(lispobj obj) { - struct region*region=find_region((void*)obj); - return (region != NULL && region->space == newspace); + struct region *region = find_region((void *) obj); + + return (region != NULL && region->space == newspace); } static inline boolean static_space_p(lispobj obj) { - return (STATIC_SPACE_START < obj - && obj < SymbolValue(STATIC_SPACE_FREE_POINTER)); + return (STATIC_SPACE_START < obj + && obj < SymbolValue(STATIC_SPACE_FREE_POINTER)); } /* Predicate that returns true if an object is a pointer. */ @@ -625,38 +663,41 @@ static_space_p(lispobj obj) #endif static unsigned long bytes_copied = 0; + # define HAVE_FASTCOPY #if defined HAVE_FASTCOPY #define COPYDUAL(a,b,c) fastcopy16(a,b,c) -void fastcopy16(void*,void*,size_t); +void fastcopy16(void *, void *, size_t); #else #define COPYDUAL(a,b,c) memmove(a,b,c) #endif static inline lispobj copy(lispobj taggedobj) { - obj_t source = (obj_t)PTR(taggedobj); - int nbytes = OBJECT_SIZE(source); - gc_assert(Pointerp(taggedobj)); - gc_assert(!(nbytes & (ALIGN_BYTES-1))); - { - int lowtag = LowtagOf(taggedobj); - obj_t newobj = cgc_alloc(nbytes); - COPYDUAL(newobj, source, nbytes); - bytes_copied += nbytes; - return ((lispobj)newobj | lowtag); - } -} + obj_t source = (obj_t) PTR(taggedobj); + int nbytes = OBJECT_SIZE(source); + + gc_assert(Pointerp(taggedobj)); + gc_assert(!(nbytes & (ALIGN_BYTES - 1))); + { + int lowtag = LowtagOf(taggedobj); + obj_t newobj = cgc_alloc(nbytes); + COPYDUAL(newobj, source, nbytes); + bytes_copied += nbytes; + return ((lispobj) newobj | lowtag); + } +} + #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1))) #define NWORDS(x,y) (CEILING((x),(y)) / (y)) #define WEAK_POINTER_NWORDS \ CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2) static struct weak_pointer *weak_pointers; - + /* Scavenging: * CMU CL objects can be classified as BOXED, UNBOXED or other. * Boxed objects have a header containing length and type followed @@ -670,18 +711,23 @@ static struct weak_pointer *weak_pointers; * or unboxed. */ #define IMMED_OR_LOSE(thing) gc_assert(sct[TypeOf(thing)].sc_kind == SC_IMMED) -static void scavenge_pointer(lispobj*); +static void scavenge_pointer(lispobj *); static int noise = 0; -typedef struct { unsigned sc_kind : 3, ve_l2bits : 5;} OSC_t; +typedef struct { + unsigned sc_kind:3, ve_l2bits:5; +} OSC_t; -OSC_t make_OSC(int kind, int log2bits) +OSC_t +make_OSC(int kind, int log2bits) { - OSC_t thing; - thing.sc_kind = kind; - thing.ve_l2bits = log2bits; - return thing; + OSC_t thing; + + thing.sc_kind = kind; + thing.ve_l2bits = log2bits; + return thing; } + #define SETSCT(indx,kind,logbits) sct[indx] = make_OSC(kind,logbits) #define SC_ISBOXED 1 #define SC_UNBOXED 2 @@ -693,766 +739,790 @@ OSC_t make_OSC(int kind, int log2bits) #define SC_LOSER 0 static OSC_t sct[256]; -int sizeOfObject(obj_t obj) -{ - int obj_type = TypeOf(obj->header); - OSC_t class = sct[obj_type]; - struct vector*vector; - int length = 1; - int nwords = 1; - switch (class.sc_kind) - { - case SC_POINTER: - case SC_IMMED: - return 1; - case SC_ISBOXED: - case SC_UNBOXED: - gc_assert(HeaderValue(obj->header) > 0); - nwords = length = HeaderValue(obj->header) + 1; - break; - case SC_STRING: - case SC_VECTOR: - { - int log2bits = class.ve_l2bits; - int bits_per_el = 1 << log2bits; - int extra = 0; - int els_per_word = 1 << (5 - log2bits); - if(log2bits > 5) +int +sizeOfObject(obj_t obj) +{ + int obj_type = TypeOf(obj->header); + OSC_t class = sct[obj_type]; + struct vector *vector; + int length = 1; + int nwords = 1; + + switch (class.sc_kind) { + case SC_POINTER: + case SC_IMMED: + return 1; + case SC_ISBOXED: + case SC_UNBOXED: + gc_assert(HeaderValue(obj->header) > 0); + nwords = length = HeaderValue(obj->header) + 1; + break; + case SC_STRING: + case SC_VECTOR: { - els_per_word = 1; - extra = log2bits - 5; + int log2bits = class.ve_l2bits; + int bits_per_el = 1 << log2bits; + int extra = 0; + int els_per_word = 1 << (5 - log2bits); + + if (log2bits > 5) { + els_per_word = 1; + extra = log2bits - 5; + } + length = ((struct vector *) obj)->length; + length = fixnum_value(length); /* Zero Length IS valid */ + length += (class.sc_kind == SC_STRING); + length <<= extra; + nwords = NWORDS(length, els_per_word); + nwords += 2; /* header + length */ } - length = ((struct vector*)obj)->length; - length = fixnum_value(length); /* Zero Length IS valid */ - length += (class.sc_kind == SC_STRING); - length <<= extra; - nwords = NWORDS(length, els_per_word); - nwords += 2; /* header + length */ - } - break; - case SC_OTHER: - switch(obj_type) - { - case type_CodeHeader: - { - struct code *code; - int nheader_words, ncode_words; - code = (struct code *)obj; - ncode_words = fixnum_value(code->code_size); - nheader_words = HeaderValue(code->header); - nwords = ncode_words + nheader_words; - } break; - default: - fprintf(stderr,"GC losage: no size for other type %d\n",obj_type); + break; + case SC_OTHER: + switch (obj_type) { + case type_CodeHeader: + { + struct code *code; + int nheader_words, ncode_words; + + code = (struct code *) obj; + ncode_words = fixnum_value(code->code_size); + nheader_words = HeaderValue(code->header); + nwords = ncode_words + nheader_words; + } break; + default: + fprintf(stderr, "GC losage: no size for other type %d\n", + obj_type); + gc_abort(); + } + break; + default: + fprintf(stderr, "GC losage: no size for other type %d\n", obj_type); gc_abort(); - } - break; - default: - fprintf(stderr,"GC losage: no size for other type %d\n",obj_type); - gc_abort(); } - return CEILING(nwords,2); + return CEILING(nwords, 2); } -static void init_osc() +static void +init_osc() { - int i; - for (i = 0; i < 256; i++) - SETSCT(i ,SC_LOSER, 0); - for (i = 0; i < 32; i++) - { - SETSCT(type_EvenFixnum|(i<<3) ,SC_IMMED,0); - SETSCT(type_FunctionPointer|(i<<3),SC_POINTER,0); - /* OtherImmediate0 */ - SETSCT(type_ListPointer|(i<<3) ,SC_POINTER,0); - SETSCT(type_OddFixnum|(i<<3) ,SC_IMMED,0); - SETSCT(type_InstancePointer|(i<<3),SC_POINTER,0); - /* OtherImmediate1 */ - SETSCT(type_OtherPointer|(i<<3) ,SC_POINTER,0); + int i; + + for (i = 0; i < 256; i++) + SETSCT(i, SC_LOSER, 0); + for (i = 0; i < 32; i++) { + SETSCT(type_EvenFixnum | (i << 3), SC_IMMED, 0); + SETSCT(type_FunctionPointer | (i << 3), SC_POINTER, 0); + /* OtherImmediate0 */ + SETSCT(type_ListPointer | (i << 3), SC_POINTER, 0); + SETSCT(type_OddFixnum | (i << 3), SC_IMMED, 0); + SETSCT(type_InstancePointer | (i << 3), SC_POINTER, 0); + /* OtherImmediate1 */ + SETSCT(type_OtherPointer | (i << 3), SC_POINTER, 0); } - SETSCT(type_Bignum ,SC_UNBOXED,0); - SETSCT(type_Ratio ,SC_ISBOXED,0); - SETSCT(type_SingleFloat ,SC_UNBOXED,0); - SETSCT(type_DoubleFloat ,SC_UNBOXED,0); + SETSCT(type_Bignum, SC_UNBOXED, 0); + SETSCT(type_Ratio, SC_ISBOXED, 0); + SETSCT(type_SingleFloat, SC_UNBOXED, 0); + SETSCT(type_DoubleFloat, SC_UNBOXED, 0); #if defined type_ComplexSingleFloat - SETSCT(type_ComplexSingleFloat ,SC_UNBOXED,0); + SETSCT(type_ComplexSingleFloat, SC_UNBOXED, 0); #endif #if defined type_ComplexDoubleFloat - SETSCT(type_ComplexDoubleFloat ,SC_UNBOXED,0); + SETSCT(type_ComplexDoubleFloat, SC_UNBOXED, 0); #endif - SETSCT(type_Complex ,SC_ISBOXED,0); - SETSCT(type_SimpleArray ,SC_ISBOXED,0); - SETSCT(type_SimpleString ,SC_STRING,3); - SETSCT(type_SimpleBitVector ,SC_VECTOR,0); - SETSCT(type_SimpleVector ,SC_VECTOR,5); - SETSCT(type_SimpleArrayUnsignedByte2 ,SC_VECTOR,1); - SETSCT(type_SimpleArrayUnsignedByte4 ,SC_VECTOR,2); - SETSCT(type_SimpleArrayUnsignedByte8 ,SC_VECTOR,3); - SETSCT(type_SimpleArrayUnsignedByte16 ,SC_VECTOR,4); - SETSCT(type_SimpleArrayUnsignedByte32 ,SC_VECTOR,5); + SETSCT(type_Complex, SC_ISBOXED, 0); + SETSCT(type_SimpleArray, SC_ISBOXED, 0); + SETSCT(type_SimpleString, SC_STRING, 3); + SETSCT(type_SimpleBitVector, SC_VECTOR, 0); + SETSCT(type_SimpleVector, SC_VECTOR, 5); + SETSCT(type_SimpleArrayUnsignedByte2, SC_VECTOR, 1); + SETSCT(type_SimpleArrayUnsignedByte4, SC_VECTOR, 2); + SETSCT(type_SimpleArrayUnsignedByte8, SC_VECTOR, 3); + SETSCT(type_SimpleArrayUnsignedByte16, SC_VECTOR, 4); + SETSCT(type_SimpleArrayUnsignedByte32, SC_VECTOR, 5); #if defined type_SimpleArraySignedByte8 - SETSCT(type_SimpleArraySignedByte8 ,SC_VECTOR,3); + SETSCT(type_SimpleArraySignedByte8, SC_VECTOR, 3); #endif #if defined type_SimpleArraySignedByte16 - SETSCT(type_SimpleArraySignedByte16 ,SC_VECTOR,4); + SETSCT(type_SimpleArraySignedByte16, SC_VECTOR, 4); #endif #if defined type_SimpleArraySignedByte30 - SETSCT(type_SimpleArraySignedByte30 ,SC_VECTOR,5); + SETSCT(type_SimpleArraySignedByte30, SC_VECTOR, 5); #endif #if defined type_SimpleArraySignedByte32 - SETSCT(type_SimpleArraySignedByte32 ,SC_VECTOR,5); + SETSCT(type_SimpleArraySignedByte32, SC_VECTOR, 5); #endif - SETSCT(type_SimpleArraySingleFloat ,SC_VECTOR,5); - SETSCT(type_SimpleArrayDoubleFloat ,SC_VECTOR,6); + SETSCT(type_SimpleArraySingleFloat, SC_VECTOR, 5); + SETSCT(type_SimpleArrayDoubleFloat, SC_VECTOR, 6); #if defined type_SimpleArrayComplexSingleFloat - SETSCT(type_SimpleArrayComplexSingleFloat ,SC_VECTOR,6); + SETSCT(type_SimpleArrayComplexSingleFloat, SC_VECTOR, 6); #endif #if defined type_SimpleArrayComplexDoubleFloat - SETSCT(type_SimpleArrayComplexDoubleFloat ,SC_VECTOR,7); + SETSCT(type_SimpleArrayComplexDoubleFloat, SC_VECTOR, 7); #endif - SETSCT(type_ComplexString ,SC_ISBOXED,0); - SETSCT(type_ComplexBitVector ,SC_ISBOXED,0); - SETSCT(type_ComplexVector ,SC_ISBOXED,0); - SETSCT(type_ComplexArray ,SC_ISBOXED,0); - SETSCT(type_CodeHeader ,SC_OTHER,0); - SETSCT(type_FunctionHeader ,SC_OTHER,0); - SETSCT(type_ClosureFunctionHeader ,SC_OTHER,0); - SETSCT(type_ReturnPcHeader ,SC_OTHER,0); - SETSCT(type_ClosureHeader ,SC_ISBOXED,0); - SETSCT(type_FuncallableInstanceHeader ,SC_ISBOXED,0); - SETSCT(type_ByteCodeFunction ,SC_ISBOXED,0); - SETSCT(type_ByteCodeClosure ,SC_ISBOXED,0); - SETSCT(type_DylanFunctionHeader ,SC_ISBOXED,0); - - SETSCT(type_ValueCellHeader ,SC_ISBOXED,0); - SETSCT(type_SymbolHeader ,SC_ISBOXED,0); - SETSCT(type_BaseChar ,SC_IMMED,0); - SETSCT(type_Sap ,SC_UNBOXED,0); - SETSCT(type_UnboundMarker ,SC_IMMED,0); - SETSCT(type_WeakPointer ,SC_UNBOXED,0); - SETSCT(type_InstanceHeader ,SC_ISBOXED,0); - SETSCT(type_Fdefn ,SC_ISBOXED,0); + SETSCT(type_ComplexString, SC_ISBOXED, 0); + SETSCT(type_ComplexBitVector, SC_ISBOXED, 0); + SETSCT(type_ComplexVector, SC_ISBOXED, 0); + SETSCT(type_ComplexArray, SC_ISBOXED, 0); + SETSCT(type_CodeHeader, SC_OTHER, 0); + SETSCT(type_FunctionHeader, SC_OTHER, 0); + SETSCT(type_ClosureFunctionHeader, SC_OTHER, 0); + SETSCT(type_ReturnPcHeader, SC_OTHER, 0); + SETSCT(type_ClosureHeader, SC_ISBOXED, 0); + SETSCT(type_FuncallableInstanceHeader, SC_ISBOXED, 0); + SETSCT(type_ByteCodeFunction, SC_ISBOXED, 0); + SETSCT(type_ByteCodeClosure, SC_ISBOXED, 0); + SETSCT(type_DylanFunctionHeader, SC_ISBOXED, 0); + + SETSCT(type_ValueCellHeader, SC_ISBOXED, 0); + SETSCT(type_SymbolHeader, SC_ISBOXED, 0); + SETSCT(type_BaseChar, SC_IMMED, 0); + SETSCT(type_Sap, SC_UNBOXED, 0); + SETSCT(type_UnboundMarker, SC_IMMED, 0); + SETSCT(type_WeakPointer, SC_UNBOXED, 0); + SETSCT(type_InstanceHeader, SC_ISBOXED, 0); + SETSCT(type_Fdefn, SC_ISBOXED, 0); } -static lispobj* scavenge(lispobj*,int); -static lispobj*scavenge_object(lispobj*); -static lispobj*scavengex(lispobj*); +static lispobj *scavenge(lispobj *, int); +static lispobj *scavenge_object(lispobj *); +static lispobj *scavengex(lispobj *); -static inline scavenge_1word_obj(lispobj*addr) +static inline +scavenge_1word_obj(lispobj * addr) { - if(Pointerp(*addr)) - { - if(*addr != NIL && *addr != T) - scavenge_pointer(addr); - } - else - IMMED_OR_LOSE(*addr); + if (Pointerp(*addr)) { + if (*addr != NIL && *addr != T) + scavenge_pointer(addr); + } else + IMMED_OR_LOSE(*addr); } static int debug_code = 0; static int -scav_code_header(lispobj*where) -{ - lispobj object = *where; - struct code *code; - int i,nheader_words, ncode_words, nwords; - lispobj fheaderl; - struct function *fheaderp; - dprintf(0,("code: %x %x\n",where,object)); - code = (struct code *) where; - ncode_words = fixnum_value(code->code_size); - nheader_words = HeaderValue(object); - nwords = ncode_words + nheader_words; - nwords = CEILING(nwords, 2); - /* Scavenge the boxed section of the code data block */ - /* NOTE: seeing a problem where the trace_table_offset slot - * is a bogus list pointer instead of a fixnum such that - * junk gets moved to newspace which causes problems later. - * Purify doesn't look at that slot (a bug?). Need - * to figure out how it happens. Ans: from loading top-level - * forms that init byte-compiled functions like "defun fcn". - * Fix the loader to not do this and save some space! - */ - for(i=1; i < nheader_words; i++) - scavenge_1word_obj(where + i); - - /* Scavenge the boxed section of each function object in the - * code data block. - */ - fheaderl = code->entry_points; - while (fheaderl != NIL) { - fheaderp = (struct function *) PTR(fheaderl); - gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); - scavenge_1word_obj(&fheaderp->name); - scavenge_1word_obj(&fheaderp->arglist); - scavenge_1word_obj(&fheaderp->type); - fheaderl = fheaderp->next; - } - return nwords; +scav_code_header(lispobj * where) +{ + lispobj object = *where; + struct code *code; + int i, nheader_words, ncode_words, nwords; + lispobj fheaderl; + struct function *fheaderp; + + dprintf(0, ("code: %x %x\n", where, object)); + code = (struct code *) where; + ncode_words = fixnum_value(code->code_size); + nheader_words = HeaderValue(object); + nwords = ncode_words + nheader_words; + nwords = CEILING(nwords, 2); + /* Scavenge the boxed section of the code data block */ + /* NOTE: seeing a problem where the trace_table_offset slot + * is a bogus list pointer instead of a fixnum such that + * junk gets moved to newspace which causes problems later. + * Purify doesn't look at that slot (a bug?). Need + * to figure out how it happens. Ans: from loading top-level + * forms that init byte-compiled functions like "defun fcn". + * Fix the loader to not do this and save some space! + */ + for (i = 1; i < nheader_words; i++) + scavenge_1word_obj(where + i); + + /* Scavenge the boxed section of each function object in the + * code data block. + */ + fheaderl = code->entry_points; + while (fheaderl != NIL) { + fheaderp = (struct function *) PTR(fheaderl); + gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); + scavenge_1word_obj(&fheaderp->name); + scavenge_1word_obj(&fheaderp->arglist); + scavenge_1word_obj(&fheaderp->type); + fheaderl = fheaderp->next; + } + return nwords; } #define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer) #ifdef i386 -static void scavenge_fcn_header(struct function*object) -{ - struct function*fheader = object; - unsigned long offset = HeaderValue(fheader->header) * 4; - /* Ok, we don't transport code here, but we do need to - * scavenge the constants and functions (of which this is one). - * This should be done as part of scavenging a live code object - * and we could now be trying to do CPR on a corpse! - */ - struct code*code = (struct code *) ((unsigned long) fheader - offset); - gc_assert(TypeOf(fheader->header) == type_FunctionHeader); - scav_code_header((lispobj*)code); +static void +scavenge_fcn_header(struct function *object) +{ + struct function *fheader = object; + unsigned long offset = HeaderValue(fheader->header) * 4; + + /* Ok, we don't transport code here, but we do need to + * scavenge the constants and functions (of which this is one). + * This should be done as part of scavenging a live code object + * and we could now be trying to do CPR on a corpse! + */ + struct code *code = (struct code *) ((unsigned long) fheader - offset); + + gc_assert(TypeOf(fheader->header) == type_FunctionHeader); + scav_code_header((lispobj *) code); } -static int docode=0; /* maybe not needed */ +static int docode = 0; /* maybe not needed */ static int -scav_closure_header(struct closure*closure) -{ - /* Could also be a funcallable_instance. The x86 port has the - * raw code address in the function slot, not a lisp object. - * However, the function object is a known distance from the code. - */ - lispobj fun, fheader1; - int i,words; - gc_assert(ALIGNEDP(closure)); - words = HeaderValue(closure->header); - fun = closure->function - RAW_ADDR_OFFSET; - /* This needs to be done to get at live code. I now have no - * way to know if this has already been scavenged so I assume - * that it hasn't. Code that has been seen by purify is - * supposed RO and doesn't (shouldn't) need to be looked at - * so this maybe really redundant. - * - * I have seen one case where FI was incomplete with function - * and lexenv slots == 0! Is this a bug? - * - * Update, it appears this is not needed. I will disable execution - * by default but leave the code here in case something breaks. - */ - if(docode && static_space_p(closure->function)) - scavenge_fcn_header((struct function*)PTR(fun)); - else /* "normal" */ - scavenge_1word_obj(&fun); - - /* Now the boxed part of the closure header. */ - for(i = 0; i < words - 1; i++) - scavenge_1word_obj(&closure->info[i]); - - return CEILING(words + 1, 2); -} -static int fnoise=0; /* experimental */ +scav_closure_header(struct closure *closure) +{ + /* Could also be a funcallable_instance. The x86 port has the + * raw code address in the function slot, not a lisp object. + * However, the function object is a known distance from the code. + */ + lispobj fun, fheader1; + int i, words; + + gc_assert(ALIGNEDP(closure)); + words = HeaderValue(closure->header); + fun = closure->function - RAW_ADDR_OFFSET; + /* This needs to be done to get at live code. I now have no + * way to know if this has already been scavenged so I assume + * that it hasn't. Code that has been seen by purify is + * supposed RO and doesn't (shouldn't) need to be looked at + * so this maybe really redundant. + * + * I have seen one case where FI was incomplete with function + * and lexenv slots == 0! Is this a bug? + * + * Update, it appears this is not needed. I will disable execution + * by default but leave the code here in case something breaks. + */ + if (docode && static_space_p(closure->function)) + scavenge_fcn_header((struct function *) PTR(fun)); + else /* "normal" */ + scavenge_1word_obj(&fun); + + /* Now the boxed part of the closure header. */ + for (i = 0; i < words - 1; i++) + scavenge_1word_obj(&closure->info[i]); + + return CEILING(words + 1, 2); +} +static int fnoise = 0; /* experimental */ static int -scav_fdefn(lispobj*where) -{ - /* I don't know if this is really needs to be special cased here. - * raw_address should look like a fixnum and function is in static - * space -- unless it is pointing to something in C like closure_tramp - * or maybe undefined_tramp. - * Actually function is in dynamic space if it is a byte-function! - * Hmm, have seen case of function slot containing 1. Bug? - */ - struct fdefn * fdefn = (struct fdefn*)where; - int words = HeaderValue(fdefn->header); - int fix_func = ((char*)(fdefn->function+RAW_ADDR_OFFSET) == fdefn->raw_addr); - scavenge_pointer(&fdefn->name); - if(fnoise && LowtagOf(fdefn->function) == type_FunctionPointer) - { - obj_t fcnobj = (obj_t)PTR(fdefn->function); - switch(TypeOf(fcnobj->header)) - { - /* Can only be in static space and may need to scavenge code object. - * Won't be noticed by scavenge_pointer(). - */ - case type_FunctionHeader: - scavenge_fcn_header((struct function*)fcnobj); - break; - /* If in static space it was moved there by purify and we are - * doing normal scavenge. Handle normally. - */ - case type_FuncallableInstanceHeader: - case type_ClosureHeader: - scavenge_pointer(&fdefn->function); - break; - default: - dprintf(1,("Ignoring bogus value %x for fdefn function.\n", - *fcnobj)); +scav_fdefn(lispobj * where) +{ + /* I don't know if this is really needs to be special cased here. + * raw_address should look like a fixnum and function is in static + * space -- unless it is pointing to something in C like closure_tramp + * or maybe undefined_tramp. + * Actually function is in dynamic space if it is a byte-function! + * Hmm, have seen case of function slot containing 1. Bug? + */ + struct fdefn *fdefn = (struct fdefn *) where; + int words = HeaderValue(fdefn->header); + int fix_func = + + ((char *) (fdefn->function + RAW_ADDR_OFFSET) == fdefn->raw_addr); + scavenge_pointer(&fdefn->name); + if (fnoise && LowtagOf(fdefn->function) == type_FunctionPointer) { + obj_t fcnobj = (obj_t) PTR(fdefn->function); + + switch (TypeOf(fcnobj->header)) { + /* Can only be in static space and may need to scavenge code object. + * Won't be noticed by scavenge_pointer(). + */ + case type_FunctionHeader: + scavenge_fcn_header((struct function *) fcnobj); + break; + /* If in static space it was moved there by purify and we are + * doing normal scavenge. Handle normally. + */ + case type_FuncallableInstanceHeader: + case type_ClosureHeader: + scavenge_pointer(&fdefn->function); + break; + default: + dprintf(1, ("Ignoring bogus value %x for fdefn function.\n", + *fcnobj)); } - } - else - /* NIL for undefined function? */ - scavenge_pointer(&fdefn->function); + } else + /* NIL for undefined function? */ + scavenge_pointer(&fdefn->function); - if (fix_func) - { /* This shouldn't be needed yet. */ - fdefn->raw_addr = (char *)(fdefn->function + RAW_ADDR_OFFSET); + if (fix_func) { /* This shouldn't be needed yet. */ + fdefn->raw_addr = (char *) (fdefn->function + RAW_ADDR_OFFSET); } - return sizeof(struct fdefn) / sizeof(lispobj); + return sizeof(struct fdefn) / sizeof(lispobj); } #endif /* List scavenger taken from gc.c and adapted */ -static FILE*log=NULL; -static int scav_ro = 0; /* for testing */ -static int debug=0; -static void*trapaddr=0; -void check_trap(void*addr) +static FILE *log = NULL; +static int scav_ro = 0; /* for testing */ +static int debug = 0; +static void *trapaddr = 0; +void +check_trap(void *addr) { - fprintf(stderr,"Trapped @ %x\n",addr); + fprintf(stderr, "Trapped @ %x\n", addr); } static lispobj trans_list(lispobj object) { - lispobj new_list_pointer; - struct cons *cons, *new_cons; - int n=0; - lispobj cdr; - - cons = (struct cons *) PTR(object); - - /* copy 'object' */ - new_cons = (struct cons *) cgc_alloc(sizeof(struct cons)); - new_cons->car = cons->car; - new_cons->cdr = cons->cdr; /* updated later */ - new_list_pointer = (lispobj)new_cons | LowtagOf(object); - bytes_copied += sizeof(struct cons); + lispobj new_list_pointer; + struct cons *cons, *new_cons; + int n = 0; + lispobj cdr; + + cons = (struct cons *) PTR(object); + + /* copy 'object' */ + new_cons = (struct cons *) cgc_alloc(sizeof(struct cons)); + + new_cons->car = cons->car; + new_cons->cdr = cons->cdr; /* updated later */ + new_list_pointer = (lispobj) new_cons | LowtagOf(object); + bytes_copied += sizeof(struct cons); + #if 0 - if(scav_ro>1)check_trap(object); - if(log)fprintf(log,"( %d cons @ #x%x -> #x%x car #x%x)\n", - n++, cons,new_cons,new_cons->car); + if (scav_ro > 1) + check_trap(object); + if (log) + fprintf(log, "( %d cons @ #x%x -> #x%x car #x%x)\n", + n++, cons, new_cons, new_cons->car); #endif - /* Grab the cdr before it is clobbered */ - cdr = cons->cdr; - /* Set forwarding pointer (clobbers start of list). */ - DEPOSIT_FORWARDING_PTR((obj_t)cons,new_list_pointer); + /* Grab the cdr before it is clobbered */ + cdr = cons->cdr; + /* Set forwarding pointer (clobbers start of list). */ + DEPOSIT_FORWARDING_PTR((obj_t) cons, new_list_pointer); + + /* Try to linearize the list in the cdr direction to help reduce paging. */ + while (1) { + lispobj new_cdr; + struct cons *cdr_cons, *new_cdr_cons; + + if (LowtagOf(cdr) != type_ListPointer || !from_space_p(cdr) + || FORWARDED((obj_t) PTR(cdr))) + break; + + cdr_cons = (struct cons *) PTR(cdr); + + /* copy 'cdr' */ + new_cdr_cons = (struct cons *) cgc_alloc(sizeof(struct cons)); + + new_cdr_cons->car = cdr_cons->car; + new_cdr_cons->cdr = cdr_cons->cdr; + new_cdr = (lispobj) new_cdr_cons | LowtagOf(cdr); + bytes_copied += sizeof(struct cons); - /* Try to linearize the list in the cdr direction to help reduce paging. */ - while (1) - { - lispobj new_cdr; - struct cons *cdr_cons, *new_cdr_cons; - - if (LowtagOf(cdr) != type_ListPointer - || !from_space_p(cdr) - || FORWARDED((obj_t)PTR(cdr)) ) - break; - - cdr_cons = (struct cons *) PTR(cdr); - - /* copy 'cdr' */ - new_cdr_cons = (struct cons*) cgc_alloc(sizeof(struct cons)); - new_cdr_cons->car = cdr_cons->car; - new_cdr_cons->cdr = cdr_cons->cdr; - new_cdr = (lispobj)new_cdr_cons | LowtagOf(cdr); - bytes_copied += sizeof(struct cons); #if 0 - if(scav_ro>1)check_trap(object); - if(log)fprintf(log,"( %d cons @ #x%x -> #x%x car #x%x)\n", - n++,cdr_cons,new_cdr_cons,cdr_cons->car); + if (scav_ro > 1) + check_trap(object); + if (log) + fprintf(log, "( %d cons @ #x%x -> #x%x car #x%x)\n", + n++, cdr_cons, new_cdr_cons, cdr_cons->car); #endif - /* Grab the cdr before it is clobbered */ - cdr = cdr_cons->cdr; - /* Set forwarding pointer */ - DEPOSIT_FORWARDING_PTR((obj_t)cdr_cons,new_cdr); - - /* Update the cdr of the last cons copied into new - * space to keep the newspace scavenge from having to do it. - */ - new_cons->cdr = new_cdr; - - new_cons = new_cdr_cons; - } - - return new_list_pointer; + /* Grab the cdr before it is clobbered */ + cdr = cdr_cons->cdr; + /* Set forwarding pointer */ + DEPOSIT_FORWARDING_PTR((obj_t) cdr_cons, new_cdr); + + /* Update the cdr of the last cons copied into new + * space to keep the newspace scavenge from having to do it. + */ + new_cons->cdr = new_cdr; + + new_cons = new_cdr_cons; + } + + return new_list_pointer; } /* Weak Pointers */ -static int weak_noise=0; -static int do_weak=1; +static int weak_noise = 0; +static int do_weak = 1; static int -scav_weak_pointer(lispobj*where) +scav_weak_pointer(lispobj * where) { - struct weak_pointer*wp = weak_pointers; - /* Push the weak pointer onto the list of weak pointers. - * Do I have to watch for duplicates? Originally this was - * part of trans_weak_pointer but that didn't work in the - * case where the WP was in a promoted region. - */ + struct weak_pointer *wp = weak_pointers; - while(wp != NULL) - { - if(wp == (struct weak_pointer*)where) - break; - wp = wp->next; + /* Push the weak pointer onto the list of weak pointers. + * Do I have to watch for duplicates? Originally this was + * part of trans_weak_pointer but that didn't work in the + * case where the WP was in a promoted region. + */ + + while (wp != NULL) { + if (wp == (struct weak_pointer *) where) + break; + wp = wp->next; } - if(wp == NULL) - { - wp = (struct weak_pointer*)where; - wp->next = weak_pointers; - weak_pointers = wp; - if(!do_weak)scavenge_1word_obj(&wp->value); + if (wp == NULL) { + wp = (struct weak_pointer *) where; + wp->next = weak_pointers; + weak_pointers = wp; + if (!do_weak) + scavenge_1word_obj(&wp->value); } - /* Do not let GC scavenge the value slot of the weak pointer - * (that is why it is a weak pointer). - */ + /* Do not let GC scavenge the value slot of the weak pointer + * (that is why it is a weak pointer). + */ - return WEAK_POINTER_NWORDS; + return WEAK_POINTER_NWORDS; } -void scan_weak_pointers(void) -{ - struct weak_pointer *wp; - for (wp = weak_pointers; wp != NULL; wp = wp->next) - { - lispobj value = wp->value; - obj_t obj = (obj_t)PTR(value); - lispobj first, *first_pointer; - - dprintf(weak_noise,("Weak pointer at 0x%08x\n", (unsigned long) wp)); - dprintf(weak_noise,("Value: 0x%08x\n", (unsigned long) value)); - - if (Pointerp(value) && from_space_p(value)) - { - /* Now, we need to check if the object has been forwarded. - * If it has been, the weak pointer is still good and needs - * to be updated. Otherwise, the weak pointer needs to be nil'ed out. - */ - - if(FORWARDED(obj)) - wp->value = FORWARDING_PTR(obj); - else - { /* break it */ - dprintf(weak_noise,("Broken.\n")); - wp->value = NIL; - wp->broken = T; + +void +scan_weak_pointers(void) +{ + struct weak_pointer *wp; + + for (wp = weak_pointers; wp != NULL; wp = wp->next) { + lispobj value = wp->value; + obj_t obj = (obj_t) PTR(value); + lispobj first, *first_pointer; + + dprintf(weak_noise, ("Weak pointer at 0x%08x\n", (unsigned long) wp)); + dprintf(weak_noise, ("Value: 0x%08x\n", (unsigned long) value)); + + if (Pointerp(value) && from_space_p(value)) { + /* Now, we need to check if the object has been forwarded. + * If it has been, the weak pointer is still good and needs + * to be updated. Otherwise, the weak pointer needs to be nil'ed out. + */ + + if (FORWARDED(obj)) + wp->value = FORWARDING_PTR(obj); + else { /* break it */ + dprintf(weak_noise, ("Broken.\n")); + wp->value = NIL; + wp->broken = T; } } } } static int -scavenge_random_object(lispobj*addr) +scavenge_random_object(lispobj * addr) { - lispobj header = *addr; - int count = 1; - dprintf(noise > 1,("soi: %x @ %x\n",header,addr)); + lispobj header = *addr; + int count = 1; + + dprintf(noise > 1, ("soi: %x @ %x\n", header, addr)); #if 0 - if(trapaddr==addr) - check_trap(addr); + if (trapaddr == addr) + check_trap(addr); #endif - gc_assert(ALIGNEDP(addr)); + gc_assert(ALIGNEDP(addr)); - switch (TypeOf(header)) - { - case type_SimpleVector: - { - struct vector*v = (struct vector*)addr; - int i, n = fixnum_value(v->length); - if (HeaderValue(v->header) == subtype_VectorValidHashing) - v->header = (subtype_VectorMustRehash<<type_Bits)|type_SimpleVector; - /* Look at each of the vector elements which can be any lisp object. */ - for(i=0; i<n; i++) - scavenge_1word_obj(&v->data[i]); - count = CEILING(n+2, 2); - } - break; - case type_CodeHeader: - count = scav_code_header(addr); - break; - /* We should never hit any of these, 'cause they occur buried in - * the middle of code objects (and handled by the code just above). - */ - case type_ClosureFunctionHeader: - case type_ReturnPcHeader: - gc_abort(); - - /* Except while looking at an fdefn and wanting to ensure - * code object is looked at. - */ - case type_FunctionHeader: - scavenge_fcn_header((struct function *)addr); - break; + switch (TypeOf(header)) { + case type_SimpleVector: + { + struct vector *v = (struct vector *) addr; + int i, n = fixnum_value(v->length); + + if (HeaderValue(v->header) == subtype_VectorValidHashing) + v->header = + (subtype_VectorMustRehash << type_Bits) | + type_SimpleVector; + /* Look at each of the vector elements which can be any lisp object. */ + for (i = 0; i < n; i++) + scavenge_1word_obj(&v->data[i]); + count = CEILING(n + 2, 2); + } + break; + case type_CodeHeader: + count = scav_code_header(addr); + break; + /* We should never hit any of these, 'cause they occur buried in + * the middle of code objects (and handled by the code just above). + */ + case type_ClosureFunctionHeader: + case type_ReturnPcHeader: + gc_abort(); + + /* Except while looking at an fdefn and wanting to ensure + * code object is looked at. + */ + case type_FunctionHeader: + scavenge_fcn_header((struct function *) addr); + break; #if defined i386 - case type_ClosureHeader: - case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: - case type_DylanFunctionHeader: - count = scav_closure_header((struct closure *)addr); - break; + case type_ClosureHeader: + case type_FuncallableInstanceHeader: + case type_ByteCodeFunction: + case type_ByteCodeClosure: + case type_DylanFunctionHeader: + count = scav_closure_header((struct closure *) addr); + break; #endif - case type_WeakPointer: - count = scav_weak_pointer(addr); - break; - case type_Fdefn: - /* We have to handle fdefn objects specially, so we can fix - * up the raw function address. - */ - count = scav_fdefn(addr); - break; - default: - { - OSC_t class = sct[TypeOf(header)]; - switch(class.sc_kind) + case type_WeakPointer: + count = scav_weak_pointer(addr); + break; + case type_Fdefn: + /* We have to handle fdefn objects specially, so we can fix + * up the raw function address. + */ + count = scav_fdefn(addr); + break; + default: { - case SC_IMMED: - count = 1; - break; - case SC_ISBOXED: - { - int i, words = 1+ HeaderValue(header); - for(i=1; i<words; i++) - scavenge_1word_obj(addr+i); - count = CEILING(words, 2); - } - break; - case SC_UNBOXED: - case SC_STRING: - case SC_VECTOR: /* simple vector handled above */ - count = sizeOfObject((obj_t)addr); - break; - default: - gc_abort(); + OSC_t class = sct[TypeOf(header)]; + + switch (class.sc_kind) { + case SC_IMMED: + count = 1; + break; + case SC_ISBOXED: + { + int i, words = 1 + HeaderValue(header); + + for (i = 1; i < words; i++) + scavenge_1word_obj(addr + i); + count = CEILING(words, 2); + } + break; + case SC_UNBOXED: + case SC_STRING: + case SC_VECTOR: /* simple vector handled above */ + count = sizeOfObject((obj_t) addr); + break; + default: + gc_abort(); + } } - } } - return count; + return count; } -static void logcopy(lispobj*addr, lispobj tagged, int hdr, lispobj to) +static void +logcopy(lispobj * addr, lispobj tagged, int hdr, lispobj to) { - if(log) - { - int kind = TypeOf(hdr); - int words = sizeOfObject((obj_t)PTR(tagged)); - fprintf(log,"(copy #x%x @ #x%x (#x%x %d) to #x%x)\n", - tagged,addr,kind,words,to); + if (log) { + int kind = TypeOf(hdr); + int words = sizeOfObject((obj_t) PTR(tagged)); + + fprintf(log, "(copy #x%x @ #x%x (#x%x %d) to #x%x)\n", + tagged, addr, kind, words, to); } } static void -maybe_transport(lispobj*addr, lispobj tagged, struct region*region) +maybe_transport(lispobj * addr, lispobj tagged, struct region *region) { - obj_t obj = (obj_t)PTR(tagged); - gc_assert(ALIGNEDP(obj)); - gc_assert(Pointerp(tagged)); - gc_assert((void*)region != (void*)obj); + obj_t obj = (obj_t) PTR(tagged); + + gc_assert(ALIGNEDP(obj)); + gc_assert(Pointerp(tagged)); + gc_assert((void *) region != (void *) obj); #if 0 - if((void*)obj == (void*)trapaddr) - check_trap(obj); + if ((void *) obj == (void *) trapaddr) + check_trap(obj); #endif - if (region->contains_small_objects) - { - lispobj new = copy(tagged); + if (region->contains_small_objects) { + lispobj new = copy(tagged); + #if 0 - if(scav_ro > 1) /* debugging in RO space */ - check_trap(obj); + if (scav_ro > 1) /* debugging in RO space */ + check_trap(obj); #endif #if defined GOOSE_CHASE - if(TypeOf(obj->header)==type_Fdefn) - { - struct fdefn*fdefn=(struct fdefn*)PTR(new); - if(fdefn->function < STATIC_SPACE_START) - check_trap(obj); + if (TypeOf(obj->header) == type_Fdefn) { + struct fdefn *fdefn = (struct fdefn *) PTR(new); + + if (fdefn->function < STATIC_SPACE_START) + check_trap(obj); } #endif - dprintf(0,("copy %x @ %x (%x) to %x\n", - tagged,addr,TypeOf(obj->header),new)); - logcopy(addr,tagged,obj->header,new); - DEPOSIT_FORWARDING_PTR(obj , new); - *addr = new; - } - else - { - move_to_newspace(region); - dprintf(0,("move %x\n",region)); + dprintf(0, ("copy %x @ %x (%x) to %x\n", + tagged, addr, TypeOf(obj->header), new)); + logcopy(addr, tagged, obj->header, new); + DEPOSIT_FORWARDING_PTR(obj, new); + *addr = new; + } else { + move_to_newspace(region); + dprintf(0, ("move %x\n", region)); } } void -scavenge_pointer(lispobj*addr) +scavenge_pointer(lispobj * addr) { - lispobj taggedobj = *addr; /* descriptor */ - obj_t obj = (obj_t)PTR(taggedobj); /* pointer to object */ - gc_assert(Pointerp(taggedobj)); + lispobj taggedobj = *addr; /* descriptor */ + obj_t obj = (obj_t) PTR(taggedobj); /* pointer to object */ + + gc_assert(Pointerp(taggedobj)); #if 0 - if(addr == trapaddr) check_trap(addr); - if(obj == trapaddr) check_trap(obj); + if (addr == trapaddr) + check_trap(addr); + if (obj == trapaddr) + check_trap(obj); #endif - /* optimize out common static pointers */ - if(taggedobj != NIL && taggedobj != T) - { - struct region*region = find_region(obj); - /* Only interested in pointers into oldspace */ - if(region && region->space == oldspace) - { - if(FORWARDED(obj)) - *addr = FORWARDING_PTR(obj); - else - switch (LowtagOf(taggedobj)) - { - case type_ListPointer: - dprintf(noise>1,("ListPointer @ %x...\n",addr)); - *addr = trans_list(taggedobj); - dprintf(noise>1,("... -> %x\n",addr)); - break; - case type_FunctionPointer: - switch(TypeOf(obj->header)) - { - case type_ClosureHeader: - case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: - case type_DylanFunctionHeader: - maybe_transport(addr, taggedobj, region); - break; + /* optimize out common static pointers */ + if (taggedobj != NIL && taggedobj != T) { + struct region *region = find_region(obj); + + /* Only interested in pointers into oldspace */ + if (region && region->space == oldspace) { + if (FORWARDED(obj)) + *addr = FORWARDING_PTR(obj); + else + switch (LowtagOf(taggedobj)) { + case type_ListPointer: + dprintf(noise > 1, ("ListPointer @ %x...\n", addr)); + *addr = trans_list(taggedobj); + dprintf(noise > 1, ("... -> %x\n", addr)); + break; + case type_FunctionPointer: + switch (TypeOf(obj->header)) { + case type_ClosureHeader: + case type_FuncallableInstanceHeader: + case type_ByteCodeFunction: + case type_ByteCodeClosure: + case type_DylanFunctionHeader: + maybe_transport(addr, taggedobj, region); + break; + default: + gc_abort(); + } + break; + case type_InstancePointer: + case type_OtherPointer: + maybe_transport(addr, taggedobj, region); + break; default: - gc_abort(); - } - break; - case type_InstancePointer: - case type_OtherPointer: - maybe_transport(addr, taggedobj, region); - break; - default: - /* It was a pointer, but not one of them? */ - gc_abort(); - } + /* It was a pointer, but not one of them? */ + gc_abort(); + } } } } -static lispobj*scavenge(lispobj*addr, int ptrs) +static lispobj * +scavenge(lispobj * addr, int ptrs) { - /* addr points to an aligned 32-bit word in some space. */ - struct region *region; - lispobj*end = addr + ptrs; - lispobj obj; - while (addr < end) - { - int count = 1; - obj = *addr; /* the lisp object */ + /* addr points to an aligned 32-bit word in some space. */ + struct region *region; + lispobj *end = addr + ptrs; + lispobj obj; + + while (addr < end) { + int count = 1; + + obj = *addr; /* the lisp object */ #if 0 - if(trapaddr == addr) - check_trap(addr); /* gdb breakpoint */ + if (trapaddr == addr) + check_trap(addr); /* gdb breakpoint */ #endif - if (Pointerp(obj)) /* lowtag odd */ - scavenge_pointer(addr); - else if(obj & 0x3) /* some other immediate */ - /* - * Some random header. Process some type dependent number - * of words. May still be inside object after call and the - * next cell can be any lisp object. We can either recurse - * by calling scavenge here or let the caller do it. - */ - count = scavenge_random_object(addr); - else - IMMED_OR_LOSE(obj); - - addr += count; + if (Pointerp(obj)) /* lowtag odd */ + scavenge_pointer(addr); + else if (obj & 0x3) + /* some other immediate */ + /* + * Some random header. Process some type dependent number + * of words. May still be inside object after call and the + * next cell can be any lisp object. We can either recurse + * by calling scavenge here or let the caller do it. + */ + count = scavenge_random_object(addr); + else + IMMED_OR_LOSE(obj); + + addr += count; } - return addr; + return addr; } static void -scavenge_cons(lispobj*where) -{ - /* Scavenge a two-word space */ - scavenge_1word_obj(where + 0); /* car */ - scavenge_1word_obj(where + 1); /* cdr */ -} -static lispobj*scavenge_object(lispobj*start) -{ - int length = sizeOfObject((obj_t)start); - int words = scavenge_random_object(start); - gc_assert(length == words); - return start+length; -} -static lispobj* -scavengex(lispobj*obj) -{ - /* Thing at this location is one of: - * a - basic object with header. - * b - cons object (no header). - * so that the starting and ending addresses are aligned. - */ - gc_assert(ALIGNEDP(obj)); - { - lispobj first_word = *obj; - OSC_t sc = sct[TypeOf(first_word)]; - if(Pointerp(first_word) || sc.sc_kind == SC_IMMED) - { /* Must be a cons object or unused space */ - scavenge_cons((lispobj*)obj); - return obj + 2; - } - else - { /* Must be a complex object with header */ - lispobj*next = scavenge_object(obj); - return next; - } - } +scavenge_cons(lispobj * where) +{ + /* Scavenge a two-word space */ + scavenge_1word_obj(where + 0); /* car */ + scavenge_1word_obj(where + 1); /* cdr */ +} +static lispobj * +scavenge_object(lispobj * start) +{ + int length = sizeOfObject((obj_t) start); + int words = scavenge_random_object(start); + + gc_assert(length == words); + return start + length; +} +static lispobj * +scavengex(lispobj * obj) +{ + /* Thing at this location is one of: + * a - basic object with header. + * b - cons object (no header). + * so that the starting and ending addresses are aligned. + */ + gc_assert(ALIGNEDP(obj)); + { + lispobj first_word = *obj; + OSC_t sc = sct[TypeOf(first_word)]; + + if (Pointerp(first_word) || sc.sc_kind == SC_IMMED) { /* Must be a cons object or unused space */ + scavenge_cons((lispobj *) obj); + return obj + 2; + } else { /* Must be a complex object with header */ + lispobj *next = scavenge_object(obj); + + return next; + } + } } static void -scavenge_space( lispobj*where, int words, char*name ) -{ - int allocated = bytes_allocated; - lispobj*end = where + words; - lispobj*last; - bytes_copied = 0; - if(name) - dprintf(noise,(" %s",name)); - while (where < end) - { - last = where; - where = scavengex(last); +scavenge_space(lispobj * where, int words, char *name) +{ + int allocated = bytes_allocated; + lispobj *end = where + words; + lispobj *last; + + bytes_copied = 0; + if (name) + dprintf(noise, (" %s", name)); + while (where < end) { + last = where; + where = scavengex(last); } - gc_assert(where == end); - if(name) - dprintf(noise,(" %ld bytes moved, %ld bytes allocated.\n", - bytes_copied, bytes_allocated - allocated)); + gc_assert(where == end); + if (name) + dprintf(noise, (" %ld bytes moved, %ld bytes allocated.\n", + bytes_copied, bytes_allocated - allocated)); } static int boxed_registers[] = BOXED_REGISTERS; static void -preserve_interrupt_context(os_context_t *context) +preserve_interrupt_context(os_context_t * context) { - int i; - /* Check each boxed register for a valid pointer and promote - * its region when found. - */ - for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) - { - int index = boxed_registers[i]; - lispobj foo = SC_REG(context,index); - struct region*region = find_region((void*)foo); - if(region && region->space == oldspace) - move_to_newspace(region); + int i; + + /* Check each boxed register for a valid pointer and promote + * its region when found. + */ + for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) { + int index = boxed_registers[i]; + lispobj foo = SC_REG(context, index); + struct region *region = find_region((void *) foo); + + if (region && region->space == oldspace) + move_to_newspace(region); } } -static void preserve_interrupt_contexts(void) +static void +preserve_interrupt_contexts(void) { - int i, index; - os_context_t *context; + int i, index; + os_context_t *context; - index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)); - dprintf(noise,("Number of active contexts: %d\n", index)); + index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)); + dprintf(noise, ("Number of active contexts: %d\n", index)); - for (i = 0; i < index; i++) - { - context = lisp_interrupt_contexts[i]; - preserve_interrupt_context(context); + for (i = 0; i < index; i++) { + context = lisp_interrupt_contexts[i]; + preserve_interrupt_context(context); } } - -static void flip_spaces() + +static void +flip_spaces() { struct space *temp = oldspace; + oldspace = newspace; newspace = temp; } @@ -1461,434 +1531,453 @@ static void flip_spaces() * to just the assigned lisp stack area. */ #if defined i386 -#define BOS (CONTROL_STACK_START+CONTROL_STACK_SIZE) /* x86-validate.h */ +#define BOS (CONTROL_STACK_START+CONTROL_STACK_SIZE) /* x86-validate.h */ /* Traverse stack in same direction as it was loaded to try and * preserve original ordering of pages. Good for the VM system I hope. - */ + */ #define ACROSS_STACK(var) var=(void**)BOS-1; var > (void**)&var; var-- #endif -void preserve_pointer(void *ptr) +void +preserve_pointer(void *ptr) { - if (ptr > heap_base && ptr < heap_end) - { - struct region *region = find_region(ptr); - if (region != NULL && region->space == oldspace) - { - dprintf(0,("move %x\n",ptr)); - move_to_newspace(region); + if (ptr > heap_base && ptr < heap_end) { + struct region *region = find_region(ptr); + + if (region != NULL && region->space == oldspace) { + dprintf(0, ("move %x\n", ptr)); + move_to_newspace(region); } } } -static void preserve_stack() +static void +preserve_stack() { - void **addr; /* auto var is current TOS */ - for (ACROSS_STACK(addr)) - preserve_pointer(*addr); + void **addr; /* auto var is current TOS */ + + for (ACROSS_STACK(addr)) + preserve_pointer(*addr); } #ifdef CONTROL_STACKS /* Scavenge the thread stack conservative roots. */ -void scavenge_thread_stacks(void) -{ - lispobj thread_stacks = SymbolValue(CONTROL_STACKS); - int type = TypeOf(thread_stacks); - - if (LowtagOf(thread_stacks)==type_OtherPointer) { - struct vector *vector = (struct vector *) PTR(thread_stacks); - int length, i; - if (TypeOf(vector->header)!=type_SimpleVector) - return; - length = fixnum_value(vector->length); - for (i=0; i<length; i++) { - lispobj stack_obj = vector->data[i]; - if (LowtagOf(stack_obj)==type_OtherPointer) { - struct vector *stack = (struct vector *) PTR(stack_obj); - int length, j; - if (TypeOf(stack->header)!=type_SimpleArrayUnsignedByte32) - return; - length = fixnum_value(stack->length); - /* fprintf(stderr,"Scavenging control stack %d of length %d words\n", - i,length); */ - for (j=0; j<length; j++) - preserve_pointer((void *)stack->data[j]); - } +void +scavenge_thread_stacks(void) +{ + lispobj thread_stacks = SymbolValue(CONTROL_STACKS); + int type = TypeOf(thread_stacks); + + if (LowtagOf(thread_stacks) == type_OtherPointer) { + struct vector *vector = (struct vector *) PTR(thread_stacks); + int length, i; + + if (TypeOf(vector->header) != type_SimpleVector) + return; + length = fixnum_value(vector->length); + for (i = 0; i < length; i++) { + lispobj stack_obj = vector->data[i]; + + if (LowtagOf(stack_obj) == type_OtherPointer) { + struct vector *stack = (struct vector *) PTR(stack_obj); + int length, j; + + if (TypeOf(stack->header) != type_SimpleArrayUnsignedByte32) + return; + length = fixnum_value(stack->length); + /* fprintf(stderr,"Scavenging control stack %d of length %d words\n", + i,length); */ + for (j = 0; j < length; j++) + preserve_pointer((void *) stack->data[j]); + } + } } - } } #endif -static void zero_stack() +static void +zero_stack() { - /* This is a bit tricky because we don't want to zap any - * stack frames between here and the call to mmap. For now, - * lets just be slow and careful. - */ - long*p,*q; - os_vm_address_t base = (os_vm_address_t)CONTROL_STACK_START; - os_vm_size_t size = (char*)&base - (char*)base; + /* This is a bit tricky because we don't want to zap any + * stack frames between here and the call to mmap. For now, + * lets just be slow and careful. + */ + long *p, *q; + os_vm_address_t base = (os_vm_address_t) CONTROL_STACK_START; + os_vm_size_t size = (char *) &base - (char *) base; + #if 0 - cgc_zero(base,size); + cgc_zero(base, size); #else - p = (long*)base; - q = (long*)&size; - while(p < q) - *p++ = 0; + p = (long *) base; + q = (long *) &size; + while (p < q) + *p++ = 0; #endif - + } #if defined STATIC_BLUE_BAG -static int fast_static=1; -static void scavenge_static() -{ - /* Static space consists of alternating layers of - * code objects that refer to read-only space (from purify), - * static non-code objects that need looking at, and - * newly loaded code objects that refer to dynamic space. - * The number of these areas depends on how many times purify - * ran while loading the system image. I will extend purify - * to maintain a list of collectable areas and use that list - * here to avoid scanning read-only code sections. - */ - lispobj*ss0 = (lispobj*)PTR(NIL); - lispobj*ssa = (lispobj*)(PTR(STATIC_BLUE_BAG)); - lispobj*ssz = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER); - lispobj bag = SymbolValue(STATIC_BLUE_BAG); - lispobj*end = NULL; - ssa += sizeOfObject(OBJECT_AT(ssa)); /* Genesis modifies plist entry */ - if(fast_static) - { - scavenge_space(ss0, ssa-ss0, "Static0"); - if(bag != NIL && LowtagOf(bag) == type_ListPointer) - { - char sbuf[128]; - struct cons*cons = (struct cons*)PTR(bag); - while(LowtagOf(cons->car) == type_ListPointer) - { - struct cons*pair = (struct cons*)PTR(cons->car); - lispobj*ss1 = (lispobj*)pair->car; - lispobj*ss2 = (lispobj*)pair->cdr; - if(end == NULL) - end = ss2; - sprintf(sbuf,"Static %x %d",ss1, ss2-ss1); - scavenge_space(ss1, ss2-ss1, sbuf); - if(cons->cdr != NIL && LowtagOf(cons->cdr) == type_ListPointer) - cons = (struct cons*)PTR(cons->cdr); - else break; +static int fast_static = 1; +static void +scavenge_static() +{ + /* Static space consists of alternating layers of + * code objects that refer to read-only space (from purify), + * static non-code objects that need looking at, and + * newly loaded code objects that refer to dynamic space. + * The number of these areas depends on how many times purify + * ran while loading the system image. I will extend purify + * to maintain a list of collectable areas and use that list + * here to avoid scanning read-only code sections. + */ + lispobj *ss0 = (lispobj *) PTR(NIL); + lispobj *ssa = (lispobj *) (PTR(STATIC_BLUE_BAG)); + lispobj *ssz = (lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER); + lispobj bag = SymbolValue(STATIC_BLUE_BAG); + lispobj *end = NULL; + + ssa += sizeOfObject(OBJECT_AT(ssa)); /* Genesis modifies plist entry */ + if (fast_static) { + scavenge_space(ss0, ssa - ss0, "Static0"); + if (bag != NIL && LowtagOf(bag) == type_ListPointer) { + char sbuf[128]; + struct cons *cons = (struct cons *) PTR(bag); + + while (LowtagOf(cons->car) == type_ListPointer) { + struct cons *pair = (struct cons *) PTR(cons->car); + lispobj *ss1 = (lispobj *) pair->car; + lispobj *ss2 = (lispobj *) pair->cdr; + + if (end == NULL) + end = ss2; + sprintf(sbuf, "Static %x %d", ss1, ss2 - ss1); + scavenge_space(ss1, ss2 - ss1, sbuf); + if (cons->cdr != NIL && LowtagOf(cons->cdr) == type_ListPointer) + cons = (struct cons *) PTR(cons->cdr); + else + break; } } - if(end != NULL) - scavenge_space(end, ssz-end, "Static"); - } - else (scavenge_space(ss0, ssz-ss0, "Static-All")); + if (end != NULL) + scavenge_space(end, ssz - end, "Static"); + } else + (scavenge_space(ss0, ssz - ss0, "Static-All")); } #endif -static void scavenge_roots() -{ - /* So what should go here? - * When cgc starts up after purify/save all live objects - * are in read-only or static space, and anything in RO - * can point only to RO or STATIC and can't be changed. - * Anything in STATIC is subject to change (but not move). - * . not read-only-space (probably most of the roots here) - * . static-space (all compiled code at least) - * . binding-stack - * . weak-pointers - ? do I allow GC from interrupt?) - * . interrupt-context (regs same as stack) - **** - * Well, it turns out that RO space ain't exactly that as - * somehow apparently cached 'compact-info-environment' stuff - * modifies at least 2 locations in RO space. There is a note - * in globaldb.lisp that alludes to this and provides a post GC - * hook to blow the cache. Not a problem if gc is called from - * the lisp wrapper. UPDATE: Found purify bug which forced - * boxed vectors into RO. This may be what led to above. - * - */ - lispobj*rs0 = (lispobj*)READ_ONLY_SPACE_START; - lispobj*rsz = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER); - lispobj*ss0 = (lispobj*)STATIC_SPACE_START; - lispobj*ssz = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER); - lispobj*bs0 = (lispobj*)BINDING_STACK_START; - lispobj*bsz = (lispobj*)SymbolValue(BINDING_STACK_POINTER); - - if(scav_ro) - { - scav_ro++; - scavenge_space(rs0, rsz-rs0, "RO"); - scav_ro--; +static void +scavenge_roots() +{ + /* So what should go here? + * When cgc starts up after purify/save all live objects + * are in read-only or static space, and anything in RO + * can point only to RO or STATIC and can't be changed. + * Anything in STATIC is subject to change (but not move). + * . not read-only-space (probably most of the roots here) + * . static-space (all compiled code at least) + * . binding-stack + * . weak-pointers + ? do I allow GC from interrupt?) + * . interrupt-context (regs same as stack) + **** + * Well, it turns out that RO space ain't exactly that as + * somehow apparently cached 'compact-info-environment' stuff + * modifies at least 2 locations in RO space. There is a note + * in globaldb.lisp that alludes to this and provides a post GC + * hook to blow the cache. Not a problem if gc is called from + * the lisp wrapper. UPDATE: Found purify bug which forced + * boxed vectors into RO. This may be what led to above. + * + */ + lispobj *rs0 = (lispobj *) READ_ONLY_SPACE_START; + lispobj *rsz = (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER); + lispobj *ss0 = (lispobj *) STATIC_SPACE_START; + lispobj *ssz = (lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER); + lispobj *bs0 = (lispobj *) BINDING_STACK_START; + lispobj *bsz = (lispobj *) SymbolValue(BINDING_STACK_POINTER); + + if (scav_ro) { + scav_ro++; + scavenge_space(rs0, rsz - rs0, "RO"); + scav_ro--; } - scavenge_static(); - scavenge_space(bs0, bsz-bs0, "Binding Stack"); + scavenge_static(); + scavenge_space(bs0, bsz - bs0, "Binding Stack"); - dprintf(noise,("Interrupt handlers (%u bytes) ...\n", - sizeof(interrupt_handlers))); + dprintf(noise, ("Interrupt handlers (%u bytes) ...\n", + sizeof(interrupt_handlers))); - scavenge((lispobj *) interrupt_handlers, - sizeof(interrupt_handlers) / sizeof(lispobj)); + scavenge((lispobj *) interrupt_handlers, + sizeof(interrupt_handlers) / sizeof(lispobj)); } -static void scavenge_newspace() -{ - /* Scavenge is going to start at the beginning of newspace which - * is presumed to have some "root" object pointers lying about due - * to promoting regions that may be aimed at by stack resident pointers, - * copied small objects from scavenge_roots(), or promoted large_object - * regions. Scavenge() will flush out more copied objects/promoted - * regions that will get added to the end of newspace and eventually - * scanned by this code -- until all referenced things (and maybe some - * extra dead stuff) have been examined. At the end of this loop anything - * in oldspace is trash. - */ +static void +scavenge_newspace() +{ + /* Scavenge is going to start at the beginning of newspace which + * is presumed to have some "root" object pointers lying about due + * to promoting regions that may be aimed at by stack resident pointers, + * copied small objects from scavenge_roots(), or promoted large_object + * regions. Scavenge() will flush out more copied objects/promoted + * regions that will get added to the end of newspace and eventually + * scanned by this code -- until all referenced things (and maybe some + * extra dead stuff) have been examined. At the end of this loop anything + * in oldspace is trash. + */ struct region *current; + current = newspace->regions; - while (current != NULL) - { - if (current->contains_small_objects) - { - void *obj = (char *)current + REGION_OVERHEAD; - void *end = (char *)current + current->num_chunks*CHUNK_BYTES; + while (current != NULL) { + if (current->contains_small_objects) { + void *obj = (char *) current + REGION_OVERHEAD; + void *end = (char *) current + current->num_chunks * CHUNK_BYTES; + while (obj < end) - obj = SCAVENGE_OBJECT(OBJECT_AT(obj)); + obj = SCAVENGE_OBJECT(OBJECT_AT(obj)); gc_assert(obj == end); - } - else - SCAVENGE_OBJECT(OBJECT_AT(((char *)current + REGION_OVERHEAD))); + } else + SCAVENGE_OBJECT(OBJECT_AT(((char *) current + REGION_OVERHEAD))); current = current->next; - } + } } -static void free_oldspace() +static void +free_oldspace() { struct region *region, *next; + chunks_freed = 0; - for (region = oldspace->regions; region != NULL; region = next) - { + for (region = oldspace->regions; region != NULL; region = next) { gc_assert(region->space != newspace); next = region->next; free_region(region); - } + } oldspace->alloc_ptr = NULL; oldspace->alloc_end = NULL; oldspace->regions = NULL; oldspace->regions_tail = &oldspace->regions; } -static void verify_space(lispobj*start, size_t words) +static void +verify_space(lispobj * start, size_t words) { - while(words > 0) - { - size_t count = 1; - lispobj thing = *(lispobj*)start; - if(Pointerp(thing)) - { - struct region*region = find_region((void*)thing); - if(region && region->space == NULL) - fprintf(stderr,"Ptr %x @ %x sees Junk\n",thing,start); - } - else - if(thing & 0x3) - { - obj_t obj = (obj_t)start; - switch(TypeOf(obj->header)) - { + while (words > 0) { + size_t count = 1; + lispobj thing = *(lispobj *) start; + + if (Pointerp(thing)) { + struct region *region = find_region((void *) thing); + + if (region && region->space == NULL) + fprintf(stderr, "Ptr %x @ %x sees Junk\n", thing, start); + } else if (thing & 0x3) { + obj_t obj = (obj_t) start; + + switch (TypeOf(obj->header)) { case type_CodeHeader: - { - lispobj object = *start; - struct code *code; - int nheader_words, ncode_words, nwords; - lispobj fheaderl; - struct function *fheaderp; - - code = (struct code *) start; - ncode_words = fixnum_value(code->code_size); - nheader_words = HeaderValue(object); - nwords = ncode_words + nheader_words; - nwords = CEILING(nwords, 2); - /* Scavenge the boxed section of the code data block */ - verify_space(start + 1, nheader_words - 1); - - /* Scavenge the boxed section of each function object in the - * code data block. - */ - fheaderl = code->entry_points; - while (fheaderl != NIL) { - fheaderp = (struct function *) PTR(fheaderl); - gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); - verify_space(&fheaderp->name, 1); - verify_space(&fheaderp->arglist, 1); - verify_space(&fheaderp->type, 1); - fheaderl = fheaderp->next; + { + lispobj object = *start; + struct code *code; + int nheader_words, ncode_words, nwords; + lispobj fheaderl; + struct function *fheaderp; + + code = (struct code *) start; + ncode_words = fixnum_value(code->code_size); + nheader_words = HeaderValue(object); + nwords = ncode_words + nheader_words; + nwords = CEILING(nwords, 2); + /* Scavenge the boxed section of the code data block */ + verify_space(start + 1, nheader_words - 1); + + /* Scavenge the boxed section of each function object in the + * code data block. + */ + fheaderl = code->entry_points; + while (fheaderl != NIL) { + fheaderp = (struct function *) PTR(fheaderl); + gc_assert(TypeOf(fheaderp->header) == + type_FunctionHeader); + verify_space(&fheaderp->name, 1); + verify_space(&fheaderp->arglist, 1); + verify_space(&fheaderp->type, 1); + fheaderl = fheaderp->next; + } + count = nwords; + break; } - count = nwords; - break; - } default: - { - OSC_t class = sct[TypeOf(obj->header)]; - switch(class.sc_kind) - { - case SC_ISBOXED: - case SC_IMMED: - count = 1; - break; - case SC_UNBOXED: - case SC_STRING: - case SC_VECTOR: - count = sizeOfObject((obj_t)start); + { + OSC_t class = sct[TypeOf(obj->header)]; + + switch (class.sc_kind) { + case SC_ISBOXED: + case SC_IMMED: + count = 1; + break; + case SC_UNBOXED: + case SC_STRING: + case SC_VECTOR: + count = sizeOfObject((obj_t) start); + break; + default: + gc_abort(); + } break; - default: - gc_abort(); - } - break; - } - } - } - start += count; - words -= count; + } + } + } + start += count; + words -= count; } } /* For debug/test only. */ -static void +static void verify_gc() { - lispobj*rs0 = (lispobj*)READ_ONLY_SPACE_START; - lispobj*rsz = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER); - lispobj*ss0 = (lispobj*)STATIC_SPACE_START; - lispobj*ssz = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER); - lispobj*bs0 = (lispobj*)BINDING_STACK_START; - lispobj*bsz = (lispobj*)SymbolValue(BINDING_STACK_POINTER); - lispobj*cs0 = (lispobj*)&rs0; - lispobj*csz = (lispobj*)BOS; - /* can't check stack easily because there may be non-valid - * objects there (thats why we're doing this cgc stuff). In - * particular there are raw return addresses which can be very - * descriptorish looking!!! - - verify_space(cs0, csz-cs0); - */ - verify_space(rs0, rsz-rs0); - verify_space(ss0, ssz-ss0); - verify_space(bs0, bsz-bs0); -} -static void fixup_regions(struct region*region) -{ - do - { - lispobj header = (lispobj)OBJECT_AT(region)->header; - if(static_space_p(header)) - { - /* Purify thought this header was a cons? Why? */ - struct cons*wrong = (struct cons*)PTR(header); - struct cons*fixme = (struct cons*)region; - dprintf(1,("\n--Fixing region header @ %x.",region)); - fixme->car = wrong->car; /* restore region header */ - fixme->cdr = wrong->cdr; /* restore prev pointer */ - wrong->car = wrong->cdr = 0; + lispobj *rs0 = (lispobj *) READ_ONLY_SPACE_START; + lispobj *rsz = (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER); + lispobj *ss0 = (lispobj *) STATIC_SPACE_START; + lispobj *ssz = (lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER); + lispobj *bs0 = (lispobj *) BINDING_STACK_START; + lispobj *bsz = (lispobj *) SymbolValue(BINDING_STACK_POINTER); + lispobj *cs0 = (lispobj *) & rs0; + lispobj *csz = (lispobj *) BOS; + + /* can't check stack easily because there may be non-valid + * objects there (thats why we're doing this cgc stuff). In + * particular there are raw return addresses which can be very + * descriptorish looking!!! + + verify_space(cs0, csz-cs0); + */ + verify_space(rs0, rsz - rs0); + verify_space(ss0, ssz - ss0); + verify_space(bs0, bsz - bs0); +} +static void +fixup_regions(struct region *region) +{ + do { + lispobj header = (lispobj) OBJECT_AT(region)->header; + + if (static_space_p(header)) { + /* Purify thought this header was a cons? Why? */ + struct cons *wrong = (struct cons *) PTR(header); + struct cons *fixme = (struct cons *) region; + + dprintf(1, ("\n--Fixing region header @ %x.", region)); + fixme->car = wrong->car; /* restore region header */ + fixme->cdr = wrong->cdr; /* restore prev pointer */ + wrong->car = wrong->cdr = 0; } - region = region->next; + region = region->next; } - while (region != NULL); + while (region != NULL); } -static void post_purify_fixup(struct space*space) -{ - /* Purify may have messed up the region headers. This can happen - * if there is a dead list pointer on the stack that now aims - * at a region header (previously was valid memory). Purify attempts - * to at least check for a valid object header but loses with lists. - * This hack recovers the correct values and keeps us going. Can - * this occur with other dead objects? - */ - if(large_region_free_list) - fixup_regions(large_region_free_list); - if(small_region_free_list) - fixup_regions(small_region_free_list); - fixup_regions(space->regions); +static void +post_purify_fixup(struct space *space) +{ + /* Purify may have messed up the region headers. This can happen + * if there is a dead list pointer on the stack that now aims + * at a region header (previously was valid memory). Purify attempts + * to at least check for a valid object header but loses with lists. + * This hack recovers the correct values and keeps us going. Can + * this occur with other dead objects? + */ + if (large_region_free_list) + fixup_regions(large_region_free_list); + if (small_region_free_list) + fixup_regions(small_region_free_list); + fixup_regions(space->regions); } - -static int dolog=0; /* log copy ops to file */ -static int dover=0; /* hunt pointers to oldspace */ -void cgc_collect_garbage() -{ - unsigned long allocated = bytes_allocated; - - dprintf(noise,("GC\n")); - if(dolog && !log) - log=fopen("LOG.tmp","w"); - - /* Initialize the weak pointer list. */ - weak_pointers = NULL; - - dprintf(noise,("[Flip Spaces]\n")); - flip_spaces(); - preserve_interrupt_contexts(); - dprintf(noise,("[Preserve Stack]\n")); - preserve_stack(); - scavenge_thread_stacks(); - dprintf(noise,("[Scavenge Roots]\n")); - scavenge_roots(); - dprintf(noise,("[Scavenge New]\n")); - scavenge_newspace(); - scan_weak_pointers(); - dprintf(noise,("[Free Oldspace]\n")); - free_oldspace(); - if(dover) { - dprintf(noise,("[Checking]\n")); - verify_gc();} - dprintf(noise,("[Compacting]\n")); - compact_free_regions(); - /* The stack will be zeroed by scrub-control-stack in sub-gc which - is more effecient. */ - /* zero_stack(); */ - if(log) - fclose(log); - log=NULL; - dprintf(noise,(" %ld bytes copied.\n",(bytes_allocated - allocated))); - dprintf(noise,(" %ld bytes (%ld pages) reclaimed.\n", - chunks_freed*CHUNK_BYTES, chunks_freed)); - bytes_allocated -= chunks_freed*CHUNK_BYTES; - maybe_gc_called = 0; -} -void cgc_free_heap() -{ - /* Like above but just zap everything 'cause purify has - * cleaned house! - */ - unsigned long allocated = bytes_allocated; - flip_spaces(); - post_purify_fixup(oldspace); - free_oldspace(); - compact_free_regions(); -#if 0 /* purify is currently running on the C stack so don't do this */ - zero_stack(); -#endif - bytes_allocated -= chunks_freed*CHUNK_BYTES; + +static int dolog = 0; /* log copy ops to file */ +static int dover = 0; /* hunt pointers to oldspace */ +void +cgc_collect_garbage() +{ + unsigned long allocated = bytes_allocated; + + dprintf(noise, ("GC\n")); + if (dolog && !log) + log = fopen("LOG.tmp", "w"); + + /* Initialize the weak pointer list. */ + weak_pointers = NULL; + + dprintf(noise, ("[Flip Spaces]\n")); + flip_spaces(); + preserve_interrupt_contexts(); + dprintf(noise, ("[Preserve Stack]\n")); + preserve_stack(); + scavenge_thread_stacks(); + dprintf(noise, ("[Scavenge Roots]\n")); + scavenge_roots(); + dprintf(noise, ("[Scavenge New]\n")); + scavenge_newspace(); + scan_weak_pointers(); + dprintf(noise, ("[Free Oldspace]\n")); + free_oldspace(); + if (dover) { + dprintf(noise, ("[Checking]\n")); + verify_gc(); + } + dprintf(noise, ("[Compacting]\n")); + compact_free_regions(); + /* The stack will be zeroed by scrub-control-stack in sub-gc which + is more effecient. */ + /* zero_stack(); */ + if (log) + fclose(log); + log = NULL; + dprintf(noise, (" %ld bytes copied.\n", (bytes_allocated - allocated))); + dprintf(noise, (" %ld bytes (%ld pages) reclaimed.\n", + chunks_freed * CHUNK_BYTES, chunks_freed)); + bytes_allocated -= chunks_freed * CHUNK_BYTES; + maybe_gc_called = 0; } +void +cgc_free_heap() +{ + /* Like above but just zap everything 'cause purify has + * cleaned house! + */ + unsigned long allocated = bytes_allocated; + + flip_spaces(); + post_purify_fixup(oldspace); + free_oldspace(); + compact_free_regions(); +#if 0 /* purify is currently running on the C stack so don't do this */ + zero_stack(); +#endif + bytes_allocated -= chunks_freed * CHUNK_BYTES; +} + void cgc_init_collector() { int max_blocks; - heap_base = (void*)DYNAMIC_0_SPACE_START; + + heap_base = (void *) DYNAMIC_0_SPACE_START; /* I could actually use both spaces here but just 1 for now */ - heap_end = (char*)heap_base + dynamic_space_size; + heap_end = (char *) heap_base + dynamic_space_size; max_blocks = BLOCK_NUMBER(heap_end) - BLOCK_NUMBER(heap_base); - if((block_table_base = malloc(sizeof(struct cluster *) * max_blocks)) - != NULL) - { + if ((block_table_base = malloc(sizeof(struct cluster *) * max_blocks)) + != NULL) { memset(block_table_base, 0, sizeof(struct cluster *) * max_blocks); + block_table = (block_table_base - BLOCK_NUMBER(heap_base)); space_0.regions_tail = &space_0.regions; @@ -1896,104 +1985,111 @@ cgc_init_collector() newspace = &space_0; oldspace = &space_1; - } - else perror("malloc cgc block table"); - init_osc(); /* Object Storage Class table */ + } else + perror("malloc cgc block table"); + init_osc(); /* Object Storage Class table */ } void do_pending_interrupt(void); int use_cgc_p = 0; -char*alloc(int nbytes) +char * +alloc(int nbytes) { - /* Alloc is only called from lisp code to allocate a number of - words, the cgc GC uses cgc_alloc directly as the checks of the - heap size and is not needed and interrupts are allways disabled - during a GC. */ + /* Alloc is only called from lisp code to allocate a number of + words, the cgc GC uses cgc_alloc directly as the checks of the + heap size and is not needed and interrupts are allways disabled + during a GC. */ - /* Assumes nbytes includes alignment. Python arranges for that - * but the C startup code needed some help. - */ + /* Assumes nbytes includes alignment. Python arranges for that + * but the C startup code needed some help. + */ #if 0 - int bytes = (nbytes + (ALIGN_BYTES-1)) & ~(ALIGN_BYTES-1); - if(bytes != nbytes) - fprintf(stderr,"Fixing unaligned allocation length %d.\n",nbytes); - nbytes = bytes; + int bytes = (nbytes + (ALIGN_BYTES - 1)) & ~(ALIGN_BYTES - 1); + + if (bytes != nbytes) + fprintf(stderr, "Fixing unaligned allocation length %d.\n", nbytes); + nbytes = bytes; #endif - if(!use_cgc_p) - { - char*current = (char*)SymbolValue(ALLOCATION_POINTER); - char*nxtfree = current + nbytes; - SetSymbolValue(ALLOCATION_POINTER, (lispobj)nxtfree); - return current; - } - else - { - /* Lacking an interrupt driven scheme to notice when a GC might - * be wise, we add some more overhead to the allocator here - * before any needed state is acquired. Only need to do it once - * though because lisp will remember *need to collect garbage* - * and get to it when it can. */ - if( auto_gc_trigger /* Only when enabled */ - && bytes_allocated > auto_gc_trigger - && !maybe_gc_called++) /* Only once */ - funcall0(SymbolFunction(MAYBE_GC)); - - if (SymbolValue(INTERRUPTS_ENABLED) == NIL) - /* Interrupts are disable so no special care is needed */ - return cgc_alloc(nbytes); - else - { - void *result; - /* Interrupts are enabled so set *interrupt-enabled* to nil - before calling cgc_alloc to prevent cgc_alloc from being - re-entered. */ - SetSymbolValue(INTERRUPTS_ENABLED, NIL); - - result = cgc_alloc(nbytes); - - /* Restore *interrupts-enabled* */ - SetSymbolValue(INTERRUPTS_ENABLED, T); - - /* Check if an interrupt occured */ - if (SymbolValue(INTERRUPT_PENDING) == T) - /* Handle any interrupts that occured during cgc_alloc */ - do_pending_interrupt(); - - return result; + if (!use_cgc_p) { + char *current = (char *) SymbolValue(ALLOCATION_POINTER); + char *nxtfree = current + nbytes; + + SetSymbolValue(ALLOCATION_POINTER, (lispobj) nxtfree); + return current; + } else { + /* Lacking an interrupt driven scheme to notice when a GC might + * be wise, we add some more overhead to the allocator here + * before any needed state is acquired. Only need to do it once + * though because lisp will remember *need to collect garbage* + * and get to it when it can. */ + if (auto_gc_trigger /* Only when enabled */ + && bytes_allocated > auto_gc_trigger && !maybe_gc_called++) /* Only once */ + funcall0(SymbolFunction(MAYBE_GC)); + + if (SymbolValue(INTERRUPTS_ENABLED) == NIL) + /* Interrupts are disable so no special care is needed */ + return cgc_alloc(nbytes); + else { + void *result; + + /* Interrupts are enabled so set *interrupt-enabled* to nil + before calling cgc_alloc to prevent cgc_alloc from being + re-entered. */ + SetSymbolValue(INTERRUPTS_ENABLED, NIL); + + result = cgc_alloc(nbytes); + + /* Restore *interrupts-enabled* */ + SetSymbolValue(INTERRUPTS_ENABLED, T); + + /* Check if an interrupt occured */ + if (SymbolValue(INTERRUPT_PENDING) == T) + /* Handle any interrupts that occured during cgc_alloc */ + do_pending_interrupt(); + + return result; } } } /* Interface to history. */ -void set_auto_gc_trigger(unsigned long dynamic_usage) +void +set_auto_gc_trigger(unsigned long dynamic_usage) { - auto_gc_trigger += dynamic_usage; + auto_gc_trigger += dynamic_usage; } -void clear_auto_gc_trigger(void) + +void +clear_auto_gc_trigger(void) { - auto_gc_trigger = 0; + auto_gc_trigger = 0; } -void gc_init(void) + +void +gc_init(void) { cgc_init_collector(); } -void collect_garbage() + +void +collect_garbage() { - /* SUB-GC wraps without-interrupt around call, but this - * is going to absolutely block SIGINT. - */ - /* #define REALLY_SAFE */ + /* SUB-GC wraps without-interrupt around call, but this + * is going to absolutely block SIGINT. + */ + /* #define REALLY_SAFE */ #if defined REALLY_SAFE - sigset_t newmask,oldmask; - sigemptyset(&newmask); - sigaddset(&newmask, SIGINT); - sigprocmask(SIG_BLOCK, &newmask, &oldmask); + sigset_t newmask, oldmask; + + sigemptyset(&newmask); + sigaddset(&newmask, SIGINT); + sigprocmask(SIG_BLOCK, &newmask, &oldmask); #endif - cgc_collect_garbage(); + cgc_collect_garbage(); #if defined REALLY_SAFE - sigprocmask(SIG_SETMASK, &oldmask, NULL); + sigprocmask(SIG_SETMASK, &oldmask, NULL); #endif } @@ -2002,74 +2098,75 @@ void collect_garbage() /* Scan an area looking for an object which encloses the given pointer. Returns the object start on success or NULL on failure. */ -static lispobj* -search_space(lispobj *start, size_t words, lispobj *pointer) -{ - while(words > 0) { - size_t count = 1; - lispobj thing = *start; - - /* If thing is an immediate then this is a cons */ - if (Pointerp(thing) - || ((thing & 3) == 0) /* fixnum */ - || (TypeOf(thing) == type_BaseChar) - || (TypeOf(thing) == type_UnboundMarker)) - count = 2; - else - count = sizeOfObject((obj_t)start); - - /* Check if the pointer is within this object? */ - if ((pointer >= start) && (pointer < (start+count))) { - /* Found it. */ - /* fprintf(stderr,"* Found %x in %x %x\n",pointer, start, thing);*/ - return(start); +static lispobj * +search_space(lispobj * start, size_t words, lispobj * pointer) +{ + while (words > 0) { + size_t count = 1; + lispobj thing = *start; + + /* If thing is an immediate then this is a cons */ + if (Pointerp(thing) + || ((thing & 3) == 0) /* fixnum */ + ||(TypeOf(thing) == type_BaseChar) + || (TypeOf(thing) == type_UnboundMarker)) + count = 2; + else + count = sizeOfObject((obj_t) start); + + /* Check if the pointer is within this object? */ + if ((pointer >= start) && (pointer < (start + count))) { + /* Found it. */ + /* fprintf(stderr,"* Found %x in %x %x\n",pointer, start, thing); */ + return (start); + } + + /* Round up the count */ + count = CEILING(count, 2); + + start += count; + words -= count; } - - /* Round up the count */ - count = CEILING(count,2); - - start += count; - words -= count; - } - return (NULL); -} - -static lispobj* -search_read_only_space(lispobj *pointer) -{ - lispobj* start = (lispobj*)READ_ONLY_SPACE_START; - lispobj* end = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER); - if ((pointer < start) || (pointer >= end)) - return NULL; - return (search_space(start, (pointer+2)-start, pointer)); + return (NULL); } -static lispobj* -search_static_space(lispobj *pointer) +static lispobj * +search_read_only_space(lispobj * pointer) { - lispobj* start = (lispobj*)STATIC_SPACE_START; - lispobj* end = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER); - if ((pointer < start) || (pointer >= end)) - return NULL; - return (search_space(start, (pointer+2)-start, pointer)); + lispobj *start = (lispobj *) READ_ONLY_SPACE_START; + lispobj *end = (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER); + + if ((pointer < start) || (pointer >= end)) + return NULL; + return (search_space(start, (pointer + 2) - start, pointer)); } -/* Find the code object for the given pc. Return NULL on failure */ -lispobj* -component_ptr_from_pc(lispobj *pc) +static lispobj * +search_static_space(lispobj * pointer) { - lispobj *object = NULL; - - if (object = search_read_only_space(pc)); - else - object = search_static_space(pc); - - /* Found anything? */ - if (object) - /* Check if it is a code object. */ - if (TypeOf(*object) == type_CodeHeader) - return(object); + lispobj *start = (lispobj *) STATIC_SPACE_START; + lispobj *end = (lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER); - return (NULL); + if ((pointer < start) || (pointer >= end)) + return NULL; + return (search_space(start, (pointer + 2) - start, pointer)); } +/* Find the code object for the given pc. Return NULL on failure */ +lispobj * +component_ptr_from_pc(lispobj * pc) +{ + lispobj *object = NULL; + + if (object = search_read_only_space(pc)); + else + object = search_static_space(pc); + + /* Found anything? */ + if (object) + /* Check if it is a code object. */ + if (TypeOf(*object) == type_CodeHeader) + return (object); + + return (NULL); +} diff --git a/lisp/cgc.h b/lisp/cgc.h index 38b6ad178..74b0fc3d4 100644 --- a/lisp/cgc.h +++ b/lisp/cgc.h @@ -7,7 +7,7 @@ #ifndef _CGC_H_ #define _CGC_H_ -void*cgc_alloc(int); +void *cgc_alloc(int); void cgc_free_heap(void); #endif /* _CGC_H_ */ diff --git a/lisp/core.h b/lisp/core.h index b156f3145..25f706767 100644 --- a/lisp/core.h +++ b/lisp/core.h @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/core.h,v 1.5 2005/01/13 19:55:00 fgilham Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/core.h,v 1.6 2005/09/15 18:26:51 rtoy Exp $ */ #ifndef _CORE_H_ #define _CORE_H_ @@ -20,17 +20,17 @@ struct ndir_entry { #if !(defined(alpha) || defined(__x86_64)) - long identifier; - long nwords; - long data_page; - long address; - long page_count; + long identifier; + long nwords; + long data_page; + long address; + long page_count; #else - u32 identifier; - u32 nwords; - u32 data_page; - u32 address; - u32 page_count; + u32 identifier; + u32 nwords; + u32 data_page; + u32 address; + u32 page_count; #endif }; diff --git a/lisp/coreparse.c b/lisp/coreparse.c index aabde7557..a498bbc52 100644 --- a/lisp/coreparse.c +++ b/lisp/coreparse.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/coreparse.c,v 1.9 2004/07/08 17:49:04 rtoy Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/coreparse.c,v 1.10 2005/09/15 18:26:51 rtoy Exp $ */ #include <stdio.h> #include <sys/types.h> #include <sys/file.h> @@ -16,7 +16,8 @@ extern int version; -static void process_directory(int fd, long *ptr, int count) +static void +process_directory(int fd, long *ptr, int count) { long id, offset, len; lispobj *free_pointer; @@ -34,50 +35,51 @@ static void process_directory(int fd, long *ptr, int count) if (len != 0) { os_vm_address_t real_addr; + #ifdef PRINTNOISE printf("Mapping %ld bytes at 0x%lx.\n", len, addr); #endif - real_addr=os_map(fd, offset, addr, len); - if(real_addr!=addr) - fprintf(stderr, - "process_directory: file mapped in wrong place! (0x%p != 0x%p)\n", - (void *) real_addr, - (void *) addr); + real_addr = os_map(fd, offset, addr, len); + if (real_addr != addr) + fprintf(stderr, + "process_directory: file mapped in wrong place! (0x%p != 0x%p)\n", + (void *) real_addr, (void *) addr); } - #if 0 printf("Space ID = %d, free pointer = 0x%08x.\n", id, free_pointer); #endif switch (id) { case DYNAMIC_SPACE_ID: - if (addr != (os_vm_address_t)dynamic_0_space - && addr != (os_vm_address_t)dynamic_1_space) - printf("Strange ... dynamic space lossage.\n"); - current_dynamic_space = (lispobj *)addr; + if (addr != (os_vm_address_t) dynamic_0_space + && addr != (os_vm_address_t) dynamic_1_space) + printf("Strange ... dynamic space lossage.\n"); + current_dynamic_space = (lispobj *) addr; #if defined(ibmrt) || defined(i386) || defined(__x86_64) - SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer); + SetSymbolValue(ALLOCATION_POINTER, (lispobj) free_pointer); #else - current_dynamic_space_free_pointer = free_pointer; + current_dynamic_space_free_pointer = free_pointer; #endif - break; + break; case STATIC_SPACE_ID: - static_space = (lispobj *) addr; - break; + static_space = (lispobj *) addr; + break; case READ_ONLY_SPACE_ID: - /* Don't care about read only space */ - break; + /* Don't care about read only space */ + break; default: - printf("Strange space ID: %ld; ignored.\n", id); - break; + printf("Strange space ID: %ld; ignored.\n", id); + break; } entry++; } } -lispobj load_core_file(char *file) +lispobj +load_core_file(char *file) { int fd = open(file, O_RDONLY), count; + #if !(defined(alpha) || defined(__x86_64)) long header[CORE_PAGESIZE / sizeof(long)], val, len, *ptr; #else @@ -99,14 +101,14 @@ lispobj load_core_file(char *file) if (count < CORE_PAGESIZE) { fprintf(stderr, "Premature EOF.\n"); exit(1); - } + } ptr = header; val = *ptr++; if (val != CORE_MAGIC) { fprintf(stderr, "Invalid magic number: 0x%lx should have been 0x%x.\n", - val, CORE_MAGIC); + val, CORE_MAGIC); exit(1); } @@ -116,39 +118,41 @@ lispobj load_core_file(char *file) switch (val) { case CORE_END: - break; + break; case CORE_VERSION: - if (*ptr != version) { - fprintf(stderr, "WARNING: startup-code version (%d) different from core version (%ld).\nYou may lose big.\n", version, *ptr); - } - break; + if (*ptr != version) { + fprintf(stderr, + "WARNING: startup-code version (%d) different from core version (%ld).\nYou may lose big.\n", + version, *ptr); + } + break; case CORE_VALIDATE: - fprintf(stderr, "Validation no longer supported; ignored.\n"); - break; + fprintf(stderr, "Validation no longer supported; ignored.\n"); + break; case CORE_NDIRECTORY: - process_directory(fd, ptr, + process_directory(fd, ptr, #if !(defined(alpha) || defined(__x86_64)) - (len-2) / (sizeof(struct ndir_entry) / sizeof(long))); + (len - 2) / (sizeof(struct ndir_entry) / sizeof(long))); #else - (len-2) / (sizeof(struct ndir_entry) / sizeof(u32))); + (len - 2) / (sizeof(struct ndir_entry) / sizeof(u32))); #endif - break; + break; case CORE_INITIAL_FUNCTION: - initial_function = (lispobj)*ptr; - break; + initial_function = (lispobj) * ptr; + break; case CORE_MACHINE_STATE: - fprintf(stderr, "Obsolete core file.\n"); - exit(1); - break; + fprintf(stderr, "Obsolete core file.\n"); + exit(1); + break; default: - printf("Unknown core file entry: %ld; skipping.\n", val); - break; + printf("Unknown core file entry: %ld; skipping.\n", val); + break; } ptr += len - 2; diff --git a/lisp/darwin-lispadjuster.c b/lisp/darwin-lispadjuster.c index 70b5fddd9..a18768a7a 100644 --- a/lisp/darwin-lispadjuster.c +++ b/lisp/darwin-lispadjuster.c @@ -12,63 +12,76 @@ #ifdef DEBUG #define dprintf printf #else -#define dprintf(...) +#define dprintf(...) #endif -int main(int argc, char** argv) +int +main(int argc, char **argv) { - char* filename; - int fd; - int i,result; - off_t curpos; - struct mach_header theheader; - struct segment_command thesegment; - char segname[17]; + char *filename; + int fd; + int i, result; + off_t curpos; + struct mach_header theheader; + struct segment_command thesegment; + char segname[17]; - if (argc != 2) - return 1; - filename = argv[1]; + if (argc != 2) + return 1; + filename = argv[1]; - fd = open(filename, O_RDWR, 0755); - read(fd,&theheader,sizeof(theheader)); + fd = open(filename, O_RDWR, 0755); + read(fd, &theheader, sizeof(theheader)); - if ((theheader.magic != MH_MAGIC) || (theheader.filetype != MH_EXECUTE)) - return 2; - - dprintf("Reading %d commands:\n",theheader.ncmds); + if ((theheader.magic != MH_MAGIC) || (theheader.filetype != MH_EXECUTE)) + return 2; - for (i=0;i<theheader.ncmds;i++) { - curpos = lseek(fd,0,SEEK_CUR); - dprintf("Reading command %d (%d bytes):\n",i,sizeof(struct load_command)); - read(fd,&thesegment,sizeof(struct load_command)); - dprintf("Command is %d, length %d\n",thesegment.cmd,thesegment.cmdsize); - if (thesegment.cmd != LC_SEGMENT) { - dprintf("Skipping remainder of command...\n"); - lseek(fd,thesegment.cmdsize - sizeof(struct load_command),SEEK_CUR); - continue; - } + dprintf("Reading %d commands:\n", theheader.ncmds); + + for (i = 0; i < theheader.ncmds; i++) { + curpos = lseek(fd, 0, SEEK_CUR); + dprintf("Reading command %d (%d bytes):\n", i, + + sizeof(struct load_command)); + read(fd, &thesegment, sizeof(struct load_command)); + + dprintf("Command is %d, length %d\n", thesegment.cmd, + thesegment.cmdsize); + if (thesegment.cmd != LC_SEGMENT) { + dprintf("Skipping remainder of command...\n"); + lseek(fd, thesegment.cmdsize - sizeof(struct load_command), + + SEEK_CUR); + continue; + } + + dprintf("Reading remainder of Segment command (%d bytes)", + sizeof(thesegment) - sizeof(struct load_command)); + read(fd, &thesegment.segname, - dprintf("Reading remainder of Segment command (%d bytes)", sizeof(thesegment)-sizeof(struct load_command)); - read(fd,&thesegment.segname,sizeof(thesegment)-sizeof(struct load_command)); - memset(segname,0,17); - memcpy(segname,thesegment.segname,16); - dprintf("Segname: %s\n",segname); - if (0==strncmp(thesegment.segname,"CMUCLRO",7)) { - dprintf("Frobbing the segment, setting vmsize from %8X to %8X\n",thesegment.vmsize,READ_ONLY_SPACE_SIZE); - thesegment.vmsize = READ_ONLY_SPACE_SIZE; - dprintf("Skipping back to %lld.\n",curpos); - lseek(fd,curpos,SEEK_SET); - dprintf("Writing %d bytes.\n",sizeof(thesegment)); - result=write(fd,&thesegment,sizeof(thesegment)); - if (result==-1) - perror("Error:"); - close(fd); - return 0; - } else { - dprintf("Cmdsize = %d, Already read = %d, Now seeking %d\n",thesegment.cmdsize, sizeof(thesegment), thesegment.cmdsize - sizeof(thesegment)); - lseek(fd,thesegment.cmdsize - sizeof(thesegment),SEEK_CUR); + sizeof(thesegment) - sizeof(struct load_command)); + memset(segname, 0, 17); + memcpy(segname, thesegment.segname, 16); + dprintf("Segname: %s\n", segname); + if (0 == strncmp(thesegment.segname, "CMUCLRO", 7)) { + dprintf("Frobbing the segment, setting vmsize from %8X to %8X\n", + thesegment.vmsize, READ_ONLY_SPACE_SIZE); + thesegment.vmsize = READ_ONLY_SPACE_SIZE; + dprintf("Skipping back to %lld.\n", curpos); + lseek(fd, curpos, SEEK_SET); + dprintf("Writing %d bytes.\n", sizeof(thesegment)); + result = write(fd, &thesegment, sizeof(thesegment)); + if (result == -1) + perror("Error:"); + close(fd); + return 0; + } else { + dprintf("Cmdsize = %d, Already read = %d, Now seeking %d\n", + thesegment.cmdsize, sizeof(thesegment), + thesegment.cmdsize - sizeof(thesegment)); + lseek(fd, thesegment.cmdsize - sizeof(thesegment), SEEK_CUR); + } } - } - close(fd); - return 3; + close(fd); + return 3; } diff --git a/lisp/dynbind.c b/lisp/dynbind.c index b1963174a..76158b262 100644 --- a/lisp/dynbind.c +++ b/lisp/dynbind.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/dynbind.c,v 1.3 2004/05/18 22:48:22 cwang Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/dynbind.c,v 1.4 2005/09/15 18:26:51 rtoy Rel $ * * Support for dynamic binding from C. */ @@ -17,39 +17,42 @@ #define SetBSP(value) (current_binding_stack_pointer=(lispobj *)(value)) #endif -void bind_variable(lispobj symbol, lispobj value) +void +bind_variable(lispobj symbol, lispobj value) { - lispobj old_value; - struct binding *binding; + lispobj old_value; + struct binding *binding; - old_value = SymbolValue(symbol); - binding = GetBSP(); - SetBSP(binding+1); + old_value = SymbolValue(symbol); + binding = GetBSP(); + SetBSP(binding + 1); - binding->value = old_value; - binding->symbol = symbol; - SetSymbolValue(symbol, value); + binding->value = old_value; + binding->symbol = symbol; + SetSymbolValue(symbol, value); } -void unbind(void) +void +unbind(void) { - struct binding *binding; - lispobj symbol; - - binding = GetBSP() - 1; - - symbol = binding->symbol; + struct binding *binding; + lispobj symbol; + + binding = GetBSP() - 1; - SetSymbolValue(symbol, binding->value); + symbol = binding->symbol; - binding->symbol = 0; + SetSymbolValue(symbol, binding->value); - SetBSP(binding); + binding->symbol = 0; + + SetBSP(binding); } -void unbind_to_here(lispobj *bsp) +void +unbind_to_here(lispobj * bsp) { - struct binding *target = (struct binding *)bsp; + struct binding *target = (struct binding *) bsp; struct binding *binding = GetBSP(); lispobj symbol; diff --git a/lisp/dynbind.h b/lisp/dynbind.h index 58641ad63..67aefb88a 100644 --- a/lisp/dynbind.h +++ b/lisp/dynbind.h @@ -1,10 +1,10 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/dynbind.h,v 1.2 2005/01/13 19:55:00 fgilham Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/dynbind.h,v 1.3 2005/09/15 18:26:51 rtoy Rel $ */ #ifndef _DYNBIND_H_ #define _DYNBIND_H_ extern void bind_variable(lispobj symbol, lispobj value); extern void unbind(void); -extern void unbind_to_here(lispobj *bsp); +extern void unbind_to_here(lispobj * bsp); #endif /* _DYNBIND_H_ */ diff --git a/lisp/elf.c b/lisp/elf.c index 4bc2d749e..9084b8ba1 100644 --- a/lisp/elf.c +++ b/lisp/elf.c @@ -20,7 +20,7 @@ #include "os.h" -static char elf_magic_string[] = {ELFMAG0, ELFMAG1, ELFMAG2, ELFMAG3}; +static char elf_magic_string[] = { ELFMAG0, ELFMAG1, ELFMAG2, ELFMAG3 }; /* Note: FreeBSD has nice macros that let you use Elf_Ehdr etc. declarations; unfortunately Linux doesn't have this so you @@ -35,53 +35,55 @@ static Elf_Ehdr eh; /* Names of the Lisp image ELF sections. These names must be the same as the corresponding names found in the linker script and the process-core utility. */ -static char *core_section_names[] = {"CORDYN", "CORSTA", "CORRO"}; +static char *core_section_names[] = { "CORDYN", "CORSTA", "CORRO" }; static void eread(int d, void *buf, size_t nbytes, const char *func) { - int res = read(d, buf, nbytes); + int res = read(d, buf, nbytes); - if (res == -1) { - perror(func); - exit(-1); - } + if (res == -1) { + perror(func); + exit(-1); + } - if (res < nbytes) { - fprintf(stderr, "Short read in %s!\n", func); - exit(-1); - } + if (res < nbytes) { + fprintf(stderr, "Short read in %s!\n", func); + exit(-1); + } } static void elseek(int d, off_t o, const char *func) { - if (lseek(d, o, SEEK_SET) == -1) { - perror(func); - exit(-1); - } + if (lseek(d, o, SEEK_SET) == -1) { + perror(func); + exit(-1); + } } /* Read the ELF header from a file descriptor and stuff it into a structure. Make sure it is really an elf header etc. */ static void -read_elf_header(int fd, Elf_Ehdr *ehp) +read_elf_header(int fd, Elf_Ehdr * ehp) { - eread(fd, ehp, sizeof(Elf_Ehdr), "read_elf_header"); + eread(fd, ehp, sizeof(Elf_Ehdr), "read_elf_header"); - if (strncmp(ehp->e_ident, elf_magic_string, 4)) { - fprintf(stderr, "Bad ELF magic number --- not an elf file. Exiting in %s.\n", "read_elf_header"); - exit(-1); - } + if (strncmp(ehp->e_ident, elf_magic_string, 4)) { + fprintf(stderr, + "Bad ELF magic number --- not an elf file. Exiting in %s.\n", + "read_elf_header"); + exit(-1); + } } static void -read_section_header_entry(int fd, Elf_Shdr *shp) +read_section_header_entry(int fd, Elf_Shdr * shp) { - eread(fd, shp, eh.e_shentsize, "read_section_header_entry"); + eread(fd, shp, eh.e_shentsize, "read_section_header_entry"); } @@ -94,60 +96,62 @@ read_section_header_entry(int fd, Elf_Shdr *shp) void map_core_sections(char *exec_name) { - int exec_fd; - Elf_Shdr sh; /* A section header entry. */ - Elf_Shdr strsecent; - char nambuf[10]; - int soff; - int strsecoff; /* File offset to string table section. */ - int sections_remaining = 3; - int i, j; - - if (!(exec_fd = open(exec_name, O_RDONLY))) { - perror("Can't open executable!"); - exit(-1); - } - - read_elf_header(exec_fd, &eh); - - /* Find the section name string section. Save its file offset. */ - soff = eh.e_shoff + eh.e_shstrndx * eh.e_shentsize; - elseek(exec_fd, soff, "map_core_sections"); - read_section_header_entry(exec_fd, &strsecent); - strsecoff = strsecent.sh_offset; - - for (i = 0; i < eh.e_shnum && sections_remaining > 0; i++) { - - /* Read an entry from the section header table. */ - elseek(exec_fd, eh.e_shoff + i * eh.e_shentsize, "map_core_sections"); - read_section_header_entry(exec_fd, &sh); - - /* Read the name from the string section. */ - elseek(exec_fd, strsecoff + sh.sh_name, "map_core_sections"); - eread(exec_fd, nambuf, 6, "map_core_sections"); - - if (sh.sh_type == SHT_PROGBITS) { - /* See if this section is one of the lisp core sections. */ - for (j = 0; j < 3; j++) { - if (!strncmp(nambuf, core_section_names[j], 6)) { - /* Found a core section. Map it! */ - if (os_map(exec_fd, sh.sh_offset, (os_vm_address_t)sh.sh_addr, sh.sh_size) == -1) { - fprintf(stderr, "Can't map section %s\n", core_section_names[j]); - exit(-1); - } - sections_remaining--; - /* Found a core section, don't check the other core section names. */ - break; + int exec_fd; + Elf_Shdr sh; /* A section header entry. */ + Elf_Shdr strsecent; + char nambuf[10]; + int soff; + int strsecoff; /* File offset to string table section. */ + int sections_remaining = 3; + int i, j; + + if (!(exec_fd = open(exec_name, O_RDONLY))) { + perror("Can't open executable!"); + exit(-1); + } + + read_elf_header(exec_fd, &eh); + + /* Find the section name string section. Save its file offset. */ + soff = eh.e_shoff + eh.e_shstrndx * eh.e_shentsize; + elseek(exec_fd, soff, "map_core_sections"); + read_section_header_entry(exec_fd, &strsecent); + strsecoff = strsecent.sh_offset; + + for (i = 0; i < eh.e_shnum && sections_remaining > 0; i++) { + + /* Read an entry from the section header table. */ + elseek(exec_fd, eh.e_shoff + i * eh.e_shentsize, "map_core_sections"); + read_section_header_entry(exec_fd, &sh); + + /* Read the name from the string section. */ + elseek(exec_fd, strsecoff + sh.sh_name, "map_core_sections"); + eread(exec_fd, nambuf, 6, "map_core_sections"); + + if (sh.sh_type == SHT_PROGBITS) { + /* See if this section is one of the lisp core sections. */ + for (j = 0; j < 3; j++) { + if (!strncmp(nambuf, core_section_names[j], 6)) { + /* Found a core section. Map it! */ + if (os_map + (exec_fd, sh.sh_offset, (os_vm_address_t) sh.sh_addr, + sh.sh_size) == -1) { + fprintf(stderr, "Can't map section %s\n", + core_section_names[j]); + exit(-1); + } + sections_remaining--; + /* Found a core section, don't check the other core section names. */ + break; + } + } } - } } - } - close(exec_fd); + close(exec_fd); - if (sections_remaining != 0) { - fprintf(stderr, "Couldn't map all core sections! Exiting!\n"); - exit(-1); - } + if (sections_remaining != 0) { + fprintf(stderr, "Couldn't map all core sections! Exiting!\n"); + exit(-1); + } } - diff --git a/lisp/gc.c b/lisp/gc.c index 5647482e0..dcb4009dc 100644 --- a/lisp/gc.c +++ b/lisp/gc.c @@ -1,7 +1,7 @@ /* * Stop and Copy GC based on Cheney's algorithm. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.c,v 1.22 2004/07/12 23:44:07 pmai Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.c,v 1.23 2005/09/15 18:26:51 rtoy Exp $ * * Written by Christopher Hoover. */ @@ -26,13 +26,13 @@ static lispobj *from_space_free_pointer; static lispobj *new_space; static lispobj *new_space_free_pointer; -static int (*scavtab[256])(lispobj *where, lispobj object); -static lispobj (*transother[256])(lispobj object); -static int (*sizetab[256])(lispobj *where); +static int (*scavtab[256]) (lispobj * where, lispobj object); +static lispobj(*transother[256]) (lispobj object); +static int (*sizetab[256]) (lispobj * where); static struct weak_pointer *weak_pointers; -static void scavenge(lispobj *start, long nwords); +static void scavenge(lispobj * start, long nwords); static void scavenge_newspace(void); static void scavenge_interrupt_contexts(void); static void scan_weak_pointers(void); @@ -49,33 +49,33 @@ static void scan_weak_pointers(void); #endif #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1))) - + /* Predicates */ #if defined(DEBUG_SPACE_PREDICATES) -boolean from_space_p(lispobj object) +boolean +from_space_p(lispobj object) { - lispobj *ptr; + lispobj *ptr; - ptr = (lispobj *) PTR(object); + ptr = (lispobj *) PTR(object); - return ((from_space <= ptr) && - (ptr < from_space_free_pointer)); -} + return ((from_space <= ptr) && (ptr < from_space_free_pointer)); +} -boolean new_space_p(lispobj object) +boolean +new_space_p(lispobj object) { - lispobj *ptr; + lispobj *ptr; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - ptr = (lispobj *) PTR(object); - - return ((new_space <= ptr) && - (ptr < new_space_free_pointer)); -} + ptr = (lispobj *) PTR(object); + + return ((new_space <= ptr) && (ptr < new_space_free_pointer)); +} #else @@ -88,49 +88,50 @@ boolean new_space_p(lispobj object) (((lispobj *) ptr) < new_space_free_pointer)) #endif - + /* Copying Objects */ static lispobj copy_object(lispobj object, int nwords) { - int tag; - lispobj *new; - lispobj *source, *dest; + int tag; + lispobj *new; + lispobj *source, *dest; - gc_assert(Pointerp(object)); - gc_assert(from_space_p(object)); - gc_assert((nwords & 0x01) == 0); + gc_assert(Pointerp(object)); + gc_assert(from_space_p(object)); + gc_assert((nwords & 0x01) == 0); - /* get tag of object */ - tag = LowtagOf(object); + /* get tag of object */ + tag = LowtagOf(object); - /* allocate space */ - new = new_space_free_pointer; - new_space_free_pointer += nwords; + /* allocate space */ + new = new_space_free_pointer; + new_space_free_pointer += nwords; - dest = new; - source = (lispobj *) PTR(object); + dest = new; + source = (lispobj *) PTR(object); - /* copy the object */ - while (nwords > 0) { - dest[0] = source[0]; - dest[1] = source[1]; - dest += 2; - source += 2; - nwords -= 2; - } + /* copy the object */ + while (nwords > 0) { + dest[0] = source[0]; + dest[1] = source[1]; + dest += 2; + source += 2; + nwords -= 2; + } - /* return lisp pointer of new object */ - return ((lispobj) new) | tag; + /* return lisp pointer of new object */ + return ((lispobj) new) | tag; } - + /* Collect Garbage */ #ifdef PRINTNOISE -static double tv_diff(struct timeval *x, struct timeval *y) +static double +tv_diff(struct timeval *x, struct timeval *y) { return (((double) x->tv_sec + (double) x->tv_usec * 1.0e-6) - ((double) y->tv_sec + (double) y->tv_usec * 1.0e-6)); @@ -139,12 +140,13 @@ static double tv_diff(struct timeval *x, struct timeval *y) #define BYTES_ZERO_BEFORE_END (1<<12) -static void zero_stack(void) +static void +zero_stack(void) { #ifndef alpha - unsigned long *ptr = (unsigned long *)current_control_stack_pointer; + unsigned long *ptr = (unsigned long *) current_control_stack_pointer; #else - u32 *ptr = (u32 *)current_control_stack_pointer; + u32 *ptr = (u32 *) current_control_stack_pointer; #endif search: do { @@ -152,9 +154,9 @@ static void zero_stack(void) goto fill; ptr++; #ifndef alpha - } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1)); + } while (((unsigned long) ptr) & (BYTES_ZERO_BEFORE_END - 1)); #else - } while (((u32)ptr) & (BYTES_ZERO_BEFORE_END-1)); + } while (((u32) ptr) & (BYTES_ZERO_BEFORE_END - 1)); #endif return; @@ -162,264 +164,263 @@ static void zero_stack(void) do { *ptr++ = 0; #ifndef alpha - } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1)); + } while (((unsigned long) ptr) & (BYTES_ZERO_BEFORE_END - 1)); #else - } while (((u32)ptr) & (BYTES_ZERO_BEFORE_END-1)); + } while (((u32) ptr) & (BYTES_ZERO_BEFORE_END - 1)); #endif goto search; } -void collect_garbage(void) +void +collect_garbage(void) { #ifdef PRINTNOISE - struct timeval start_tv, stop_tv; - struct rusage start_rusage, stop_rusage; - double real_time, system_time, user_time; - double percent_retained, gc_rate; - unsigned long size_discarded; - unsigned long size_retained; -#endif - lispobj *current_static_space_free_pointer; - unsigned long static_space_size; - unsigned long control_stack_size, binding_stack_size; + struct timeval start_tv, stop_tv; + struct rusage start_rusage, stop_rusage; + double real_time, system_time, user_time; + double percent_retained, gc_rate; + unsigned long size_discarded; + unsigned long size_retained; +#endif + lispobj *current_static_space_free_pointer; + unsigned long static_space_size; + unsigned long control_stack_size, binding_stack_size; + #ifdef POSIX_SIGS - sigset_t tmp, old; + sigset_t tmp, old; #else - int oldmask; + int oldmask; #endif - - SAVE_CONTEXT(); + + SAVE_CONTEXT(); #ifdef PRINTNOISE - printf("[Collecting garbage ... \n"); + printf("[Collecting garbage ... \n"); - getrusage(RUSAGE_SELF, &start_rusage); - gettimeofday(&start_tv, (struct timezone *) 0); + getrusage(RUSAGE_SELF, &start_rusage); + gettimeofday(&start_tv, (struct timezone *) 0); #endif #ifdef POSIX_SIGS - sigemptyset(&tmp); - FILLBLOCKSET(&tmp); - sigprocmask(SIG_BLOCK, &tmp, &old); + sigemptyset(&tmp); + FILLBLOCKSET(&tmp); + sigprocmask(SIG_BLOCK, &tmp, &old); #else - oldmask = sigblock(BLOCKABLE); + oldmask = sigblock(BLOCKABLE); #endif - current_static_space_free_pointer = - (lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER); + current_static_space_free_pointer = + (lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER); - /* Set up from space and new space pointers. */ + /* Set up from space and new space pointers. */ - from_space = current_dynamic_space; + from_space = current_dynamic_space; #ifndef ibmrt - from_space_free_pointer = current_dynamic_space_free_pointer; + from_space_free_pointer = current_dynamic_space_free_pointer; #else - from_space_free_pointer = (lispobj *)SymbolValue(ALLOCATION_POINTER); + from_space_free_pointer = (lispobj *) SymbolValue(ALLOCATION_POINTER); #endif - if (current_dynamic_space == dynamic_0_space) - new_space = dynamic_1_space; - else if (current_dynamic_space == dynamic_1_space) - new_space = dynamic_0_space; - else - lose("GC lossage. Current dynamic space is bogus!\n"); + if (current_dynamic_space == dynamic_0_space) + new_space = dynamic_1_space; + else if (current_dynamic_space == dynamic_1_space) + new_space = dynamic_0_space; + else + lose("GC lossage. Current dynamic space is bogus!\n"); - new_space_free_pointer = new_space; + new_space_free_pointer = new_space; - /* Initialize the weak pointer list. */ - weak_pointers = (struct weak_pointer *) NULL; + /* Initialize the weak pointer list. */ + weak_pointers = (struct weak_pointer *) NULL; - /* Scavenge all of the roots. */ + /* Scavenge all of the roots. */ #ifdef PRINTNOISE - printf("Scavenging interrupt contexts ...\n"); + printf("Scavenging interrupt contexts ...\n"); #endif - scavenge_interrupt_contexts(); + scavenge_interrupt_contexts(); #ifdef PRINTNOISE - printf("Scavenging interrupt handlers (%d bytes) ...\n", - sizeof(interrupt_handlers)); + printf("Scavenging interrupt handlers (%d bytes) ...\n", + sizeof(interrupt_handlers)); #endif - scavenge((lispobj *) interrupt_handlers, - sizeof(interrupt_handlers) / sizeof(lispobj)); + scavenge((lispobj *) interrupt_handlers, + sizeof(interrupt_handlers) / sizeof(lispobj)); - control_stack_size = current_control_stack_pointer - control_stack; + control_stack_size = current_control_stack_pointer - control_stack; #ifdef PRINTNOISE - printf("Scavenging the control stack (%d bytes) ...\n", - control_stack_size * sizeof(lispobj)); + printf("Scavenging the control stack (%d bytes) ...\n", + control_stack_size * sizeof(lispobj)); #endif - scavenge(control_stack, control_stack_size); + scavenge(control_stack, control_stack_size); #ifndef ibmrt - binding_stack_size = current_binding_stack_pointer - binding_stack; + binding_stack_size = current_binding_stack_pointer - binding_stack; #else - binding_stack_size = - (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack; + binding_stack_size = + (lispobj *) SymbolValue(BINDING_STACK_POINTER) - binding_stack; #endif #ifdef PRINTNOISE - printf("Scavenging the binding stack (%d bytes) ...\n", - binding_stack_size * sizeof(lispobj)); + printf("Scavenging the binding stack (%d bytes) ...\n", + binding_stack_size * sizeof(lispobj)); #endif - scavenge(binding_stack, binding_stack_size); + scavenge(binding_stack, binding_stack_size); - static_space_size = current_static_space_free_pointer - static_space; + static_space_size = current_static_space_free_pointer - static_space; #ifdef PRINTNOISE - printf("Scavenging static space (%d bytes) ...\n", - static_space_size * sizeof(lispobj)); + printf("Scavenging static space (%d bytes) ...\n", + static_space_size * sizeof(lispobj)); #endif - scavenge(static_space, static_space_size); + scavenge(static_space, static_space_size); - /* Scavenge newspace. */ + /* Scavenge newspace. */ #ifdef PRINTNOISE - printf("Scavenging new space (%d bytes) ...\n", - (new_space_free_pointer - new_space) * sizeof(lispobj)); + printf("Scavenging new space (%d bytes) ...\n", + (new_space_free_pointer - new_space) * sizeof(lispobj)); #endif - scavenge_newspace(); + scavenge_newspace(); #if defined(DEBUG_PRINT_GARBAGE) - print_garbage(from_space, from_space_free_pointer); + print_garbage(from_space, from_space_free_pointer); #endif - /* Scan the weak pointers. */ + /* Scan the weak pointers. */ #ifdef PRINTNOISE - printf("Scanning weak pointers ...\n"); + printf("Scanning weak pointers ...\n"); #endif - scan_weak_pointers(); + scan_weak_pointers(); - /* Flip spaces. */ + /* Flip spaces. */ #ifdef PRINTNOISE - printf("Flipping spaces ...\n"); + printf("Flipping spaces ...\n"); #endif - os_zero((os_vm_address_t) current_dynamic_space, - (os_vm_size_t) dynamic_space_size); + os_zero((os_vm_address_t) current_dynamic_space, + (os_vm_size_t) dynamic_space_size); - current_dynamic_space = new_space; + current_dynamic_space = new_space; #ifndef ibmrt - current_dynamic_space_free_pointer = new_space_free_pointer; + current_dynamic_space_free_pointer = new_space_free_pointer; #else - SetSymbolValue(ALLOCATION_POINTER, (lispobj)new_space_free_pointer); + SetSymbolValue(ALLOCATION_POINTER, (lispobj) new_space_free_pointer); #endif #ifdef PRINTNOISE - size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj); - size_retained = (new_space_free_pointer - new_space) * sizeof(lispobj); + size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj); + size_retained = (new_space_free_pointer - new_space) * sizeof(lispobj); #endif - /* Zero stack. */ + /* Zero stack. */ #ifdef PRINTNOISE - printf("Zeroing empty part of control stack ...\n"); + printf("Zeroing empty part of control stack ...\n"); #endif - zero_stack(); + zero_stack(); #ifdef POSIX_SIGS - sigprocmask(SIG_SETMASK, &old, 0); + sigprocmask(SIG_SETMASK, &old, 0); #else - (void) sigsetmask(oldmask); + (void) sigsetmask(oldmask); #endif #ifdef PRINTNOISE - gettimeofday(&stop_tv, (struct timezone *) 0); - getrusage(RUSAGE_SELF, &stop_rusage); + gettimeofday(&stop_tv, (struct timezone *) 0); + getrusage(RUSAGE_SELF, &stop_rusage); - printf("done.]\n"); - - percent_retained = (((float) size_retained) / - ((float) size_discarded)) * 100.0; + printf("done.]\n"); - printf("Total of %d bytes out of %d bytes retained (%3.2f%%).\n", - size_retained, size_discarded, percent_retained); + percent_retained = (((float) size_retained) / + ((float) size_discarded)) * 100.0; - real_time = tv_diff(&stop_tv, &start_tv); - user_time = tv_diff(&stop_rusage.ru_utime, &start_rusage.ru_utime); - system_time = tv_diff(&stop_rusage.ru_stime, &start_rusage.ru_stime); + printf("Total of %d bytes out of %d bytes retained (%3.2f%%).\n", + size_retained, size_discarded, percent_retained); + + real_time = tv_diff(&stop_tv, &start_tv); + user_time = tv_diff(&stop_rusage.ru_utime, &start_rusage.ru_utime); + system_time = tv_diff(&stop_rusage.ru_stime, &start_rusage.ru_stime); #if 0 - printf("Statistics:\n"); - printf("%10.2f sec of real time\n", real_time); - printf("%10.2f sec of user time,\n", user_time); - printf("%10.2f sec of system time.\n", system_time); + printf("Statistics:\n"); + printf("%10.2f sec of real time\n", real_time); + printf("%10.2f sec of user time,\n", user_time); + printf("%10.2f sec of system time.\n", system_time); #else - printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n", - real_time, user_time, system_time); -#endif + printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n", + real_time, user_time, system_time); +#endif - gc_rate = ((float) size_retained / (float) (1<<20)) / real_time; + gc_rate = ((float) size_retained / (float) (1 << 20)) / real_time; - printf("%10.2f M bytes/sec collected.\n", gc_rate); + printf("%10.2f M bytes/sec collected.\n", gc_rate); #endif } - + /* Scavenging */ #define DIRECT_SCAV 0 static void -scavenge(lispobj *start, long nwords) +scavenge(lispobj * start, long nwords) { - while (nwords > 0) { - lispobj object; - int type, words_scavenged; + while (nwords > 0) { + lispobj object; + int type, words_scavenged; - object = *start; - type = TypeOf(object); + object = *start; + type = TypeOf(object); #if defined(DEBUG_SCAVENGE_VERBOSE) - printf("Scavenging object at 0x%08x, object = 0x%08x, type = %d\n", - (unsigned long) start, (unsigned long) object, type); + printf("Scavenging object at 0x%08x, object = 0x%08x, type = %d\n", + (unsigned long) start, (unsigned long) object, type); #endif #if DIRECT_SCAV - words_scavenged = (scavtab[type])(start, object); + words_scavenged = (scavtab[type]) (start, object); #else - if (Pointerp(object)) { - /* It be a pointer. */ - if (from_space_p(object)) { - /* It currently points to old space. Check for a */ - /* forwarding pointer. */ - lispobj first_word; - - first_word = *((lispobj *)PTR(object)); - if (Pointerp(first_word) && new_space_p(first_word)) { - /* Yep, there be a forwarding pointer. */ - *start = first_word; - words_scavenged = 1; - } - else { - /* Scavenge that pointer. */ - words_scavenged = (scavtab[type])(start, object); - } - } - else { - /* It points somewhere other than oldspace. Leave */ - /* it alone. */ - words_scavenged = 1; - } - } - else if ((object & 3) == 0) { - /* It's a fixnum. Real easy. */ - words_scavenged = 1; - } - else { - /* It's some random header object. */ - words_scavenged = (scavtab[type])(start, object); - } -#endif - - start += words_scavenged; - nwords -= words_scavenged; + if (Pointerp(object)) { + /* It be a pointer. */ + if (from_space_p(object)) { + /* It currently points to old space. Check for a */ + /* forwarding pointer. */ + lispobj first_word; + + first_word = *((lispobj *) PTR(object)); + if (Pointerp(first_word) && new_space_p(first_word)) { + /* Yep, there be a forwarding pointer. */ + *start = first_word; + words_scavenged = 1; + } else { + /* Scavenge that pointer. */ + words_scavenged = (scavtab[type]) (start, object); + } + } else { + /* It points somewhere other than oldspace. Leave */ + /* it alone. */ + words_scavenged = 1; + } + } else if ((object & 3) == 0) { + /* It's a fixnum. Real easy. */ + words_scavenged = 1; + } else { + /* It's some random header object. */ + words_scavenged = (scavtab[type]) (start, object); } - gc_assert(nwords == 0); +#endif + + start += words_scavenged; + nwords -= words_scavenged; + } + gc_assert(nwords == 0); } -static void scavenge_newspace(void) +static void +scavenge_newspace(void) { lispobj *here, *next; @@ -430,156 +431,160 @@ static void scavenge_newspace(void) here = next; } } - + /* Scavenging Interrupt Contexts */ static int boxed_registers[] = BOXED_REGISTERS; -static void scavenge_interrupt_context(os_context_t *context) +static void +scavenge_interrupt_context(os_context_t * context) { - int i; + int i; + #ifdef reg_LIP - unsigned long lip; - unsigned long lip_offset; - int lip_register_pair; + unsigned long lip; + unsigned long lip_offset; + int lip_register_pair; #endif - unsigned long pc_code_offset; + unsigned long pc_code_offset; + #ifdef SC_NPC - unsigned long npc_code_offset; + unsigned long npc_code_offset; #endif - /* Find the LIP's register pair and calculate it's offset */ - /* before we scavenge the context. */ + /* Find the LIP's register pair and calculate it's offset */ + /* before we scavenge the context. */ #ifdef reg_LIP - lip = SC_REG(context, reg_LIP); - lip_offset = 0x7FFFFFFF; - lip_register_pair = -1; - for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) { - unsigned long reg; - long offset; - int index; - - index = boxed_registers[i]; - reg = SC_REG(context, index); - if (Pointerp(reg) && PTR(reg) <= lip) { - offset = lip - reg; - if (offset < lip_offset) { - lip_offset = offset; - lip_register_pair = index; - } - } + lip = SC_REG(context, reg_LIP); + lip_offset = 0x7FFFFFFF; + lip_register_pair = -1; + for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) { + unsigned long reg; + long offset; + int index; + + index = boxed_registers[i]; + reg = SC_REG(context, index); + if (Pointerp(reg) && PTR(reg) <= lip) { + offset = lip - reg; + if (offset < lip_offset) { + lip_offset = offset; + lip_register_pair = index; + } } + } #endif /* reg_LIP */ - /* Compute the PC's offset from the start of the CODE */ - /* register. */ - pc_code_offset = SC_PC(context) - SC_REG(context, reg_CODE); + /* Compute the PC's offset from the start of the CODE */ + /* register. */ + pc_code_offset = SC_PC(context) - SC_REG(context, reg_CODE); #ifdef SC_NPC - npc_code_offset = SC_NPC(context) - SC_REG(context, reg_CODE); + npc_code_offset = SC_NPC(context) - SC_REG(context, reg_CODE); #endif /* SC_NPC */ - - /* Scanvenge all boxed registers in the context. */ - for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) { - int index; - lispobj foo; - - index = boxed_registers[i]; - foo = SC_REG(context,index); - scavenge((lispobj *) &foo, 1); - SC_REG(context,index) = foo; - - scavenge((lispobj *) &(SC_REG(context, index)), 1); - } + + /* Scanvenge all boxed registers in the context. */ + for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) { + int index; + lispobj foo; + + index = boxed_registers[i]; + foo = SC_REG(context, index); + scavenge((lispobj *) & foo, 1); + SC_REG(context, index) = foo; + + scavenge((lispobj *) & (SC_REG(context, index)), 1); + } #ifdef reg_LIP - /* Fix the LIP */ - SC_REG(context, reg_LIP) = - SC_REG(context, lip_register_pair) + lip_offset; + /* Fix the LIP */ + SC_REG(context, reg_LIP) = SC_REG(context, lip_register_pair) + lip_offset; #endif /* reg_LIP */ - - /* Fix the PC if it was in from space */ - if (from_space_p(SC_PC(context))) - SC_PC(context) = SC_REG(context, reg_CODE) + pc_code_offset; + + /* Fix the PC if it was in from space */ + if (from_space_p(SC_PC(context))) + SC_PC(context) = SC_REG(context, reg_CODE) + pc_code_offset; #ifdef SC_NPC - if (from_space_p(SC_NPC(context))) - SC_NPC(context) = SC_REG(context, reg_CODE) + npc_code_offset; + if (from_space_p(SC_NPC(context))) + SC_NPC(context) = SC_REG(context, reg_CODE) + npc_code_offset; #endif /* SC_NPC */ } -void scavenge_interrupt_contexts(void) +void +scavenge_interrupt_contexts(void) { - int i, index; - os_context_t *context; + int i, index; + os_context_t *context; - index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)); + index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)); #if defined(DEBUG_PRINT_CONTEXT_INDEX) - printf("Number of active contexts: %d\n", index); + printf("Number of active contexts: %d\n", index); #endif - for (i = 0; i < index; i++) { - context = lisp_interrupt_contexts[i]; - scavenge_interrupt_context(context); - } + for (i = 0; i < index; i++) { + context = lisp_interrupt_contexts[i]; + scavenge_interrupt_context(context); + } } - + /* Debugging Code */ -void print_garbage(lispobj *from_space, lispobj *from_space_free_pointer) -{ - lispobj *start; - int total_words_not_copied; - - printf("Scanning from space ...\n"); - - total_words_not_copied = 0; - start = from_space; - while (start < from_space_free_pointer) { - lispobj object; - int forwardp, type, nwords; - lispobj header; - - object = *start; - forwardp = Pointerp(object) && new_space_p(object); - - if (forwardp) { - int tag; - lispobj *pointer; - - tag = LowtagOf(object); - - switch (tag) { - case type_ListPointer: - nwords = 2; - break; - case type_InstancePointer: - printf("Don't know about instances yet!\n"); - nwords = 1; - break; - case type_FunctionPointer: - nwords = 1; - break; - case type_OtherPointer: - pointer = (lispobj *) PTR(object); - header = *pointer; - type = TypeOf(header); - nwords = (sizetab[type])(pointer); - } - } else { - type = TypeOf(object); - nwords = (sizetab[type])(start); - total_words_not_copied += nwords; - printf("%4d words not copied at 0x%08x; ", - nwords, (unsigned long) start); - printf("Header word is 0x%08x\n", (unsigned long) object); - } - start += nwords; +void +print_garbage(lispobj * from_space, lispobj * from_space_free_pointer) +{ + lispobj *start; + int total_words_not_copied; + + printf("Scanning from space ...\n"); + + total_words_not_copied = 0; + start = from_space; + while (start < from_space_free_pointer) { + lispobj object; + int forwardp, type, nwords; + lispobj header; + + object = *start; + forwardp = Pointerp(object) && new_space_p(object); + + if (forwardp) { + int tag; + lispobj *pointer; + + tag = LowtagOf(object); + + switch (tag) { + case type_ListPointer: + nwords = 2; + break; + case type_InstancePointer: + printf("Don't know about instances yet!\n"); + nwords = 1; + break; + case type_FunctionPointer: + nwords = 1; + break; + case type_OtherPointer: + pointer = (lispobj *) PTR(object); + header = *pointer; + type = TypeOf(header); + nwords = (sizetab[type]) (pointer); + } + } else { + type = TypeOf(object); + nwords = (sizetab[type]) (start); + total_words_not_copied += nwords; + printf("%4d words not copied at 0x%08x; ", + nwords, (unsigned long) start); + printf("Header word is 0x%08x\n", (unsigned long) object); } - printf("%d total words not copied.\n", total_words_not_copied); + start += nwords; + } + printf("%d total words not copied.\n", total_words_not_copied); } - + /* Code and Code-Related Objects */ #define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer) @@ -589,241 +594,240 @@ static lispobj trans_boxed(lispobj object); #if DIRECT_SCAV static int -scav_function_pointer(lispobj *where, lispobj object) -{ - gc_assert(Pointerp(object)); - - if (from_space_p(object)) { - lispobj first, *first_pointer; - - /* object is a pointer into from space. check to see */ - /* if it has been forwarded */ - first_pointer = (lispobj *) PTR(object); - first = *first_pointer; - - if (!(Pointerp(first) && new_space_p(first))) { - int type; - lispobj copy; - - /* must transport object -- object may point */ - /* to either a function header, a closure */ - /* function header, or to a closure header. */ - - type = TypeOf(first); - switch (type) { - case type_FunctionHeader: - case type_ClosureFunctionHeader: - copy = trans_function_header(object); - break; - default: - copy = trans_boxed(object); - break; - } - - first = *first_pointer = copy; - } +scav_function_pointer(lispobj * where, lispobj object) +{ + gc_assert(Pointerp(object)); - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); + if (from_space_p(object)) { + lispobj first, *first_pointer; + + /* object is a pointer into from space. check to see */ + /* if it has been forwarded */ + first_pointer = (lispobj *) PTR(object); + first = *first_pointer; - *where = first; + if (!(Pointerp(first) && new_space_p(first))) { + int type; + lispobj copy; + + /* must transport object -- object may point */ + /* to either a function header, a closure */ + /* function header, or to a closure header. */ + + type = TypeOf(first); + switch (type) { + case type_FunctionHeader: + case type_ClosureFunctionHeader: + copy = trans_function_header(object); + break; + default: + copy = trans_boxed(object); + break; + } + + first = *first_pointer = copy; } - return 1; + + gc_assert(Pointerp(first)); + gc_assert(!from_space_p(first)); + + *where = first; + } + return 1; } #else static int -scav_function_pointer(lispobj *where, lispobj object) -{ - lispobj *first_pointer; - lispobj copy; - lispobj first; - int type; - - gc_assert(Pointerp(object)); - - /* object is a pointer into from space. Not a FP */ - first_pointer = (lispobj *) PTR(object); - first = *first_pointer; - - /* must transport object -- object may point */ - /* to either a function header, a closure */ - /* function header, or to a closure header. */ - - type = TypeOf(first); - switch (type) { - case type_FunctionHeader: - case type_ClosureFunctionHeader: - copy = trans_function_header(object); - break; - default: - copy = trans_boxed(object); - break; - } - - first = *first_pointer = copy; - - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); - - *where = first; - return 1; +scav_function_pointer(lispobj * where, lispobj object) +{ + lispobj *first_pointer; + lispobj copy; + lispobj first; + int type; + + gc_assert(Pointerp(object)); + + /* object is a pointer into from space. Not a FP */ + first_pointer = (lispobj *) PTR(object); + first = *first_pointer; + + /* must transport object -- object may point */ + /* to either a function header, a closure */ + /* function header, or to a closure header. */ + + type = TypeOf(first); + switch (type) { + case type_FunctionHeader: + case type_ClosureFunctionHeader: + copy = trans_function_header(object); + break; + default: + copy = trans_boxed(object); + break; + } + + first = *first_pointer = copy; + + gc_assert(Pointerp(first)); + gc_assert(!from_space_p(first)); + + *where = first; + return 1; } #endif static struct code * trans_code(struct code *code) { - struct code *new_code; - lispobj first, l_code, l_new_code; - int nheader_words, ncode_words, nwords; - unsigned long displacement; - lispobj fheaderl, *prev_pointer; + struct code *new_code; + lispobj first, l_code, l_new_code; + int nheader_words, ncode_words, nwords; + unsigned long displacement; + lispobj fheaderl, *prev_pointer; #if defined(DEBUG_CODE_GC) - printf("\nTransporting code object located at 0x%08x.\n", - (unsigned long) code); + printf("\nTransporting code object located at 0x%08x.\n", + (unsigned long) code); #endif - /* if object has already been transported, just return pointer */ - first = code->header; - if (Pointerp(first) && new_space_p(first)) - return (struct code *) PTR(first); - - gc_assert(TypeOf(first) == type_CodeHeader); + /* if object has already been transported, just return pointer */ + first = code->header; + if (Pointerp(first) && new_space_p(first)) + return (struct code *) PTR(first); + + gc_assert(TypeOf(first) == type_CodeHeader); - /* prepare to transport the code vector */ - l_code = (lispobj) code | type_OtherPointer; + /* prepare to transport the code vector */ + l_code = (lispobj) code | type_OtherPointer; - ncode_words = fixnum_value(code->code_size); - nheader_words = HeaderValue(code->header); - nwords = ncode_words + nheader_words; - nwords = CEILING(nwords, 2); + ncode_words = fixnum_value(code->code_size); + nheader_words = HeaderValue(code->header); + nwords = ncode_words + nheader_words; + nwords = CEILING(nwords, 2); - l_new_code = copy_object(l_code, nwords); - new_code = (struct code *) PTR(l_new_code); + l_new_code = copy_object(l_code, nwords); + new_code = (struct code *) PTR(l_new_code); - displacement = l_new_code - l_code; + displacement = l_new_code - l_code; #if defined(DEBUG_CODE_GC) - printf("Old code object at 0x%08x, new code object at 0x%08x.\n", - (unsigned long) code, (unsigned long) new_code); - printf("Code object is %d words long.\n", nwords); + printf("Old code object at 0x%08x, new code object at 0x%08x.\n", + (unsigned long) code, (unsigned long) new_code); + printf("Code object is %d words long.\n", nwords); #endif + /* set forwarding pointer */ + code->header = l_new_code; + + /* set forwarding pointers for all the function headers in the */ + /* code object. also fix all self pointers */ + + fheaderl = code->entry_points; + prev_pointer = &new_code->entry_points; + + while (fheaderl != NIL) { + struct function *fheaderp, *nfheaderp; + lispobj nfheaderl; + + fheaderp = (struct function *) PTR(fheaderl); + gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); + + /* calcuate the new function pointer and the new */ + /* function header */ + nfheaderl = fheaderl + displacement; + nfheaderp = (struct function *) PTR(nfheaderl); + /* set forwarding pointer */ - code->header = l_new_code; - - /* set forwarding pointers for all the function headers in the */ - /* code object. also fix all self pointers */ - - fheaderl = code->entry_points; - prev_pointer = &new_code->entry_points; - - while (fheaderl != NIL) { - struct function *fheaderp, *nfheaderp; - lispobj nfheaderl; - - fheaderp = (struct function *) PTR(fheaderl); - gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); - - /* calcuate the new function pointer and the new */ - /* function header */ - nfheaderl = fheaderl + displacement; - nfheaderp = (struct function *) PTR(nfheaderl); - - /* set forwarding pointer */ - fheaderp->header = nfheaderl; - - /* fix self pointer */ - nfheaderp->self = nfheaderl; - - *prev_pointer = nfheaderl; - - fheaderl = fheaderp->next; - prev_pointer = &nfheaderp->next; - } + fheaderp->header = nfheaderl; + + /* fix self pointer */ + nfheaderp->self = nfheaderl; + + *prev_pointer = nfheaderl; + + fheaderl = fheaderp->next; + prev_pointer = &nfheaderp->next; + } #ifndef MACH - os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words), - ncode_words * sizeof(int)); + os_flush_icache((os_vm_address_t) (((int *) new_code) + nheader_words), + ncode_words * sizeof(int)); #endif - return new_code; + return new_code; } static int -scav_code_header(lispobj *where, lispobj object) +scav_code_header(lispobj * where, lispobj object) { - struct code *code; - int nheader_words, ncode_words, nwords; - lispobj fheaderl; - struct function *fheaderp; + struct code *code; + int nheader_words, ncode_words, nwords; + lispobj fheaderl; + struct function *fheaderp; - code = (struct code *) where; - ncode_words = fixnum_value(code->code_size); - nheader_words = HeaderValue(object); - nwords = ncode_words + nheader_words; - nwords = CEILING(nwords, 2); + code = (struct code *) where; + ncode_words = fixnum_value(code->code_size); + nheader_words = HeaderValue(object); + nwords = ncode_words + nheader_words; + nwords = CEILING(nwords, 2); #if defined(DEBUG_CODE_GC) - printf("\nScavening code object at 0x%08x.\n", - (unsigned long) where); - printf("Code object is %d words long.\n", nwords); - printf("Scavenging boxed section of code data block (%d words).\n", - nheader_words - 1); -#endif - - /* Scavenge the boxed section of the code data block */ - scavenge(where + 1, nheader_words - 1); - - /* Scavenge the boxed section of each function object in the */ - /* code data block */ - fheaderl = code->entry_points; - while (fheaderl != NIL) { - fheaderp = (struct function *) PTR(fheaderl); - gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); - + printf("\nScavening code object at 0x%08x.\n", (unsigned long) where); + printf("Code object is %d words long.\n", nwords); + printf("Scavenging boxed section of code data block (%d words).\n", + nheader_words - 1); +#endif + + /* Scavenge the boxed section of the code data block */ + scavenge(where + 1, nheader_words - 1); + + /* Scavenge the boxed section of each function object in the */ + /* code data block */ + fheaderl = code->entry_points; + while (fheaderl != NIL) { + fheaderp = (struct function *) PTR(fheaderl); + gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); + #if defined(DEBUG_CODE_GC) - printf("Scavenging boxed section of entry point located at 0x%08x.\n", - (unsigned long) PTR(fheaderl)); -#endif - scavenge(&fheaderp->name, 1); - scavenge(&fheaderp->arglist, 1); - scavenge(&fheaderp->type, 1); - - fheaderl = fheaderp->next; - } - - return nwords; + printf("Scavenging boxed section of entry point located at 0x%08x.\n", + (unsigned long) PTR(fheaderl)); +#endif + scavenge(&fheaderp->name, 1); + scavenge(&fheaderp->arglist, 1); + scavenge(&fheaderp->type, 1); + + fheaderl = fheaderp->next; + } + + return nwords; } static lispobj trans_code_header(lispobj object) { - struct code *ncode; + struct code *ncode; - ncode = trans_code((struct code *) PTR(object)); - return (lispobj) ncode | type_OtherPointer; + ncode = trans_code((struct code *) PTR(object)); + return (lispobj) ncode | type_OtherPointer; } static int -size_code_header(lispobj *where) +size_code_header(lispobj * where) { - struct code *code; - int nheader_words, ncode_words, nwords; + struct code *code; + int nheader_words, ncode_words, nwords; + + code = (struct code *) where; - code = (struct code *) where; - - ncode_words = fixnum_value(code->code_size); - nheader_words = HeaderValue(code->header); - nwords = ncode_words + nheader_words; - nwords = CEILING(nwords, 2); + ncode_words = fixnum_value(code->code_size); + nheader_words = HeaderValue(code->header); + nwords = ncode_words + nheader_words; + nwords = CEILING(nwords, 2); - return nwords; + return nwords; } static int -scav_return_pc_header(lispobj *where, lispobj object) +scav_return_pc_header(lispobj * where, lispobj object) { fprintf(stderr, "GC lossage. Should not be scavenging a "); fprintf(stderr, "Return PC Header.\n"); @@ -836,18 +840,18 @@ scav_return_pc_header(lispobj *where, lispobj object) static lispobj trans_return_pc_header(lispobj object) { - struct function *return_pc; - unsigned long offset; - struct code *code, *ncode; - - return_pc = (struct function *) PTR(object); - offset = HeaderValue(return_pc->header) * 4; + struct function *return_pc; + unsigned long offset; + struct code *code, *ncode; + + return_pc = (struct function *) PTR(object); + offset = HeaderValue(return_pc->header) * 4; - /* Transport the whole code object */ - code = (struct code *) ((unsigned long) return_pc - offset); - ncode = trans_code(code); + /* Transport the whole code object */ + code = (struct code *) ((unsigned long) return_pc - offset); + ncode = trans_code(code); - return ((lispobj) ncode + offset) | type_OtherPointer; + return ((lispobj) ncode + offset) | type_OtherPointer; } /* On the 386, closures hold a pointer to the raw address instead of the @@ -858,21 +862,21 @@ trans_return_pc_header(lispobj object) #ifdef i386 static scav_closure_header(where, object) -lispobj *where, object; + lispobj *where, object; { - struct closure *closure; - lispobj fun; + struct closure *closure; + lispobj fun; - closure = (struct closure *)where; - fun = closure->function - RAW_ADDR_OFFSET; - scavenge(&fun, 1); + closure = (struct closure *) where; + fun = closure->function - RAW_ADDR_OFFSET; + scavenge(&fun, 1); - return 2; + return 2; } #endif static int -scav_function_header(lispobj *where, lispobj object) +scav_function_header(lispobj * where, lispobj object) { fprintf(stderr, "GC lossage. Should not be scavenging a "); fprintf(stderr, "Function Header.\n"); @@ -885,27 +889,27 @@ scav_function_header(lispobj *where, lispobj object) static lispobj trans_function_header(lispobj object) { - struct function *fheader; - unsigned long offset; - struct code *code, *ncode; - - fheader = (struct function *) PTR(object); - offset = HeaderValue(fheader->header) * 4; + struct function *fheader; + unsigned long offset; + struct code *code, *ncode; - /* Transport the whole code object */ - code = (struct code *) ((unsigned long) fheader - offset); - ncode = trans_code(code); + fheader = (struct function *) PTR(object); + offset = HeaderValue(fheader->header) * 4; - return ((lispobj) ncode + offset) | type_FunctionPointer; + /* Transport the whole code object */ + code = (struct code *) ((unsigned long) fheader - offset); + ncode = trans_code(code); + + return ((lispobj) ncode + offset) | type_FunctionPointer; } + - /* Instances */ #if DIRECT_SCAV static int -scav_instance_pointer(lispobj *where, lispobj object) +scav_instance_pointer(lispobj * where, lispobj object) { if (from_space_p(object)) { lispobj first, *first_pointer; @@ -914,7 +918,7 @@ scav_instance_pointer(lispobj *where, lispobj object) /* if it has been forwarded */ first_pointer = (lispobj *) PTR(object); first = *first_pointer; - + if (!(Pointerp(first) && new_space_p(first))) first = *first_pointer = trans_boxed(object); *where = first; @@ -923,178 +927,176 @@ scav_instance_pointer(lispobj *where, lispobj object) } #else static int -scav_instance_pointer(lispobj *where, lispobj object) +scav_instance_pointer(lispobj * where, lispobj object) { - lispobj *first_pointer; - - /* object is a pointer into from space. Not a FP */ - first_pointer = (lispobj *) PTR(object); - - *where = *first_pointer = trans_boxed(object); - return 1; + lispobj *first_pointer; + + /* object is a pointer into from space. Not a FP */ + first_pointer = (lispobj *) PTR(object); + + *where = *first_pointer = trans_boxed(object); + return 1; } #endif - + /* Lists and Conses */ static lispobj trans_list(lispobj object); #if DIRECT_SCAV static int -scav_list_pointer(lispobj *where, lispobj object) +scav_list_pointer(lispobj * where, lispobj object) { - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); + + if (from_space_p(object)) { + lispobj first, *first_pointer; - if (from_space_p(object)) { - lispobj first, *first_pointer; + /* object is a pointer into from space. check to see */ + /* if it has been forwarded */ + first_pointer = (lispobj *) PTR(object); + first = *first_pointer; - /* object is a pointer into from space. check to see */ - /* if it has been forwarded */ - first_pointer = (lispobj *) PTR(object); - first = *first_pointer; - - if (!(Pointerp(first) && new_space_p(first))) - first = *first_pointer = trans_list(object); + if (!(Pointerp(first) && new_space_p(first))) + first = *first_pointer = trans_list(object); - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); - - *where = first; - } - return 1; + gc_assert(Pointerp(first)); + gc_assert(!from_space_p(first)); + + *where = first; + } + return 1; } #else static int -scav_list_pointer(lispobj *where, lispobj object) +scav_list_pointer(lispobj * where, lispobj object) { - lispobj first, *first_pointer; + lispobj first, *first_pointer; + + gc_assert(Pointerp(object)); - gc_assert(Pointerp(object)); + /* object is a pointer into from space. Not a FP. */ + first_pointer = (lispobj *) PTR(object); - /* object is a pointer into from space. Not a FP. */ - first_pointer = (lispobj *) PTR(object); - - first = *first_pointer = trans_list(object); - - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); - - *where = first; - return 1; + first = *first_pointer = trans_list(object); + + gc_assert(Pointerp(first)); + gc_assert(!from_space_p(first)); + + *where = first; + return 1; } #endif static lispobj trans_list(lispobj object) { - lispobj new_list_pointer; - struct cons *cons, *new_cons; - - cons = (struct cons *) PTR(object); - - /* ### Don't use copy_object here. */ - new_list_pointer = copy_object(object, 2); - new_cons = (struct cons *) PTR(new_list_pointer); - - /* Set forwarding pointer. */ - cons->car = new_list_pointer; - - /* Try to linearize the list in the cdr direction to help reduce */ - /* paging. */ - - while (1) { - lispobj cdr, new_cdr, first; - struct cons *cdr_cons, *new_cdr_cons; - - cdr = cons->cdr; - - if (LowtagOf(cdr) != type_ListPointer || - !from_space_p(cdr) || - (Pointerp(first = *(lispobj *)PTR(cdr)) && - new_space_p(first))) - break; - - cdr_cons = (struct cons *) PTR(cdr); - - /* ### Don't use copy_object here */ - new_cdr = copy_object(cdr, 2); - new_cdr_cons = (struct cons *) PTR(new_cdr); - - /* Set forwarding pointer */ - cdr_cons->car = new_cdr; - - /* Update the cdr of the last cons copied into new */ - /* space to keep the newspace scavenge from having to */ - /* do it. */ - new_cons->cdr = new_cdr; - - cons = cdr_cons; - new_cons = new_cdr_cons; - } + lispobj new_list_pointer; + struct cons *cons, *new_cons; - return new_list_pointer; -} + cons = (struct cons *) PTR(object); + + /* ### Don't use copy_object here. */ + new_list_pointer = copy_object(object, 2); + new_cons = (struct cons *) PTR(new_list_pointer); + + /* Set forwarding pointer. */ + cons->car = new_list_pointer; + + /* Try to linearize the list in the cdr direction to help reduce */ + /* paging. */ + + while (1) { + lispobj cdr, new_cdr, first; + struct cons *cdr_cons, *new_cdr_cons; + + cdr = cons->cdr; + + if (LowtagOf(cdr) != type_ListPointer || + !from_space_p(cdr) || + (Pointerp(first = *(lispobj *) PTR(cdr)) && new_space_p(first))) + break; + + cdr_cons = (struct cons *) PTR(cdr); + /* ### Don't use copy_object here */ + new_cdr = copy_object(cdr, 2); + new_cdr_cons = (struct cons *) PTR(new_cdr); + + /* Set forwarding pointer */ + cdr_cons->car = new_cdr; + + /* Update the cdr of the last cons copied into new */ + /* space to keep the newspace scavenge from having to */ + /* do it. */ + new_cons->cdr = new_cdr; + + cons = cdr_cons; + new_cons = new_cdr_cons; + } + + return new_list_pointer; +} + /* Scavenging and Transporting Other Pointers */ #if DIRECT_SCAV static int -scav_other_pointer(lispobj *where, lispobj object) +scav_other_pointer(lispobj * where, lispobj object) { - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); + + if (from_space_p(object)) { + lispobj first, *first_pointer; - if (from_space_p(object)) { - lispobj first, *first_pointer; + /* object is a pointer into from space. check to see */ + /* if it has been forwarded */ + first_pointer = (lispobj *) PTR(object); + first = *first_pointer; - /* object is a pointer into from space. check to see */ - /* if it has been forwarded */ - first_pointer = (lispobj *) PTR(object); - first = *first_pointer; - - if (!(Pointerp(first) && new_space_p(first))) - first = *first_pointer = - (transother[TypeOf(first)])(object); + if (!(Pointerp(first) && new_space_p(first))) + first = *first_pointer = (transother[TypeOf(first)]) (object); - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); + gc_assert(Pointerp(first)); + gc_assert(!from_space_p(first)); - *where = first; - } - return 1; + *where = first; + } + return 1; } #else static int -scav_other_pointer(lispobj *where, lispobj object) +scav_other_pointer(lispobj * where, lispobj object) { - lispobj first, *first_pointer; + lispobj first, *first_pointer; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - /* Object is a pointer into from space - not a FP */ - first_pointer = (lispobj *) PTR(object); - first = *first_pointer = (transother[TypeOf(*first_pointer)])(object); + /* Object is a pointer into from space - not a FP */ + first_pointer = (lispobj *) PTR(object); + first = *first_pointer = (transother[TypeOf(*first_pointer)]) (object); - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); + gc_assert(Pointerp(first)); + gc_assert(!from_space_p(first)); - *where = first; - return 1; + *where = first; + return 1; } #endif - + /* Immediate, Boxed, and Unboxed Objects */ static int -size_pointer(lispobj *where) +size_pointer(lispobj * where) { return 1; } static int -scav_immediate(lispobj *where, lispobj object) +scav_immediate(lispobj * where, lispobj object) { return 1; } @@ -1108,14 +1110,14 @@ trans_immediate(lispobj object) } static int -size_immediate(lispobj *where) +size_immediate(lispobj * where) { return 1; } static int -scav_boxed(lispobj *where, lispobj object) +scav_boxed(lispobj * where, lispobj object) { return 1; } @@ -1123,151 +1125,151 @@ scav_boxed(lispobj *where, lispobj object) static lispobj trans_boxed(lispobj object) { - lispobj header; - unsigned long length; + lispobj header; + unsigned long length; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - header = *((lispobj *) PTR(object)); - length = HeaderValue(header) + 1; - length = CEILING(length, 2); + header = *((lispobj *) PTR(object)); + length = HeaderValue(header) + 1; + length = CEILING(length, 2); - return copy_object(object, length); + return copy_object(object, length); } static int -size_boxed(lispobj *where) +size_boxed(lispobj * where) { - lispobj header; - unsigned long length; + lispobj header; + unsigned long length; - header = *where; - length = HeaderValue(header) + 1; - length = CEILING(length, 2); + header = *where; + length = HeaderValue(header) + 1; + length = CEILING(length, 2); - return length; + return length; } /* Note: on the sparc we don't have to do anything special for fdefns, */ /* cause the raw-addr has a function lowtag. */ #ifndef sparc static int -scav_fdefn(lispobj *where, lispobj object) +scav_fdefn(lispobj * where, lispobj object) { struct fdefn *fdefn; - fdefn = (struct fdefn *)where; - - if ((char *)(fdefn->function + RAW_ADDR_OFFSET) == fdefn->raw_addr) { - scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1); - fdefn->raw_addr = (char *)(fdefn->function + RAW_ADDR_OFFSET); - return sizeof(struct fdefn) / sizeof(lispobj); - } - else - return 1; + fdefn = (struct fdefn *) where; + + if ((char *) (fdefn->function + RAW_ADDR_OFFSET) == fdefn->raw_addr) { + scavenge(where + 1, sizeof(struct fdefn) / sizeof(lispobj) - 1); + + fdefn->raw_addr = (char *) (fdefn->function + RAW_ADDR_OFFSET); + return sizeof(struct fdefn) / sizeof(lispobj); + } else + return 1; } #endif static int -scav_unboxed(lispobj *where, lispobj object) +scav_unboxed(lispobj * where, lispobj object) { - unsigned long length; + unsigned long length; - length = HeaderValue(object) + 1; - length = CEILING(length, 2); + length = HeaderValue(object) + 1; + length = CEILING(length, 2); - return length; + return length; } static lispobj trans_unboxed(lispobj object) { - lispobj header; - unsigned long length; + lispobj header; + unsigned long length; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - header = *((lispobj *) PTR(object)); - length = HeaderValue(header) + 1; - length = CEILING(length, 2); + header = *((lispobj *) PTR(object)); + length = HeaderValue(header) + 1; + length = CEILING(length, 2); - return copy_object(object, length); + return copy_object(object, length); } static int -size_unboxed(lispobj *where) +size_unboxed(lispobj * where) { - lispobj header; - unsigned long length; + lispobj header; + unsigned long length; - header = *where; - length = HeaderValue(header) + 1; - length = CEILING(length, 2); + header = *where; + length = HeaderValue(header) + 1; + length = CEILING(length, 2); - return length; + return length; } - + /* Vector-Like Objects */ #define NWORDS(x,y) (CEILING((x),(y)) / (y)) static int -scav_string(lispobj *where, lispobj object) +scav_string(lispobj * where, lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - /* NOTE: Strings contain one more byte of data than the length */ - /* slot indicates. */ + /* NOTE: Strings contain one more byte of data than the length */ + /* slot indicates. */ - vector = (struct vector *) where; - length = fixnum_value(vector->length) + 1; - nwords = CEILING(NWORDS(length, 4) + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length) + 1; + nwords = CEILING(NWORDS(length, 4) + 2, 2); - return nwords; + return nwords; } static lispobj trans_string(lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - /* NOTE: Strings contain one more byte of data than the length */ - /* slot indicates. */ + /* NOTE: Strings contain one more byte of data than the length */ + /* slot indicates. */ - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length) + 1; - nwords = CEILING(NWORDS(length, 4) + 2, 2); + vector = (struct vector *) PTR(object); + length = fixnum_value(vector->length) + 1; + nwords = CEILING(NWORDS(length, 4) + 2, 2); - return copy_object(object, nwords); + return copy_object(object, nwords); } static int -size_string(lispobj *where) +size_string(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - /* NOTE: Strings contain one more byte of data than the length */ - /* slot indicates. */ + /* NOTE: Strings contain one more byte of data than the length */ + /* slot indicates. */ - vector = (struct vector *) where; - length = fixnum_value(vector->length) + 1; - nwords = CEILING(NWORDS(length, 4) + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length) + 1; + nwords = CEILING(NWORDS(length, 4) + 2, 2); - return nwords; + return nwords; } static int -scav_vector(lispobj *where, lispobj object) +scav_vector(lispobj * where, lispobj object) { if (HeaderValue(object) == subtype_VectorValidHashing) - *where = (subtype_VectorMustRehash<<type_Bits) | type_SimpleVector; + *where = (subtype_VectorMustRehash << type_Bits) | type_SimpleVector; return 1; } @@ -1276,648 +1278,648 @@ scav_vector(lispobj *where, lispobj object) static lispobj trans_vector(lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - vector = (struct vector *) PTR(object); + vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + length = fixnum_value(vector->length); + nwords = CEILING(length + 2, 2); - return copy_object(object, nwords); + return copy_object(object, nwords); } static int -size_vector(lispobj *where) +size_vector(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(length + 2, 2); - return nwords; + return nwords; } static int -scav_vector_bit(lispobj *where, lispobj object) +scav_vector_bit(lispobj * where, lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 32) + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 32) + 2, 2); - return nwords; + return nwords; } static lispobj trans_vector_bit(lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 32) + 2, 2); + vector = (struct vector *) PTR(object); + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 32) + 2, 2); - return copy_object(object, nwords); + return copy_object(object, nwords); } static int -size_vector_bit(lispobj *where) +size_vector_bit(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 32) + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 32) + 2, 2); - return nwords; + return nwords; } static int -scav_vector_unsigned_byte_2(lispobj *where, lispobj object) +scav_vector_unsigned_byte_2(lispobj * where, lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 16) + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 16) + 2, 2); - return nwords; + return nwords; } static lispobj trans_vector_unsigned_byte_2(lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 16) + 2, 2); + vector = (struct vector *) PTR(object); + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 16) + 2, 2); - return copy_object(object, nwords); + return copy_object(object, nwords); } static int -size_vector_unsigned_byte_2(lispobj *where) +size_vector_unsigned_byte_2(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 16) + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 16) + 2, 2); - return nwords; + return nwords; } static int -scav_vector_unsigned_byte_4(lispobj *where, lispobj object) +scav_vector_unsigned_byte_4(lispobj * where, lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 8) + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 8) + 2, 2); - return nwords; + return nwords; } static lispobj trans_vector_unsigned_byte_4(lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 8) + 2, 2); + vector = (struct vector *) PTR(object); + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 8) + 2, 2); - return copy_object(object, nwords); + return copy_object(object, nwords); } static int -size_vector_unsigned_byte_4(lispobj *where) +size_vector_unsigned_byte_4(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 8) + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 8) + 2, 2); - return nwords; + return nwords; } static int -scav_vector_unsigned_byte_8(lispobj *where, lispobj object) +scav_vector_unsigned_byte_8(lispobj * where, lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 4) + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 4) + 2, 2); - return nwords; + return nwords; } static lispobj trans_vector_unsigned_byte_8(lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 4) + 2, 2); + vector = (struct vector *) PTR(object); + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 4) + 2, 2); - return copy_object(object, nwords); + return copy_object(object, nwords); } static int -size_vector_unsigned_byte_8(lispobj *where) +size_vector_unsigned_byte_8(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 4) + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 4) + 2, 2); - return nwords; + return nwords; } static int -scav_vector_unsigned_byte_16(lispobj *where, lispobj object) +scav_vector_unsigned_byte_16(lispobj * where, lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 2) + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 2) + 2, 2); - return nwords; + return nwords; } static lispobj trans_vector_unsigned_byte_16(lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 2) + 2, 2); + vector = (struct vector *) PTR(object); + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 2) + 2, 2); - return copy_object(object, nwords); + return copy_object(object, nwords); } static int -size_vector_unsigned_byte_16(lispobj *where) +size_vector_unsigned_byte_16(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 2) + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(NWORDS(length, 2) + 2, 2); - return nwords; + return nwords; } static int -scav_vector_unsigned_byte_32(lispobj *where, lispobj object) +scav_vector_unsigned_byte_32(lispobj * where, lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(length + 2, 2); - return nwords; + return nwords; } static lispobj trans_vector_unsigned_byte_32(lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + vector = (struct vector *) PTR(object); + length = fixnum_value(vector->length); + nwords = CEILING(length + 2, 2); - return copy_object(object, nwords); + return copy_object(object, nwords); } static int -size_vector_unsigned_byte_32(lispobj *where) +size_vector_unsigned_byte_32(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(length + 2, 2); - return nwords; + return nwords; } static int -scav_vector_single_float(lispobj *where, lispobj object) +scav_vector_single_float(lispobj * where, lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(length + 2, 2); - return nwords; + return nwords; } static lispobj trans_vector_single_float(lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + vector = (struct vector *) PTR(object); + length = fixnum_value(vector->length); + nwords = CEILING(length + 2, 2); - return copy_object(object, nwords); + return copy_object(object, nwords); } static int -size_vector_single_float(lispobj *where) +size_vector_single_float(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(length + 2, 2); - return nwords; + return nwords; } static int -scav_vector_double_float(lispobj *where, lispobj object) +scav_vector_double_float(lispobj * where, lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(length * 2 + 2, 2); - return nwords; + return nwords; } static lispobj trans_vector_double_float(lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); + vector = (struct vector *) PTR(object); + length = fixnum_value(vector->length); + nwords = CEILING(length * 2 + 2, 2); - return copy_object(object, nwords); + return copy_object(object, nwords); } static int -size_vector_double_float(lispobj *where) +size_vector_double_float(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(length * 2 + 2, 2); - return nwords; + return nwords; } #ifdef type_SimpleArrayLongFloat static int -scav_vector_long_float(lispobj *where, lispobj object) +scav_vector_long_float(lispobj * where, lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef sparc - nwords = CEILING(length * 4 + 2, 2); + nwords = CEILING(length * 4 + 2, 2); #endif - return nwords; + return nwords; } static lispobj trans_vector_long_float(lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); + vector = (struct vector *) PTR(object); + length = fixnum_value(vector->length); #ifdef sparc - nwords = CEILING(length * 4 + 2, 2); + nwords = CEILING(length * 4 + 2, 2); #endif - return copy_object(object, nwords); + return copy_object(object, nwords); } static int -size_vector_long_float(lispobj *where) +size_vector_long_float(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef sparc - nwords = CEILING(length * 4 + 2, 2); + nwords = CEILING(length * 4 + 2, 2); #endif - return nwords; + return nwords; } #endif #ifdef type_SimpleArrayComplexSingleFloat static int -scav_vector_complex_single_float(lispobj *where, lispobj object) +scav_vector_complex_single_float(lispobj * where, lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(length * 2 + 2, 2); - return nwords; + return nwords; } static lispobj trans_vector_complex_single_float(lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); + vector = (struct vector *) PTR(object); + length = fixnum_value(vector->length); + nwords = CEILING(length * 2 + 2, 2); - return copy_object(object, nwords); + return copy_object(object, nwords); } static int -size_vector_complex_single_float(lispobj *where) +size_vector_complex_single_float(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(length * 2 + 2, 2); - return nwords; + return nwords; } #endif #ifdef type_SimpleArrayComplexDoubleFloat static int -scav_vector_complex_double_float(lispobj *where, lispobj object) +scav_vector_complex_double_float(lispobj * where, lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 4 + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(length * 4 + 2, 2); - return nwords; + return nwords; } static lispobj trans_vector_complex_double_float(lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(length * 4 + 2, 2); + vector = (struct vector *) PTR(object); + length = fixnum_value(vector->length); + nwords = CEILING(length * 4 + 2, 2); - return copy_object(object, nwords); + return copy_object(object, nwords); } static int -size_vector_complex_double_float(lispobj *where) +size_vector_complex_double_float(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length * 4 + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(length * 4 + 2, 2); - return nwords; + return nwords; } #endif #ifdef type_SimpleArrayComplexLongFloat static int -scav_vector_complex_long_float(lispobj *where, lispobj object) +scav_vector_complex_long_float(lispobj * where, lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef sparc - nwords = CEILING(length * 8 + 2, 2); + nwords = CEILING(length * 8 + 2, 2); #endif - return nwords; + return nwords; } static lispobj trans_vector_complex_long_float(lispobj object) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); + vector = (struct vector *) PTR(object); + length = fixnum_value(vector->length); #ifdef sparc - nwords = CEILING(length * 8 + 2, 2); + nwords = CEILING(length * 8 + 2, 2); #endif - return copy_object(object, nwords); + return copy_object(object, nwords); } static int -size_vector_complex_long_float(lispobj *where) +size_vector_complex_long_float(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef sparc - nwords = CEILING(length * 8 + 2, 2); + nwords = CEILING(length * 8 + 2, 2); #endif - return nwords; + return nwords; } #endif - + /* Weak Pointers */ #define WEAK_POINTER_NWORDS \ CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2) static int -scav_weak_pointer(lispobj *where, lispobj object) +scav_weak_pointer(lispobj * where, lispobj object) { - /* Do not let GC scavenge the value slot of the weak pointer */ - /* (that is why it is a weak pointer). Note: we could use */ - /* the scav_unboxed method here. */ + /* Do not let GC scavenge the value slot of the weak pointer */ + /* (that is why it is a weak pointer). Note: we could use */ + /* the scav_unboxed method here. */ - return WEAK_POINTER_NWORDS; + return WEAK_POINTER_NWORDS; } static lispobj trans_weak_pointer(lispobj object) { - lispobj copy; - struct weak_pointer *wp; + lispobj copy; + struct weak_pointer *wp; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); #if defined(DEBUG_WEAK) - printf("Transporting weak pointer from 0x%08x\n", object); + printf("Transporting weak pointer from 0x%08x\n", object); #endif - /* Need to remember where all the weak pointers are that have */ - /* been transported so they can be fixed up in a post-GC pass. */ + /* Need to remember where all the weak pointers are that have */ + /* been transported so they can be fixed up in a post-GC pass. */ - copy = copy_object(object, WEAK_POINTER_NWORDS); - wp = (struct weak_pointer *) PTR(copy); - + copy = copy_object(object, WEAK_POINTER_NWORDS); + wp = (struct weak_pointer *) PTR(copy); - /* Push the weak pointer onto the list of weak pointers. */ - wp->next = weak_pointers; - weak_pointers = wp; - return copy; + /* Push the weak pointer onto the list of weak pointers. */ + wp->next = weak_pointers; + weak_pointers = wp; + + return copy; } static int -size_weak_pointer(lispobj *where) +size_weak_pointer(lispobj * where) { - return WEAK_POINTER_NWORDS; + return WEAK_POINTER_NWORDS; } -void scan_weak_pointers(void) +void +scan_weak_pointers(void) { - struct weak_pointer *wp; + struct weak_pointer *wp; - for (wp = weak_pointers; wp != (struct weak_pointer *) NULL; - wp = wp->next) { - lispobj value; - lispobj first, *first_pointer; + for (wp = weak_pointers; wp != (struct weak_pointer *) NULL; wp = wp->next) { + lispobj value; + lispobj first, *first_pointer; - value = wp->value; + value = wp->value; #if defined(DEBUG_WEAK) - printf("Weak pointer at 0x%08x\n", (unsigned long) wp); - printf("Value: 0x%08x\n", (unsigned long) value); -#endif + printf("Weak pointer at 0x%08x\n", (unsigned long) wp); + printf("Value: 0x%08x\n", (unsigned long) value); +#endif - if (!(Pointerp(value) && from_space_p(value))) - continue; + if (!(Pointerp(value) && from_space_p(value))) + continue; - /* Now, we need to check if the object has been */ - /* forwarded. If it has been, the weak pointer is */ - /* still good and needs to be updated. Otherwise, the */ - /* weak pointer needs to be nil'ed out. */ + /* Now, we need to check if the object has been */ + /* forwarded. If it has been, the weak pointer is */ + /* still good and needs to be updated. Otherwise, the */ + /* weak pointer needs to be nil'ed out. */ + + first_pointer = (lispobj *) PTR(value); + first = *first_pointer; - first_pointer = (lispobj *) PTR(value); - first = *first_pointer; - #if defined(DEBUG_WEAK) - printf("First: 0x%08x\n", (unsigned long) first); -#endif - - if (Pointerp(first) && new_space_p(first)) - wp->value = first; - else { - wp->value = NIL; - wp->broken = T; - } + printf("First: 0x%08x\n", (unsigned long) first); +#endif + + if (Pointerp(first) && new_space_p(first)) + wp->value = first; + else { + wp->value = NIL; + wp->broken = T; } + } } + - /* Initialization */ static int -scav_lose(lispobj *where, lispobj object) +scav_lose(lispobj * where, lispobj object) { fprintf(stderr, "GC lossage. No scavenge function for object 0x%08x\n", (unsigned long) object); @@ -1935,321 +1937,330 @@ trans_lose(lispobj object) } static int -size_lose(lispobj *where) +size_lose(lispobj * where) { - fprintf(stderr, "Size lossage. No size function for object at 0x%08x\n", - (unsigned long) where); - fprintf(stderr, "First word of object: 0x%08x\n", - (unsigned long) *where); - return 1; + fprintf(stderr, "Size lossage. No size function for object at 0x%08x\n", + (unsigned long) where); + fprintf(stderr, "First word of object: 0x%08x\n", (unsigned long) *where); + return 1; } -void gc_init(void) +void +gc_init(void) { - int i; + int i; - /* Scavenge Table */ - for (i = 0; i < 256; i++) - scavtab[i] = scav_lose; + /* Scavenge Table */ + for (i = 0; i < 256; i++) + scavtab[i] = scav_lose; - for (i = 0; i < 32; i++) { - scavtab[type_EvenFixnum|(i<<3)] = scav_immediate; - scavtab[type_FunctionPointer|(i<<3)] = scav_function_pointer; - /* OtherImmediate0 */ - scavtab[type_ListPointer|(i<<3)] = scav_list_pointer; - scavtab[type_OddFixnum|(i<<3)] = scav_immediate; - scavtab[type_InstancePointer|(i<<3)] = scav_instance_pointer; - /* OtherImmediate1 */ - scavtab[type_OtherPointer|(i<<3)] = scav_other_pointer; - } + for (i = 0; i < 32; i++) { + scavtab[type_EvenFixnum | (i << 3)] = scav_immediate; + scavtab[type_FunctionPointer | (i << 3)] = scav_function_pointer; + /* OtherImmediate0 */ + scavtab[type_ListPointer | (i << 3)] = scav_list_pointer; + scavtab[type_OddFixnum | (i << 3)] = scav_immediate; + scavtab[type_InstancePointer | (i << 3)] = scav_instance_pointer; + /* OtherImmediate1 */ + scavtab[type_OtherPointer | (i << 3)] = scav_other_pointer; + } - scavtab[type_Bignum] = scav_unboxed; - scavtab[type_Ratio] = scav_boxed; - scavtab[type_SingleFloat] = scav_unboxed; - scavtab[type_DoubleFloat] = scav_unboxed; + scavtab[type_Bignum] = scav_unboxed; + scavtab[type_Ratio] = scav_boxed; + scavtab[type_SingleFloat] = scav_unboxed; + scavtab[type_DoubleFloat] = scav_unboxed; #ifdef type_LongFloat - scavtab[type_LongFloat] = scav_unboxed; + scavtab[type_LongFloat] = scav_unboxed; #endif - scavtab[type_Complex] = scav_boxed; + scavtab[type_Complex] = scav_boxed; #ifdef type_ComplexSingleFloat - scavtab[type_ComplexSingleFloat] = scav_unboxed; + scavtab[type_ComplexSingleFloat] = scav_unboxed; #endif #ifdef type_ComplexDoubleFloat - scavtab[type_ComplexDoubleFloat] = scav_unboxed; + scavtab[type_ComplexDoubleFloat] = scav_unboxed; #endif #ifdef type_ComplexLongFloat - scavtab[type_ComplexLongFloat] = scav_unboxed; -#endif - scavtab[type_SimpleArray] = scav_boxed; - scavtab[type_SimpleString] = scav_string; - scavtab[type_SimpleBitVector] = scav_vector_bit; - scavtab[type_SimpleVector] = scav_vector; - scavtab[type_SimpleArrayUnsignedByte2] = scav_vector_unsigned_byte_2; - scavtab[type_SimpleArrayUnsignedByte4] = scav_vector_unsigned_byte_4; - scavtab[type_SimpleArrayUnsignedByte8] = scav_vector_unsigned_byte_8; - scavtab[type_SimpleArrayUnsignedByte16] = scav_vector_unsigned_byte_16; - scavtab[type_SimpleArrayUnsignedByte32] = scav_vector_unsigned_byte_32; + scavtab[type_ComplexLongFloat] = scav_unboxed; +#endif + scavtab[type_SimpleArray] = scav_boxed; + scavtab[type_SimpleString] = scav_string; + scavtab[type_SimpleBitVector] = scav_vector_bit; + scavtab[type_SimpleVector] = scav_vector; + scavtab[type_SimpleArrayUnsignedByte2] = scav_vector_unsigned_byte_2; + scavtab[type_SimpleArrayUnsignedByte4] = scav_vector_unsigned_byte_4; + scavtab[type_SimpleArrayUnsignedByte8] = scav_vector_unsigned_byte_8; + scavtab[type_SimpleArrayUnsignedByte16] = scav_vector_unsigned_byte_16; + scavtab[type_SimpleArrayUnsignedByte32] = scav_vector_unsigned_byte_32; #ifdef type_SimpleArraySignedByte8 - scavtab[type_SimpleArraySignedByte8] = scav_vector_unsigned_byte_8; + scavtab[type_SimpleArraySignedByte8] = scav_vector_unsigned_byte_8; #endif #ifdef type_SimpleArraySignedByte16 - scavtab[type_SimpleArraySignedByte16] = scav_vector_unsigned_byte_16; + scavtab[type_SimpleArraySignedByte16] = scav_vector_unsigned_byte_16; #endif #ifdef type_SimpleArraySignedByte30 - scavtab[type_SimpleArraySignedByte30] = scav_vector_unsigned_byte_32; + scavtab[type_SimpleArraySignedByte30] = scav_vector_unsigned_byte_32; #endif #ifdef type_SimpleArraySignedByte32 - scavtab[type_SimpleArraySignedByte32] = scav_vector_unsigned_byte_32; + scavtab[type_SimpleArraySignedByte32] = scav_vector_unsigned_byte_32; #endif - scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float; - scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float; + scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float; + scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float; #ifdef type_SimpleArrayLongFloat - scavtab[type_SimpleArrayLongFloat] = scav_vector_long_float; + scavtab[type_SimpleArrayLongFloat] = scav_vector_long_float; #endif #ifdef type_SimpleArrayComplexSingleFloat - scavtab[type_SimpleArrayComplexSingleFloat] = scav_vector_complex_single_float; + scavtab[type_SimpleArrayComplexSingleFloat] = + scav_vector_complex_single_float; #endif #ifdef type_SimpleArrayComplexDoubleFloat - scavtab[type_SimpleArrayComplexDoubleFloat] = scav_vector_complex_double_float; + scavtab[type_SimpleArrayComplexDoubleFloat] = + scav_vector_complex_double_float; #endif #ifdef type_SimpleArrayComplexLongFloat - scavtab[type_SimpleArrayComplexLongFloat] = scav_vector_complex_long_float; -#endif - scavtab[type_ComplexString] = scav_boxed; - scavtab[type_ComplexBitVector] = scav_boxed; - scavtab[type_ComplexVector] = scav_boxed; - scavtab[type_ComplexArray] = scav_boxed; - scavtab[type_CodeHeader] = scav_code_header; - scavtab[type_FunctionHeader] = scav_function_header; - scavtab[type_ClosureFunctionHeader] = scav_function_header; - scavtab[type_ReturnPcHeader] = scav_return_pc_header; + scavtab[type_SimpleArrayComplexLongFloat] = scav_vector_complex_long_float; +#endif + scavtab[type_ComplexString] = scav_boxed; + scavtab[type_ComplexBitVector] = scav_boxed; + scavtab[type_ComplexVector] = scav_boxed; + scavtab[type_ComplexArray] = scav_boxed; + scavtab[type_CodeHeader] = scav_code_header; + scavtab[type_FunctionHeader] = scav_function_header; + scavtab[type_ClosureFunctionHeader] = scav_function_header; + scavtab[type_ReturnPcHeader] = scav_return_pc_header; #ifdef i386 - scavtab[type_ClosureHeader] = scav_closure_header; - scavtab[type_FuncallableInstanceHeader] = scav_closure_header; - scavtab[type_ByteCodeFunction] = scav_closure_header; - scavtab[type_ByteCodeClosure] = scav_closure_header; - scavtab[type_DylanFunctionHeader] = scav_closure_header; + scavtab[type_ClosureHeader] = scav_closure_header; + scavtab[type_FuncallableInstanceHeader] = scav_closure_header; + scavtab[type_ByteCodeFunction] = scav_closure_header; + scavtab[type_ByteCodeClosure] = scav_closure_header; + scavtab[type_DylanFunctionHeader] = scav_closure_header; #else - scavtab[type_ClosureHeader] = scav_boxed; - scavtab[type_FuncallableInstanceHeader] = scav_boxed; - scavtab[type_ByteCodeFunction] = scav_boxed; - scavtab[type_ByteCodeClosure] = scav_boxed; - scavtab[type_DylanFunctionHeader] = scav_boxed; -#endif - scavtab[type_ValueCellHeader] = scav_boxed; - scavtab[type_SymbolHeader] = scav_boxed; - scavtab[type_BaseChar] = scav_immediate; - scavtab[type_Sap] = scav_unboxed; - scavtab[type_UnboundMarker] = scav_immediate; - scavtab[type_WeakPointer] = scav_weak_pointer; - scavtab[type_InstanceHeader] = scav_boxed; + scavtab[type_ClosureHeader] = scav_boxed; + scavtab[type_FuncallableInstanceHeader] = scav_boxed; + scavtab[type_ByteCodeFunction] = scav_boxed; + scavtab[type_ByteCodeClosure] = scav_boxed; + scavtab[type_DylanFunctionHeader] = scav_boxed; +#endif + scavtab[type_ValueCellHeader] = scav_boxed; + scavtab[type_SymbolHeader] = scav_boxed; + scavtab[type_BaseChar] = scav_immediate; + scavtab[type_Sap] = scav_unboxed; + scavtab[type_UnboundMarker] = scav_immediate; + scavtab[type_WeakPointer] = scav_weak_pointer; + scavtab[type_InstanceHeader] = scav_boxed; #ifndef sparc - scavtab[type_Fdefn] = scav_fdefn; + scavtab[type_Fdefn] = scav_fdefn; #else - scavtab[type_Fdefn] = scav_boxed; + scavtab[type_Fdefn] = scav_boxed; #endif - /* Transport Other Table */ - for (i = 0; i < 256; i++) - transother[i] = trans_lose; + /* Transport Other Table */ + for (i = 0; i < 256; i++) + transother[i] = trans_lose; - transother[type_Bignum] = trans_unboxed; - transother[type_Ratio] = trans_boxed; - transother[type_SingleFloat] = trans_unboxed; - transother[type_DoubleFloat] = trans_unboxed; + transother[type_Bignum] = trans_unboxed; + transother[type_Ratio] = trans_boxed; + transother[type_SingleFloat] = trans_unboxed; + transother[type_DoubleFloat] = trans_unboxed; #ifdef type_LongFloat - transother[type_LongFloat] = trans_unboxed; + transother[type_LongFloat] = trans_unboxed; #endif - transother[type_Complex] = trans_boxed; + transother[type_Complex] = trans_boxed; #ifdef type_ComplexSingleFloat - transother[type_ComplexSingleFloat] = trans_unboxed; + transother[type_ComplexSingleFloat] = trans_unboxed; #endif #ifdef type_ComplexDoubleFloat - transother[type_ComplexDoubleFloat] = trans_unboxed; + transother[type_ComplexDoubleFloat] = trans_unboxed; #endif #ifdef type_ComplexLongFloat - transother[type_ComplexLongFloat] = trans_unboxed; -#endif - transother[type_SimpleArray] = trans_boxed; - transother[type_SimpleString] = trans_string; - transother[type_SimpleBitVector] = trans_vector_bit; - transother[type_SimpleVector] = trans_vector; - transother[type_SimpleArrayUnsignedByte2] = trans_vector_unsigned_byte_2; - transother[type_SimpleArrayUnsignedByte4] = trans_vector_unsigned_byte_4; - transother[type_SimpleArrayUnsignedByte8] = trans_vector_unsigned_byte_8; - transother[type_SimpleArrayUnsignedByte16] = trans_vector_unsigned_byte_16; - transother[type_SimpleArrayUnsignedByte32] = trans_vector_unsigned_byte_32; + transother[type_ComplexLongFloat] = trans_unboxed; +#endif + transother[type_SimpleArray] = trans_boxed; + transother[type_SimpleString] = trans_string; + transother[type_SimpleBitVector] = trans_vector_bit; + transother[type_SimpleVector] = trans_vector; + transother[type_SimpleArrayUnsignedByte2] = trans_vector_unsigned_byte_2; + transother[type_SimpleArrayUnsignedByte4] = trans_vector_unsigned_byte_4; + transother[type_SimpleArrayUnsignedByte8] = trans_vector_unsigned_byte_8; + transother[type_SimpleArrayUnsignedByte16] = trans_vector_unsigned_byte_16; + transother[type_SimpleArrayUnsignedByte32] = trans_vector_unsigned_byte_32; #ifdef type_SimpleArraySignedByte8 - transother[type_SimpleArraySignedByte8] = trans_vector_unsigned_byte_8; + transother[type_SimpleArraySignedByte8] = trans_vector_unsigned_byte_8; #endif #ifdef type_SimpleArraySignedByte16 - transother[type_SimpleArraySignedByte16] = trans_vector_unsigned_byte_16; + transother[type_SimpleArraySignedByte16] = trans_vector_unsigned_byte_16; #endif #ifdef type_SimpleArraySignedByte30 - transother[type_SimpleArraySignedByte30] = trans_vector_unsigned_byte_32; + transother[type_SimpleArraySignedByte30] = trans_vector_unsigned_byte_32; #endif #ifdef type_SimpleArraySignedByte32 - transother[type_SimpleArraySignedByte32] = trans_vector_unsigned_byte_32; + transother[type_SimpleArraySignedByte32] = trans_vector_unsigned_byte_32; #endif - transother[type_SimpleArraySingleFloat] = trans_vector_single_float; - transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float; + transother[type_SimpleArraySingleFloat] = trans_vector_single_float; + transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float; #ifdef type_SimpleArrayLongFloat - transother[type_SimpleArrayLongFloat] = trans_vector_long_float; + transother[type_SimpleArrayLongFloat] = trans_vector_long_float; #endif #ifdef type_SimpleArrayComplexSingleFloat - transother[type_SimpleArrayComplexSingleFloat] = trans_vector_complex_single_float; + transother[type_SimpleArrayComplexSingleFloat] = + trans_vector_complex_single_float; #endif #ifdef type_SimpleArrayComplexDoubleFloat - transother[type_SimpleArrayComplexDoubleFloat] = trans_vector_complex_double_float; + transother[type_SimpleArrayComplexDoubleFloat] = + trans_vector_complex_double_float; #endif #ifdef type_SimpleArrayComplexLongFloat - transother[type_SimpleArrayComplexLongFloat] = trans_vector_complex_long_float; -#endif - transother[type_ComplexString] = trans_boxed; - transother[type_ComplexBitVector] = trans_boxed; - transother[type_ComplexVector] = trans_boxed; - transother[type_ComplexArray] = trans_boxed; - transother[type_CodeHeader] = trans_code_header; - transother[type_FunctionHeader] = trans_function_header; - transother[type_ClosureFunctionHeader] = trans_function_header; - transother[type_ReturnPcHeader] = trans_return_pc_header; - transother[type_ClosureHeader] = trans_boxed; - transother[type_FuncallableInstanceHeader] = trans_boxed; - transother[type_ByteCodeFunction] = trans_boxed; - transother[type_ByteCodeClosure] = trans_boxed; - transother[type_ValueCellHeader] = trans_boxed; - transother[type_SymbolHeader] = trans_boxed; - transother[type_BaseChar] = trans_immediate; - transother[type_Sap] = trans_unboxed; - transother[type_UnboundMarker] = trans_immediate; - transother[type_WeakPointer] = trans_weak_pointer; - transother[type_InstanceHeader] = trans_boxed; - transother[type_Fdefn] = trans_boxed; - - /* Size table */ - - for (i = 0; i < 256; i++) - sizetab[i] = size_lose; - - for (i = 0; i < 32; i++) { - sizetab[type_EvenFixnum|(i<<3)] = size_immediate; - sizetab[type_FunctionPointer|(i<<3)] = size_pointer; - /* OtherImmediate0 */ - sizetab[type_ListPointer|(i<<3)] = size_pointer; - sizetab[type_OddFixnum|(i<<3)] = size_immediate; - sizetab[type_InstancePointer|(i<<3)] = size_pointer; - /* OtherImmediate1 */ - sizetab[type_OtherPointer|(i<<3)] = size_pointer; - } + transother[type_SimpleArrayComplexLongFloat] = + trans_vector_complex_long_float; +#endif + transother[type_ComplexString] = trans_boxed; + transother[type_ComplexBitVector] = trans_boxed; + transother[type_ComplexVector] = trans_boxed; + transother[type_ComplexArray] = trans_boxed; + transother[type_CodeHeader] = trans_code_header; + transother[type_FunctionHeader] = trans_function_header; + transother[type_ClosureFunctionHeader] = trans_function_header; + transother[type_ReturnPcHeader] = trans_return_pc_header; + transother[type_ClosureHeader] = trans_boxed; + transother[type_FuncallableInstanceHeader] = trans_boxed; + transother[type_ByteCodeFunction] = trans_boxed; + transother[type_ByteCodeClosure] = trans_boxed; + transother[type_ValueCellHeader] = trans_boxed; + transother[type_SymbolHeader] = trans_boxed; + transother[type_BaseChar] = trans_immediate; + transother[type_Sap] = trans_unboxed; + transother[type_UnboundMarker] = trans_immediate; + transother[type_WeakPointer] = trans_weak_pointer; + transother[type_InstanceHeader] = trans_boxed; + transother[type_Fdefn] = trans_boxed; + + /* Size table */ + + for (i = 0; i < 256; i++) + sizetab[i] = size_lose; + + for (i = 0; i < 32; i++) { + sizetab[type_EvenFixnum | (i << 3)] = size_immediate; + sizetab[type_FunctionPointer | (i << 3)] = size_pointer; + /* OtherImmediate0 */ + sizetab[type_ListPointer | (i << 3)] = size_pointer; + sizetab[type_OddFixnum | (i << 3)] = size_immediate; + sizetab[type_InstancePointer | (i << 3)] = size_pointer; + /* OtherImmediate1 */ + sizetab[type_OtherPointer | (i << 3)] = size_pointer; + } - sizetab[type_Bignum] = size_unboxed; - sizetab[type_Ratio] = size_boxed; - sizetab[type_SingleFloat] = size_unboxed; - sizetab[type_DoubleFloat] = size_unboxed; + sizetab[type_Bignum] = size_unboxed; + sizetab[type_Ratio] = size_boxed; + sizetab[type_SingleFloat] = size_unboxed; + sizetab[type_DoubleFloat] = size_unboxed; #ifdef type_LongFloat - sizetab[type_LongFloat] = size_unboxed; + sizetab[type_LongFloat] = size_unboxed; #endif - sizetab[type_Complex] = size_boxed; + sizetab[type_Complex] = size_boxed; #ifdef type_ComplexSingleFloat - sizetab[type_ComplexSingleFloat] = size_unboxed; + sizetab[type_ComplexSingleFloat] = size_unboxed; #endif #ifdef type_ComplexDoubleFloat - sizetab[type_ComplexDoubleFloat] = size_unboxed; + sizetab[type_ComplexDoubleFloat] = size_unboxed; #endif #ifdef type_ComplexLongFloat - sizetab[type_ComplexLongFloat] = size_unboxed; -#endif - sizetab[type_SimpleArray] = size_boxed; - sizetab[type_SimpleString] = size_string; - sizetab[type_SimpleBitVector] = size_vector_bit; - sizetab[type_SimpleVector] = size_vector; - sizetab[type_SimpleArrayUnsignedByte2] = size_vector_unsigned_byte_2; - sizetab[type_SimpleArrayUnsignedByte4] = size_vector_unsigned_byte_4; - sizetab[type_SimpleArrayUnsignedByte8] = size_vector_unsigned_byte_8; - sizetab[type_SimpleArrayUnsignedByte16] = size_vector_unsigned_byte_16; - sizetab[type_SimpleArrayUnsignedByte32] = size_vector_unsigned_byte_32; + sizetab[type_ComplexLongFloat] = size_unboxed; +#endif + sizetab[type_SimpleArray] = size_boxed; + sizetab[type_SimpleString] = size_string; + sizetab[type_SimpleBitVector] = size_vector_bit; + sizetab[type_SimpleVector] = size_vector; + sizetab[type_SimpleArrayUnsignedByte2] = size_vector_unsigned_byte_2; + sizetab[type_SimpleArrayUnsignedByte4] = size_vector_unsigned_byte_4; + sizetab[type_SimpleArrayUnsignedByte8] = size_vector_unsigned_byte_8; + sizetab[type_SimpleArrayUnsignedByte16] = size_vector_unsigned_byte_16; + sizetab[type_SimpleArrayUnsignedByte32] = size_vector_unsigned_byte_32; #ifdef type_SimpleArraySignedByte8 - sizetab[type_SimpleArraySignedByte8] = size_vector_unsigned_byte_8; + sizetab[type_SimpleArraySignedByte8] = size_vector_unsigned_byte_8; #endif #ifdef type_SimpleArraySignedByte16 - sizetab[type_SimpleArraySignedByte16] = size_vector_unsigned_byte_16; + sizetab[type_SimpleArraySignedByte16] = size_vector_unsigned_byte_16; #endif #ifdef type_SimpleArraySignedByte30 - sizetab[type_SimpleArraySignedByte30] = size_vector_unsigned_byte_32; + sizetab[type_SimpleArraySignedByte30] = size_vector_unsigned_byte_32; #endif #ifdef type_SimpleArraySignedByte32 - sizetab[type_SimpleArraySignedByte32] = size_vector_unsigned_byte_32; + sizetab[type_SimpleArraySignedByte32] = size_vector_unsigned_byte_32; #endif - sizetab[type_SimpleArraySingleFloat] = size_vector_single_float; - sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float; + sizetab[type_SimpleArraySingleFloat] = size_vector_single_float; + sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float; #ifdef type_SimpleArrayLongFloat - sizetab[type_SimpleArrayLongFloat] = size_vector_long_float; + sizetab[type_SimpleArrayLongFloat] = size_vector_long_float; #endif #ifdef type_SimpleArrayComplexSingleFloat - sizetab[type_SimpleArrayComplexSingleFloat] = size_vector_complex_single_float; + sizetab[type_SimpleArrayComplexSingleFloat] = + size_vector_complex_single_float; #endif #ifdef type_SimpleArrayComplexDoubleFloat - sizetab[type_SimpleArrayComplexDoubleFloat] = size_vector_complex_double_float; + sizetab[type_SimpleArrayComplexDoubleFloat] = + size_vector_complex_double_float; #endif #ifdef type_SimpleArrayComplexLongFloat - sizetab[type_SimpleArrayComplexLongFloat] = size_vector_complex_long_float; + sizetab[type_SimpleArrayComplexLongFloat] = size_vector_complex_long_float; #endif - sizetab[type_ComplexString] = size_boxed; - sizetab[type_ComplexBitVector] = size_boxed; - sizetab[type_ComplexVector] = size_boxed; - sizetab[type_ComplexArray] = size_boxed; - sizetab[type_CodeHeader] = size_code_header; + sizetab[type_ComplexString] = size_boxed; + sizetab[type_ComplexBitVector] = size_boxed; + sizetab[type_ComplexVector] = size_boxed; + sizetab[type_ComplexArray] = size_boxed; + sizetab[type_CodeHeader] = size_code_header; #if 0 - /* Shouldn't see these so just lose if it happens */ - sizetab[type_FunctionHeader] = size_function_header; - sizetab[type_ClosureFunctionHeader] = size_function_header; - sizetab[type_ReturnPcHeader] = size_return_pc_header; -#endif - sizetab[type_ClosureHeader] = size_boxed; - sizetab[type_FuncallableInstanceHeader] = size_boxed; - sizetab[type_ValueCellHeader] = size_boxed; - sizetab[type_SymbolHeader] = size_boxed; - sizetab[type_BaseChar] = size_immediate; - sizetab[type_Sap] = size_unboxed; - sizetab[type_UnboundMarker] = size_immediate; - sizetab[type_WeakPointer] = size_weak_pointer; - sizetab[type_InstanceHeader] = size_boxed; - sizetab[type_Fdefn] = size_boxed; + /* Shouldn't see these so just lose if it happens */ + sizetab[type_FunctionHeader] = size_function_header; + sizetab[type_ClosureFunctionHeader] = size_function_header; + sizetab[type_ReturnPcHeader] = size_return_pc_header; +#endif + sizetab[type_ClosureHeader] = size_boxed; + sizetab[type_FuncallableInstanceHeader] = size_boxed; + sizetab[type_ValueCellHeader] = size_boxed; + sizetab[type_SymbolHeader] = size_boxed; + sizetab[type_BaseChar] = size_immediate; + sizetab[type_Sap] = size_unboxed; + sizetab[type_UnboundMarker] = size_immediate; + sizetab[type_WeakPointer] = size_weak_pointer; + sizetab[type_InstanceHeader] = size_boxed; + sizetab[type_Fdefn] = size_boxed; } + - /* Noise to manipulate the gc trigger stuff. */ #ifndef ibmrt -void set_auto_gc_trigger(os_vm_size_t dynamic_usage) +void +set_auto_gc_trigger(os_vm_size_t dynamic_usage) { - os_vm_address_t addr=(os_vm_address_t)current_dynamic_space + + os_vm_address_t addr = (os_vm_address_t) current_dynamic_space + + dynamic_usage; long length = - dynamic_space_size + (os_vm_address_t)current_dynamic_space - addr; - if(addr < (os_vm_address_t)current_dynamic_space_free_pointer) { + dynamic_space_size + (os_vm_address_t) current_dynamic_space - addr; + + if (addr < (os_vm_address_t) current_dynamic_space_free_pointer) { fprintf(stderr, - "set_auto_gc_trigger: tried to set gc trigger too low! (%d < %d)\n", + "set_auto_gc_trigger: tried to set gc trigger too low! (%d < %d)\n", dynamic_usage, - (os_vm_address_t)current_dynamic_space_free_pointer - - (os_vm_address_t)current_dynamic_space); + (os_vm_address_t) current_dynamic_space_free_pointer + - (os_vm_address_t) current_dynamic_space); return; - } - else if (length < 0) { + } else if (length < 0) { fprintf(stderr, "set_auto_gc_trigger: tried to set gc trigger too high! (%d)\n", dynamic_usage); return; } - addr=os_round_up_to_page(addr); - length=os_trunc_size_to_page(length); + addr = os_round_up_to_page(addr); + length = os_trunc_size_to_page(length); #if defined(SUNOS) || defined(SOLARIS) - os_invalidate(addr,length); + os_invalidate(addr, length); #else os_protect(addr, length, 0); #endif @@ -2257,24 +2268,25 @@ void set_auto_gc_trigger(os_vm_size_t dynamic_usage) current_auto_gc_trigger = (lispobj *) addr; #ifdef PRINTNOISE - fprintf (stderr, "current_auto_gc_trigger set to %p\n", current_auto_gc_trigger); + fprintf(stderr, "current_auto_gc_trigger set to %p\n", + current_auto_gc_trigger); #endif } -void clear_auto_gc_trigger(void) +void +clear_auto_gc_trigger(void) { - if(current_auto_gc_trigger!=NULL){ -#if defined(SUNOS) || defined(SOLARIS)/* don't want to force whole space into swapping mode... */ - os_vm_address_t addr=(os_vm_address_t)current_auto_gc_trigger; - os_vm_size_t length= - dynamic_space_size + (os_vm_address_t)current_dynamic_space - addr; + if (current_auto_gc_trigger != NULL) { +#if defined(SUNOS) || defined(SOLARIS) /* don't want to force whole space into swapping mode... */ + os_vm_address_t addr = (os_vm_address_t) current_auto_gc_trigger; + os_vm_size_t length = + dynamic_space_size + (os_vm_address_t) current_dynamic_space - addr; - os_validate(addr,length); + os_validate(addr, length); #else - os_protect((os_vm_address_t)current_dynamic_space, - dynamic_space_size, - OS_VM_PROT_ALL); + os_protect((os_vm_address_t) current_dynamic_space, + dynamic_space_size, OS_VM_PROT_ALL); #endif current_auto_gc_trigger = NULL; diff --git a/lisp/gc.h b/lisp/gc.h index 034b7c890..33ac1f381 100644 --- a/lisp/gc.h +++ b/lisp/gc.h @@ -1,7 +1,7 @@ /* * Header file for GC * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.h,v 1.3 2003/07/28 17:43:11 gerd Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gc.h,v 1.4 2005/09/15 18:26:51 rtoy Rel $ */ #ifndef _GC_H_ @@ -9,7 +9,7 @@ extern void gc_init(void); extern void collect_garbage(void); -extern lispobj *component_ptr_from_pc (lispobj *pc); +extern lispobj *component_ptr_from_pc(lispobj * pc); #ifndef ibmrt diff --git a/lisp/gencgc.c b/lisp/gencgc.c index adcbae678..3be1b015f 100644 --- a/lisp/gencgc.c +++ b/lisp/gencgc.c @@ -7,7 +7,7 @@ * * Douglas Crosher, 1996, 1997, 1998, 1999. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.65 2005/05/23 13:41:23 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.c,v 1.66 2005/09/15 18:26:51 rtoy Exp $ * */ @@ -72,7 +72,7 @@ * the same as *current-region-free-pointer* and is stored in * alloc-tn. */ -#define set_alloc_pointer(value) +#define set_alloc_pointer(value) #define get_alloc_pointer() \ ((unsigned long) current_dynamic_space_free_pointer & ~lowtag_Mask) #define get_binding_stack_pointer() \ @@ -117,54 +117,56 @@ static void *invalid_stack_start, *invalid_stack_end; static inline void -check_escaped_stack_object (lispobj *where, lispobj obj) -{ - void *p; - if (Pointerp (obj) - && (p = (void *) PTR (obj), - (p >= (void *) CONTROL_STACK_START - && p < (void *) CONTROL_STACK_END))) - { - char *space; - - if (where >= (lispobj *) DYNAMIC_0_SPACE_START - && where < (lispobj *) (DYNAMIC_0_SPACE_START + DYNAMIC_SPACE_SIZE)) - space = "dynamic space"; - else if (where >= (lispobj *) STATIC_SPACE_START - && where < (lispobj *) (STATIC_SPACE_START + STATIC_SPACE_SIZE)) - space = "static space"; - else if (where >= (lispobj *) READ_ONLY_SPACE_START - && where < (lispobj *) (READ_ONLY_SPACE_START + READ_ONLY_SPACE_SIZE)) - space = "read-only space"; - else - space = NULL; - - /* GC itself uses some stack, so we can't tell exactly where the - invalid stack area starts. Usually, it should be an error if a - reference to a stack-allocated object is found, although it - is valid to store a reference to a stack-allocated object - temporarily in another reachable object, as long as the - reference goes away at the end of a dynamic extent. */ - - if (p >= invalid_stack_start && p < invalid_stack_end) - lose ("Escaped stack-allocated object 0x%08lx at %p in %s\n", - (unsigned long) obj, where, space); +check_escaped_stack_object(lispobj * where, lispobj obj) +{ + void *p; + + if (Pointerp(obj) + && (p = (void *) PTR(obj), + (p >= (void *) CONTROL_STACK_START + && p < (void *) CONTROL_STACK_END))) { + char *space; + + if (where >= (lispobj *) DYNAMIC_0_SPACE_START + && where < (lispobj *) (DYNAMIC_0_SPACE_START + DYNAMIC_SPACE_SIZE)) + space = "dynamic space"; + else if (where >= (lispobj *) STATIC_SPACE_START + && where < + (lispobj *) (STATIC_SPACE_START + STATIC_SPACE_SIZE)) space = + "static space"; + else if (where >= (lispobj *) READ_ONLY_SPACE_START + && where < + (lispobj *) (READ_ONLY_SPACE_START + + READ_ONLY_SPACE_SIZE)) space = "read-only space"; + else + space = NULL; + + /* GC itself uses some stack, so we can't tell exactly where the + invalid stack area starts. Usually, it should be an error if a + reference to a stack-allocated object is found, although it + is valid to store a reference to a stack-allocated object + temporarily in another reachable object, as long as the + reference goes away at the end of a dynamic extent. */ + + if (p >= invalid_stack_start && p < invalid_stack_end) + lose("Escaped stack-allocated object 0x%08lx at %p in %s\n", + (unsigned long) obj, where, space); #ifndef i386 - else if ((where >= (lispobj *) CONTROL_STACK_START - && where < (lispobj *) (CONTROL_STACK_END)) - || (space == NULL)) - { - /* Do nothing if it the reference is from the control stack, - because that will happen, and that's ok. Or if it's from - an unknown space (typically from scavenging an interrupt - context. */ - } -#endif - - else - fprintf (stderr, - "Reference to stack-allocated object 0x%08lx at %p in %s\n", - (unsigned long) obj, where, space ? space : "Unknown space"); + else if ((where >= (lispobj *) CONTROL_STACK_START + && where < (lispobj *) (CONTROL_STACK_END)) + || (space == NULL)) { + /* Do nothing if it the reference is from the control stack, + because that will happen, and that's ok. Or if it's from + an unknown space (typically from scavenging an interrupt + context. */ + } +#endif + + else + fprintf(stderr, + "Reference to stack-allocated object 0x%08lx at %p in %s\n", + (unsigned long) obj, where, + space ? space : "Unknown space"); } } @@ -179,8 +181,8 @@ check_escaped_stack_object (lispobj *where, lispobj obj) #else #define gc_assert(ex) (void) 0 #endif - + /* * The number of generations, an extra is added to this for use as a temp. */ @@ -199,7 +201,7 @@ unsigned counters_verbose = 0; * To enable the use of page protection to help avoid the scavenging * of pages that don't have pointers to younger generations. */ -boolean enable_page_protection = TRUE; +boolean enable_page_protection = TRUE; /* * Hunt for pointers to old-space, when GCing generations >= verify_gen. @@ -266,8 +268,8 @@ unsigned large_object_size = 4 * PAGE_SIZE; * interrupt safety during object initialisation. */ boolean enable_pointer_filter = TRUE; - + /* * The total bytes allocated. Seen by (dynamic-usage) */ @@ -299,8 +301,8 @@ unsigned long reserved_heap_pages = 256; */ static int from_space; static int new_space; - + /* * GC structures and variables. */ @@ -325,26 +327,28 @@ static char *heap_base = NULL; /* * Calculate the start address for the given page number. */ -inline char *page_address(int page_num) +inline char * +page_address(int page_num) { - return heap_base + PAGE_SIZE * page_num; + return heap_base + PAGE_SIZE * page_num; } /* * Find the page index within the page_table for the given address. * Returns -1 on failure. */ -inline int find_page_index(void *addr) +inline int +find_page_index(void *addr) { - int index = (char*)addr - heap_base; + int index = (char *) addr - heap_base; - if (index >= 0) { - index = (unsigned int) index / PAGE_SIZE; - if (index < dynamic_space_pages) - return index; - } + if (index >= 0) { + index = (unsigned int) index / PAGE_SIZE; + if (index < dynamic_space_pages) + return index; + } - return -1; + return -1; } @@ -353,57 +357,57 @@ inline int find_page_index(void *addr) */ struct generation { - /* The first page that gc_alloc checks on its next call. */ - int alloc_start_page; - - /* The first page that gc_alloc_unboxed checks on its next call. */ - int alloc_unboxed_start_page; - - /* - * The first page that gc_alloc_large (boxed) considers on its next call. - * Although it always allocates after the boxed_region. - */ - int alloc_large_start_page; - - /* - * The first page that gc_alloc_large (unboxed) considers on its next call. - * Although it always allocates after the current_unboxed_region. - */ - int alloc_large_unboxed_start_page; - - /* The bytes allocate to this generation. */ - int bytes_allocated; - - /* The number of bytes at which to trigger a GC */ - int gc_trigger; - - /* To calculate a new level for gc_trigger */ - int bytes_consed_between_gc; - - /* The number of GCs since the last raise. */ - int num_gc; - - /* - * The average age at after which a GC will raise objects to the - * next generation. - */ - int trigger_age; - - /* - * The cumulative sum of the bytes allocated to this generation. It - * is cleared after a GC on this generation, and update before new - * objects are added from a GC of a younger generation. Dividing by - * the bytes_allocated will give the average age of the memory in - * this generation since its last GC. - */ - int cum_sum_bytes_allocated; - - /* - * A minimum average memory age before a GC will occur helps prevent - * a GC when a large number of new live objects have been added, in - * which case a GC could be a waste of time. - */ - double min_av_mem_age; + /* The first page that gc_alloc checks on its next call. */ + int alloc_start_page; + + /* The first page that gc_alloc_unboxed checks on its next call. */ + int alloc_unboxed_start_page; + + /* + * The first page that gc_alloc_large (boxed) considers on its next call. + * Although it always allocates after the boxed_region. + */ + int alloc_large_start_page; + + /* + * The first page that gc_alloc_large (unboxed) considers on its next call. + * Although it always allocates after the current_unboxed_region. + */ + int alloc_large_unboxed_start_page; + + /* The bytes allocate to this generation. */ + int bytes_allocated; + + /* The number of bytes at which to trigger a GC */ + int gc_trigger; + + /* To calculate a new level for gc_trigger */ + int bytes_consed_between_gc; + + /* The number of GCs since the last raise. */ + int num_gc; + + /* + * The average age at after which a GC will raise objects to the + * next generation. + */ + int trigger_age; + + /* + * The cumulative sum of the bytes allocated to this generation. It + * is cleared after a GC on this generation, and update before new + * objects are added from a GC of a younger generation. Dividing by + * the bytes_allocated will give the average age of the memory in + * this generation since its last GC. + */ + int cum_sum_bytes_allocated; + + /* + * A minimum average memory age before a GC will occur helps prevent + * a GC when a large number of new live objects have been added, in + * which case a GC could be a waste of time. + */ + double min_av_mem_age; }; /* @@ -418,15 +422,15 @@ static struct generation generations[NUM_GENERATIONS + 1]; */ struct generation_stats { - int bytes_allocated; - int gc_trigger; - int bytes_consed_between_gc; - int num_gc; - int trigger_age; - int cum_sum_bytes_allocated; - double min_av_mem_age; + int bytes_allocated; + int gc_trigger; + int bytes_consed_between_gc; + int num_gc; + int trigger_age; + int cum_sum_bytes_allocated; + double min_av_mem_age; }; - + /* * The oldest generation that will currently be GCed by default. @@ -442,7 +446,7 @@ struct generation_stats { * into an older generation so an unnecessary GC of this long-lived * data can be avoided. */ -unsigned int gencgc_oldest_gen_to_gc = NUM_GENERATIONS - 1; +unsigned int gencgc_oldest_gen_to_gc = NUM_GENERATIONS - 1; /* @@ -451,10 +455,10 @@ unsigned int gencgc_oldest_gen_to_gc = NUM_GENERATIONS - 1; * search of the heap. XX Gencgc obviously needs to be better * integrated with the lisp code. */ -static int last_free_page; +static int last_free_page; + - /* * Misc. heap functions. */ @@ -462,55 +466,58 @@ static int last_free_page; /* * Count the number of write protected pages within the given generation. */ -static int count_write_protect_generation_pages(int generation) +static int +count_write_protect_generation_pages(int generation) { - int i; - int cnt = 0; - int mmask, mflags; + int i; + int cnt = 0; + int mmask, mflags; - mmask = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK - | PAGE_GENERATION_MASK; - mflags = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK | generation; + mmask = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK + | PAGE_GENERATION_MASK; + mflags = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK | generation; - for (i = 0; i < last_free_page; i++) - if (PAGE_FLAGS(i, mmask) == mflags) - cnt++; - return cnt; + for (i = 0; i < last_free_page; i++) + if (PAGE_FLAGS(i, mmask) == mflags) + cnt++; + return cnt; } /* * Count the number of pages within the given generation. */ -static int count_generation_pages(int generation) +static int +count_generation_pages(int generation) { - int i; - int cnt = 0; - int mmask, mflags; + int i; + int cnt = 0; + int mmask, mflags; - mmask = PAGE_ALLOCATED_MASK | PAGE_GENERATION_MASK; - mflags = PAGE_ALLOCATED_MASK | generation; + mmask = PAGE_ALLOCATED_MASK | PAGE_GENERATION_MASK; + mflags = PAGE_ALLOCATED_MASK | generation; - for (i = 0; i < last_free_page; i++) - if (PAGE_FLAGS(i, mmask) == mflags) - cnt++; - return cnt; + for (i = 0; i < last_free_page; i++) + if (PAGE_FLAGS(i, mmask) == mflags) + cnt++; + return cnt; } /* * Count the number of dont_move pages. */ -static int count_dont_move_pages(void) +static int +count_dont_move_pages(void) { - int i; - int cnt = 0; - int mmask; + int i; + int cnt = 0; + int mmask; - mmask = PAGE_ALLOCATED_MASK | PAGE_DONT_MOVE_MASK; + mmask = PAGE_ALLOCATED_MASK | PAGE_DONT_MOVE_MASK; - for (i = 0; i < last_free_page; i++) - if (PAGE_FLAGS(i, mmask) == mmask) - cnt++; - return cnt; + for (i = 0; i < last_free_page; i++) + if (PAGE_FLAGS(i, mmask) == mmask) + cnt++; + return cnt; } /* @@ -518,152 +525,162 @@ static int count_dont_move_pages(void) * given generation. */ #ifdef GC_ASSERTIONS -static int generation_bytes_allocated (int generation) +static int +generation_bytes_allocated(int generation) { - int i; - int bytes_allocated = 0; - int mmask, mflags; + int i; + int bytes_allocated = 0; + int mmask, mflags; - mmask = PAGE_ALLOCATED_MASK | PAGE_GENERATION_MASK; - mflags = PAGE_ALLOCATED_MASK | generation; + mmask = PAGE_ALLOCATED_MASK | PAGE_GENERATION_MASK; + mflags = PAGE_ALLOCATED_MASK | generation; - for (i = 0; i < last_free_page; i++) { - if (PAGE_FLAGS(i, mmask) == mflags) - bytes_allocated += page_table[i].bytes_used; - } - return bytes_allocated; + for (i = 0; i < last_free_page; i++) { + if (PAGE_FLAGS(i, mmask) == mflags) + bytes_allocated += page_table[i].bytes_used; + } + return bytes_allocated; } #endif /* * Return the average age of the memory in a generation. */ -static double gen_av_mem_age(int gen) +static double +gen_av_mem_age(int gen) { - if (generations[gen].bytes_allocated == 0) - return 0.0; + if (generations[gen].bytes_allocated == 0) + return 0.0; - return (double) generations[gen].cum_sum_bytes_allocated / - (double) generations[gen].bytes_allocated; + return (double) generations[gen].cum_sum_bytes_allocated / + (double) generations[gen].bytes_allocated; } /* * The verbose argument controls how much to print out: * 0 for normal level of detail; 1 for debugging. */ -void print_generation_stats(int verbose) +void +print_generation_stats(int verbose) { - int i, gens; + int i, gens; + #if defined(i386) || defined(__x86_64) #define FPU_STATE_SIZE 27 - int fpu_state[FPU_STATE_SIZE]; + int fpu_state[FPU_STATE_SIZE]; #elif defined(sparc) - /* - * 32 (single-precision) FP registers, and the FP state register. - * But Sparc V9 has 32 double-precision registers (equivalent to 64 - * single-precision, but can't be accessed), so we leave enough room - * for that. - */ + /* + * 32 (single-precision) FP registers, and the FP state register. + * But Sparc V9 has 32 double-precision registers (equivalent to 64 + * single-precision, but can't be accessed), so we leave enough room + * for that. + */ #define FPU_STATE_SIZE (((32 + 32 + 1) + 1)/2) - long long fpu_state[FPU_STATE_SIZE]; -#endif - - /* - * This code uses the FP instructions which may be setup for Lisp so - * they need to the saved and reset for C. - */ - fpu_save(fpu_state); - - /* Number of generations to print out. */ - if (verbose) - gens = NUM_GENERATIONS + 1; - else - gens = NUM_GENERATIONS; - - /* Print the heap stats */ - fprintf(stderr, " Page count (%d KB)\n", PAGE_SIZE / 1024); - fprintf(stderr, " Gen Boxed Unboxed LB LUB Alloc Waste Trigger WP GCs Mem-age\n"); - - for (i = 0; i < gens; i++) { - int j; - int boxed_cnt = 0; - int unboxed_cnt = 0; - int large_boxed_cnt = 0; - int large_unboxed_cnt = 0; - - for (j = 0; j < last_free_page; j++) { - int flags = page_table[j].flags; - if ((flags & PAGE_GENERATION_MASK) == i) { - if (flags & PAGE_ALLOCATED_MASK) { - /* - * Count the number of boxed and unboxed pages within the - * given generation. - */ - if (flags & PAGE_UNBOXED_MASK) - if (flags & PAGE_LARGE_OBJECT_MASK) - large_unboxed_cnt++; - else - unboxed_cnt++; - else - if (flags & PAGE_LARGE_OBJECT_MASK) - large_boxed_cnt++; - else - boxed_cnt++; + long long fpu_state[FPU_STATE_SIZE]; +#endif + + /* + * This code uses the FP instructions which may be setup for Lisp so + * they need to the saved and reset for C. + */ + fpu_save(fpu_state); + + /* Number of generations to print out. */ + if (verbose) + gens = NUM_GENERATIONS + 1; + else + gens = NUM_GENERATIONS; + + /* Print the heap stats */ + fprintf(stderr, " Page count (%d KB)\n", PAGE_SIZE / 1024); + fprintf(stderr, + " Gen Boxed Unboxed LB LUB Alloc Waste Trigger WP GCs Mem-age\n"); + + for (i = 0; i < gens; i++) { + int j; + int boxed_cnt = 0; + int unboxed_cnt = 0; + int large_boxed_cnt = 0; + int large_unboxed_cnt = 0; + + for (j = 0; j < last_free_page; j++) { + int flags = page_table[j].flags; + + if ((flags & PAGE_GENERATION_MASK) == i) { + if (flags & PAGE_ALLOCATED_MASK) { + /* + * Count the number of boxed and unboxed pages within the + * given generation. + */ + if (flags & PAGE_UNBOXED_MASK) + if (flags & PAGE_LARGE_OBJECT_MASK) + large_unboxed_cnt++; + else + unboxed_cnt++; + else if (flags & PAGE_LARGE_OBJECT_MASK) + large_boxed_cnt++; + else + boxed_cnt++; + } + } } - } - } - gc_assert(generations[i].bytes_allocated == generation_bytes_allocated(i)); - fprintf(stderr, " %5d: %5d %5d %5d %5d %10d %6d %10d %4d %3d %7.4f\n", - i, boxed_cnt, unboxed_cnt, large_boxed_cnt, large_unboxed_cnt, - generations[i].bytes_allocated, - PAGE_SIZE * count_generation_pages(i) - - generations[i].bytes_allocated, - generations[i].gc_trigger, - count_write_protect_generation_pages(i), - generations[i].num_gc, - gen_av_mem_age(i)); - } - fprintf(stderr, " Total bytes alloc=%ld\n", bytes_allocated); + gc_assert(generations[i].bytes_allocated == + generation_bytes_allocated(i)); + fprintf(stderr, " %5d: %5d %5d %5d %5d %10d %6d %10d %4d %3d %7.4f\n", + i, boxed_cnt, unboxed_cnt, large_boxed_cnt, large_unboxed_cnt, + generations[i].bytes_allocated, + PAGE_SIZE * count_generation_pages(i) - + generations[i].bytes_allocated, generations[i].gc_trigger, + count_write_protect_generation_pages(i), generations[i].num_gc, + gen_av_mem_age(i)); + } + fprintf(stderr, " Total bytes alloc=%ld\n", bytes_allocated); - fpu_restore(fpu_state); + fpu_restore(fpu_state); } /* Get statistics that are kept "on the fly" out of the generation array. */ -void get_generation_stats(int gen, struct generation_stats *stats) -{ - if (gen <= NUM_GENERATIONS) { - stats->bytes_allocated = generations[gen].bytes_allocated; - stats->gc_trigger = generations[gen].gc_trigger; - stats->bytes_consed_between_gc = generations[gen].bytes_consed_between_gc; - stats->num_gc = generations[gen].num_gc; - stats->trigger_age = generations[gen].trigger_age; - stats->cum_sum_bytes_allocated = generations[gen].cum_sum_bytes_allocated; - stats->min_av_mem_age = generations[gen].min_av_mem_age; - } +void +get_generation_stats(int gen, struct generation_stats *stats) +{ + if (gen <= NUM_GENERATIONS) { + stats->bytes_allocated = generations[gen].bytes_allocated; + stats->gc_trigger = generations[gen].gc_trigger; + stats->bytes_consed_between_gc = + generations[gen].bytes_consed_between_gc; + stats->num_gc = generations[gen].num_gc; + stats->trigger_age = generations[gen].trigger_age; + stats->cum_sum_bytes_allocated = + generations[gen].cum_sum_bytes_allocated; + stats->min_av_mem_age = generations[gen].min_av_mem_age; + } } -void set_gc_trigger(int gen, int trigger) +void +set_gc_trigger(int gen, int trigger) { - if (gen <= NUM_GENERATIONS) { - generations[gen].gc_trigger = trigger; - } + if (gen <= NUM_GENERATIONS) { + generations[gen].gc_trigger = trigger; + } } -void set_trigger_age(int gen, int trigger_age) +void +set_trigger_age(int gen, int trigger_age) { - if (gen <= NUM_GENERATIONS) { - generations[gen].trigger_age = trigger_age; - } + if (gen <= NUM_GENERATIONS) { + generations[gen].trigger_age = trigger_age; + } } -void set_min_mem_age(int gen, double min_mem_age) +void +set_min_mem_age(int gen, double min_mem_age) { - if (gen <= NUM_GENERATIONS) { - generations[gen].min_av_mem_age = min_mem_age; - } + if (gen <= NUM_GENERATIONS) { + generations[gen].min_av_mem_age = min_mem_age; + } } /* @@ -719,8 +736,8 @@ void set_min_mem_age(int gen, double min_mem_age) * Only using two regions at present, both are for the current * newspace generation. */ -struct alloc_region boxed_region; -struct alloc_region unboxed_region; +struct alloc_region boxed_region; +struct alloc_region unboxed_region; #if 0 /* @@ -731,45 +748,43 @@ void *current_region_end_addr; #endif /* The generation currently being allocated to. X */ -static int gc_alloc_generation; +static int gc_alloc_generation; extern void do_dynamic_space_overflow_warning(void); extern void do_dynamic_space_overflow_error(void); /* Handle heap overflow here, maybe. */ static void -handle_heap_overflow(const char* msg, int size) +handle_heap_overflow(const char *msg, int size) { - unsigned long heap_size_mb; - - if (msg) - { - fprintf(stderr, msg, size); + unsigned long heap_size_mb; + + if (msg) { + fprintf(stderr, msg, size); } #ifndef SPARSE_BLOCK_SIZE #define SPARSE_BLOCK_SIZE (0) -#endif +#endif + + /* Figure out how many MB of heap we have */ + heap_size_mb = (dynamic_space_size + SPARSE_BLOCK_SIZE) >> 20; - /* Figure out how many MB of heap we have */ - heap_size_mb = (dynamic_space_size + SPARSE_BLOCK_SIZE) >> 20; - - fprintf(stderr, " CMUCL has run out of dynamic heap space (%lu MB).\n", heap_size_mb); - /* Try to handle heap overflow somewhat gracefully if we can. */ + fprintf(stderr, " CMUCL has run out of dynamic heap space (%lu MB).\n", + heap_size_mb); + /* Try to handle heap overflow somewhat gracefully if we can. */ #if defined(trap_DynamicSpaceOverflow) || defined(FEATURE_HEAP_OVERFLOW_CHECK) - if (reserved_heap_pages == 0) - { - fprintf(stderr, "\n Returning to top-level.\n"); - do_dynamic_space_overflow_error(); - } - else - { - fprintf(stderr, " You can control heap size with the -dynamic-space-size commandline option.\n"); - do_dynamic_space_overflow_warning(); + if (reserved_heap_pages == 0) { + fprintf(stderr, "\n Returning to top-level.\n"); + do_dynamic_space_overflow_error(); + } else { + fprintf(stderr, + " You can control heap size with the -dynamic-space-size commandline option.\n"); + do_dynamic_space_overflow_warning(); } #else - print_generation_stats(1); + print_generation_stats(1); - exit(1); + exit(1); #endif } @@ -797,177 +812,185 @@ handle_heap_overflow(const char* msg, int size) * allocation call using the same pages, all the pages in the region * are allocated, although they will initially be empty. */ -static void gc_alloc_new_region(int nbytes, int unboxed, - struct alloc_region *alloc_region) -{ - int first_page; - int last_page; - int region_size; - int restart_page; - int bytes_found; - int num_pages; - int i; - int mmask, mflags; - - /* Shut up some compiler warnings */ - last_page = bytes_found = 0; - +static void +gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region) +{ + int first_page; + int last_page; + int region_size; + int restart_page; + int bytes_found; + int num_pages; + int i; + int mmask, mflags; + + /* Shut up some compiler warnings */ + last_page = bytes_found = 0; + #if 0 - fprintf(stderr, "alloc_new_region for %d bytes from gen %d\n", - nbytes, gc_alloc_generation); + fprintf(stderr, "alloc_new_region for %d bytes from gen %d\n", + nbytes, gc_alloc_generation); #endif - /* Check that the region is in a reset state. */ - gc_assert(alloc_region->first_page == 0 - && alloc_region->last_page == -1 - && alloc_region->free_pointer == alloc_region->end_addr); + /* Check that the region is in a reset state. */ + gc_assert(alloc_region->first_page == 0 + && alloc_region->last_page == -1 + && alloc_region->free_pointer == alloc_region->end_addr); + + if (unboxed) + restart_page = + generations[gc_alloc_generation].alloc_unboxed_start_page; + else + restart_page = generations[gc_alloc_generation].alloc_start_page; - if (unboxed) - restart_page = generations[gc_alloc_generation].alloc_unboxed_start_page; - else - restart_page = generations[gc_alloc_generation].alloc_start_page; + /* + * Search for a contiguous free region of at least nbytes with the + * given properties: boxed/unboxed, generation. First setting up the + * mask and matching flags. + */ - /* - * Search for a contiguous free region of at least nbytes with the - * given properties: boxed/unboxed, generation. First setting up the - * mask and matching flags. - */ + mmask = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK + | PAGE_LARGE_OBJECT_MASK | PAGE_DONT_MOVE_MASK + | PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK; + mflags = PAGE_ALLOCATED_MASK | (unboxed << PAGE_UNBOXED_SHIFT) + | gc_alloc_generation; - mmask = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK - | PAGE_LARGE_OBJECT_MASK | PAGE_DONT_MOVE_MASK - | PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK; - mflags = PAGE_ALLOCATED_MASK | (unboxed << PAGE_UNBOXED_SHIFT) - | gc_alloc_generation; + do { + first_page = restart_page; - do { - first_page = restart_page; + /* + * First search for a page with at least 32 bytes free, that is + * not write protected, or marked dont_move. + */ - /* - * First search for a page with at least 32 bytes free, that is - * not write protected, or marked dont_move. - */ + while (first_page < dynamic_space_pages) { + int flags = page_table[first_page].flags; - while (first_page < dynamic_space_pages) { - int flags = page_table[first_page].flags; - if (!(flags & PAGE_ALLOCATED_MASK) - || ((flags & mmask) == mflags && - page_table[first_page].bytes_used < PAGE_SIZE - 32)) - break; - first_page++; - } + if (!(flags & PAGE_ALLOCATED_MASK) + || ((flags & mmask) == mflags && + page_table[first_page].bytes_used < PAGE_SIZE - 32)) + break; + first_page++; + } - /* Check for a failure */ - if (first_page >= dynamic_space_pages - reserved_heap_pages) { + /* Check for a failure */ + if (first_page >= dynamic_space_pages - reserved_heap_pages) { #if 0 - handle_heap_overflow("*A2 gc_alloc_new_region failed, nbytes=%d.\n", nbytes); + handle_heap_overflow("*A2 gc_alloc_new_region failed, nbytes=%d.\n", + nbytes); #else - break; + break; #endif - } + } - gc_assert(!PAGE_WRITE_PROTECTED(first_page)); + gc_assert(!PAGE_WRITE_PROTECTED(first_page)); #if 0 - fprintf(stderr, " first_page=%d bytes_used=%d\n", - first_page, page_table[first_page].bytes_used); + fprintf(stderr, " first_page=%d bytes_used=%d\n", + first_page, page_table[first_page].bytes_used); #endif - /* - * Now search forward to calculate the available region size. It - * tries to keeps going until nbytes are found and the number of - * pages is greater than some level. This helps keep down the - * number of pages in a region. - */ - last_page = first_page; - bytes_found = PAGE_SIZE - page_table[first_page].bytes_used; - num_pages = 1; - while ((bytes_found < nbytes || num_pages < 2) - && last_page < dynamic_space_pages - 1 - && !PAGE_ALLOCATED(last_page + 1)) { - last_page++; - num_pages++; - bytes_found += PAGE_SIZE; - gc_assert(!PAGE_WRITE_PROTECTED(last_page)); - } + /* + * Now search forward to calculate the available region size. It + * tries to keeps going until nbytes are found and the number of + * pages is greater than some level. This helps keep down the + * number of pages in a region. + */ + last_page = first_page; + bytes_found = PAGE_SIZE - page_table[first_page].bytes_used; + num_pages = 1; + while ((bytes_found < nbytes || num_pages < 2) + && last_page < dynamic_space_pages - 1 + && !PAGE_ALLOCATED(last_page + 1)) { + last_page++; + num_pages++; + bytes_found += PAGE_SIZE; + gc_assert(!PAGE_WRITE_PROTECTED(last_page)); + } - region_size = (PAGE_SIZE - page_table[first_page].bytes_used) - + PAGE_SIZE * (last_page - first_page); + region_size = (PAGE_SIZE - page_table[first_page].bytes_used) + + PAGE_SIZE * (last_page - first_page); - gc_assert(bytes_found == region_size); + gc_assert(bytes_found == region_size); #if 0 - fprintf(stderr, " last_page=%d bytes_found=%d num_pages=%d\n", - last_page, bytes_found, num_pages); + fprintf(stderr, " last_page=%d bytes_found=%d num_pages=%d\n", + last_page, bytes_found, num_pages); #endif - restart_page = last_page + 1; - } - while (restart_page < dynamic_space_pages && bytes_found < nbytes); + restart_page = last_page + 1; + } + while (restart_page < dynamic_space_pages && bytes_found < nbytes); - if (first_page >= dynamic_space_pages - reserved_heap_pages) { - handle_heap_overflow("*A2 gc_alloc_new_region failed, nbytes=%d.\n", nbytes); - } - - /* Check for a failure */ - if (restart_page >= (dynamic_space_pages - reserved_heap_pages) && bytes_found < nbytes) { - handle_heap_overflow("*A1 gc_alloc_new_region failed, nbytes=%d.\n", nbytes); - } + if (first_page >= dynamic_space_pages - reserved_heap_pages) { + handle_heap_overflow("*A2 gc_alloc_new_region failed, nbytes=%d.\n", + nbytes); + } + /* Check for a failure */ + if (restart_page >= (dynamic_space_pages - reserved_heap_pages) + && bytes_found < nbytes) { + handle_heap_overflow("*A1 gc_alloc_new_region failed, nbytes=%d.\n", + nbytes); + } #if 0 - fprintf(stderr, "gc_alloc_new_region gen %d: %d bytes: from pages %d to %d: addr=%x\n", - gc_alloc_generation, bytes_found, first_page, last_page, - page_address(first_page)); -#endif - - /* Setup the alloc_region. */ - alloc_region->first_page = first_page; - alloc_region->last_page = last_page; - alloc_region->start_addr = page_table[first_page].bytes_used - + page_address(first_page); - alloc_region->free_pointer = alloc_region->start_addr; - alloc_region->end_addr = alloc_region->start_addr + bytes_found; - - if (gencgc_zero_check) { - int *p; - for(p = (int *)alloc_region->start_addr; - p < (int *)alloc_region->end_addr; p++) - if (*p != 0) - fprintf(stderr, "** new region not zero @ %lx\n", (unsigned long) p); - } - - /* Setup the pages. */ - - /* The first page may have already been in use. */ - if (page_table[first_page].bytes_used == 0) { - PAGE_FLAGS_UPDATE(first_page, mmask, mflags); - page_table[first_page].first_object_offset = 0; - } - - gc_assert(PAGE_ALLOCATED(first_page)); - gc_assert(PAGE_UNBOXED_VAL(first_page) == unboxed); - gc_assert(PAGE_GENERATION(first_page) == gc_alloc_generation); - gc_assert(!PAGE_LARGE_OBJECT(first_page)); - - for (i = first_page + 1; i <= last_page; i++) { - PAGE_FLAGS_UPDATE(i, PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK - | PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK, - PAGE_ALLOCATED_MASK | (unboxed << PAGE_UNBOXED_SHIFT) - | gc_alloc_generation); - /* - * This may not be necessary for unboxed regions (think it was - * broken before!) - */ - page_table[i].first_object_offset = - alloc_region->start_addr - page_address(i); - } + fprintf(stderr, + "gc_alloc_new_region gen %d: %d bytes: from pages %d to %d: addr=%x\n", + gc_alloc_generation, bytes_found, first_page, last_page, + page_address(first_page)); +#endif + + /* Setup the alloc_region. */ + alloc_region->first_page = first_page; + alloc_region->last_page = last_page; + alloc_region->start_addr = page_table[first_page].bytes_used + + page_address(first_page); + alloc_region->free_pointer = alloc_region->start_addr; + alloc_region->end_addr = alloc_region->start_addr + bytes_found; + + if (gencgc_zero_check) { + int *p; + + for (p = (int *) alloc_region->start_addr; + p < (int *) alloc_region->end_addr; p++) + if (*p != 0) + fprintf(stderr, "** new region not zero @ %lx\n", + (unsigned long) p); + } - /* Bump up the last_free_page */ - if (last_page + 1 > last_free_page) { - last_free_page = last_page + 1; - set_alloc_pointer((lispobj) ((char *) heap_base + - PAGE_SIZE * last_free_page)); - - } + /* Setup the pages. */ + + /* The first page may have already been in use. */ + if (page_table[first_page].bytes_used == 0) { + PAGE_FLAGS_UPDATE(first_page, mmask, mflags); + page_table[first_page].first_object_offset = 0; + } + + gc_assert(PAGE_ALLOCATED(first_page)); + gc_assert(PAGE_UNBOXED_VAL(first_page) == unboxed); + gc_assert(PAGE_GENERATION(first_page) == gc_alloc_generation); + gc_assert(!PAGE_LARGE_OBJECT(first_page)); + + for (i = first_page + 1; i <= last_page; i++) { + PAGE_FLAGS_UPDATE(i, PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK + | PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK, + PAGE_ALLOCATED_MASK | (unboxed << PAGE_UNBOXED_SHIFT) + | gc_alloc_generation); + /* + * This may not be necessary for unboxed regions (think it was + * broken before!) + */ + page_table[i].first_object_offset = + alloc_region->start_addr - page_address(i); + } + + /* Bump up the last_free_page */ + if (last_page + 1 > last_free_page) { + last_free_page = last_page + 1; + set_alloc_pointer((lispobj) ((char *) heap_base + + PAGE_SIZE * last_free_page)); + + } } @@ -994,75 +1017,77 @@ static void gc_alloc_new_region(int nbytes, int unboxed, static int record_new_objects = 0; static int new_areas_ignore_page; struct new_area { - int page; - int offset; - int size; + int page; + int offset; + int size; }; static struct new_area (*new_areas)[]; static int new_areas_index; int max_new_areas; /* Add a new area to new_areas. */ -static void add_new_area(int first_page, int offset, int size) +static void +add_new_area(int first_page, int offset, int size) { - unsigned new_area_start,c; - int i; + unsigned new_area_start, c; + int i; - /* Ignore if full */ - if (new_areas_index >= NUM_NEW_AREAS) - return; + /* Ignore if full */ + if (new_areas_index >= NUM_NEW_AREAS) + return; + + switch (record_new_objects) { + case 0: + return; + case 1: + if (first_page > new_areas_ignore_page) + return; + break; + case 2: + break; + default: + gc_abort(); + } + + new_area_start = PAGE_SIZE * first_page + offset; + + /* + * Search backwards for a prior area that this follows from. If + * found this will save adding a new area. + */ + for (i = new_areas_index - 1, c = 0; i >= 0 && c < 8; i--, c++) { + unsigned area_end = PAGE_SIZE * (*new_areas)[i].page + + (*new_areas)[i].offset + (*new_areas)[i].size; - switch (record_new_objects) { - case 0: - return; - case 1: - if (first_page > new_areas_ignore_page) - return; - break; - case 2: - break; - default: - gc_abort(); - } - - new_area_start = PAGE_SIZE * first_page + offset; - - /* - * Search backwards for a prior area that this follows from. If - * found this will save adding a new area. - */ - for (i = new_areas_index - 1, c = 0; i >= 0 && c < 8; i--, c++) { - unsigned area_end = PAGE_SIZE * (*new_areas)[i].page - + (*new_areas)[i].offset + (*new_areas)[i].size; #if 0 - fprintf(stderr, "*S1 %d %d %d %d\n", i, c, new_area_start, area_end); + fprintf(stderr, "*S1 %d %d %d %d\n", i, c, new_area_start, area_end); #endif - if (new_area_start == area_end) { + if (new_area_start == area_end) { #if 0 - fprintf(stderr, "-> Adding to [%d] %d %d %d with %d %d %d:\n", - i, (*new_areas)[i].page, (*new_areas)[i].offset , - (*new_areas)[i].size, first_page, offset, size); + fprintf(stderr, "-> Adding to [%d] %d %d %d with %d %d %d:\n", + i, (*new_areas)[i].page, (*new_areas)[i].offset, + (*new_areas)[i].size, first_page, offset, size); #endif - (*new_areas)[i].size += size; - return; + (*new_areas)[i].size += size; + return; + } } - } #if 0 - fprintf(stderr, "*S1 %d %d %d\n",i,c,new_area_start); + fprintf(stderr, "*S1 %d %d %d\n", i, c, new_area_start); #endif - (*new_areas)[new_areas_index].page = first_page; - (*new_areas)[new_areas_index].offset = offset; - (*new_areas)[new_areas_index].size = size; + (*new_areas)[new_areas_index].page = first_page; + (*new_areas)[new_areas_index].offset = offset; + (*new_areas)[new_areas_index].size = size; #if 0 - fprintf(stderr, " new_area %d page %d offset %d size %d\n", - new_areas_index, first_page, offset, size); + fprintf(stderr, " new_area %d page %d offset %d size %d\n", + new_areas_index, first_page, offset, size); #endif - new_areas_index++; + new_areas_index++; - /* Note the max new_areas used. */ - if (new_areas_index > max_new_areas) - max_new_areas = new_areas_index; + /* Note the max new_areas used. */ + if (new_areas_index > max_new_areas) + max_new_areas = new_areas_index; } @@ -1075,147 +1100,148 @@ static void add_new_area(int first_page, int offset, int size) * it is safe to try and re-update the page table of this reset * alloc_region. */ -void gc_alloc_update_page_tables(int unboxed, - struct alloc_region *alloc_region) +void +gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region) { - int more; - int first_page; - int next_page; - int bytes_used; - int orig_first_page_bytes_used; - int region_size; - int byte_cnt; + int more; + int first_page; + int next_page; + int bytes_used; + int orig_first_page_bytes_used; + int region_size; + int byte_cnt; #if 0 - fprintf(stderr, "gc_alloc_update_page_tables to gen %d: ", - gc_alloc_generation); + fprintf(stderr, "gc_alloc_update_page_tables to gen %d: ", + gc_alloc_generation); #endif - first_page = alloc_region->first_page; + first_page = alloc_region->first_page; - /* Catch an unused alloc_region. */ - if (first_page == 0 && alloc_region->last_page == -1) - return; + /* Catch an unused alloc_region. */ + if (first_page == 0 && alloc_region->last_page == -1) + return; - next_page = first_page + 1; + next_page = first_page + 1; - /* Skip if no bytes were allocated */ - if (alloc_region->free_pointer != alloc_region->start_addr) { - orig_first_page_bytes_used = page_table[first_page].bytes_used; + /* Skip if no bytes were allocated */ + if (alloc_region->free_pointer != alloc_region->start_addr) { + orig_first_page_bytes_used = page_table[first_page].bytes_used; - gc_assert(alloc_region->start_addr == page_address(first_page) + - page_table[first_page].bytes_used); + gc_assert(alloc_region->start_addr == page_address(first_page) + + page_table[first_page].bytes_used); - /* All the pages used need to be updated */ + /* All the pages used need to be updated */ - /* Update the first page. */ + /* Update the first page. */ -#if 0 - fprintf(stderr, "0"); +#if 0 + fprintf(stderr, "0"); #endif - /* If the page was free then setup the gen, and first_object_offset. */ - if (page_table[first_page].bytes_used == 0) - gc_assert(page_table[first_page].first_object_offset == 0); + /* If the page was free then setup the gen, and first_object_offset. */ + if (page_table[first_page].bytes_used == 0) + gc_assert(page_table[first_page].first_object_offset == 0); - gc_assert(PAGE_ALLOCATED(first_page)); - gc_assert(PAGE_UNBOXED_VAL(first_page) == unboxed); - gc_assert(PAGE_GENERATION(first_page) == gc_alloc_generation); - gc_assert(!PAGE_LARGE_OBJECT(first_page)); + gc_assert(PAGE_ALLOCATED(first_page)); + gc_assert(PAGE_UNBOXED_VAL(first_page) == unboxed); + gc_assert(PAGE_GENERATION(first_page) == gc_alloc_generation); + gc_assert(!PAGE_LARGE_OBJECT(first_page)); - byte_cnt = 0; + byte_cnt = 0; - /* - * Calc. the number of bytes used in this page. This is not always - * the number of new bytes, unless it was free. - */ - more = 0; - bytes_used = alloc_region->free_pointer - page_address(first_page); - if (bytes_used > PAGE_SIZE) { - bytes_used = PAGE_SIZE; - more = 1; - } - page_table[first_page].bytes_used = bytes_used; - byte_cnt += bytes_used; + /* + * Calc. the number of bytes used in this page. This is not always + * the number of new bytes, unless it was free. + */ + more = 0; + bytes_used = alloc_region->free_pointer - page_address(first_page); + if (bytes_used > PAGE_SIZE) { + bytes_used = PAGE_SIZE; + more = 1; + } + page_table[first_page].bytes_used = bytes_used; + byte_cnt += bytes_used; - /* - * All the rest of the pages should be free. Need to set their - * first_object_offset pointer to the start of the region, and set - * the bytes_used. - */ - while (more) { + /* + * All the rest of the pages should be free. Need to set their + * first_object_offset pointer to the start of the region, and set + * the bytes_used. + */ + while (more) { #if 0 - fprintf(stderr, "+"); -#endif - gc_assert(PAGE_ALLOCATED(next_page)); - gc_assert(PAGE_UNBOXED_VAL(next_page) == unboxed); - gc_assert(page_table[next_page].bytes_used == 0); - gc_assert(PAGE_GENERATION(next_page) == gc_alloc_generation); - gc_assert(!PAGE_LARGE_OBJECT(next_page)); - - gc_assert(page_table[next_page].first_object_offset == - alloc_region->start_addr - page_address(next_page)); - - /* Calc. the number of bytes used in this page. */ - more = 0; - bytes_used = alloc_region->free_pointer - page_address(next_page); - if (bytes_used > PAGE_SIZE) { - bytes_used = PAGE_SIZE; - more = 1; - } - page_table[next_page].bytes_used = bytes_used; - byte_cnt += bytes_used; + fprintf(stderr, "+"); +#endif + gc_assert(PAGE_ALLOCATED(next_page)); + gc_assert(PAGE_UNBOXED_VAL(next_page) == unboxed); + gc_assert(page_table[next_page].bytes_used == 0); + gc_assert(PAGE_GENERATION(next_page) == gc_alloc_generation); + gc_assert(!PAGE_LARGE_OBJECT(next_page)); + + gc_assert(page_table[next_page].first_object_offset == + alloc_region->start_addr - page_address(next_page)); + + /* Calc. the number of bytes used in this page. */ + more = 0; + bytes_used = alloc_region->free_pointer - page_address(next_page); + if (bytes_used > PAGE_SIZE) { + bytes_used = PAGE_SIZE; + more = 1; + } + page_table[next_page].bytes_used = bytes_used; + byte_cnt += bytes_used; - next_page++; - } + next_page++; + } - region_size = alloc_region->free_pointer - alloc_region->start_addr; - bytes_allocated += region_size; - generations[gc_alloc_generation].bytes_allocated += region_size; + region_size = alloc_region->free_pointer - alloc_region->start_addr; + bytes_allocated += region_size; + generations[gc_alloc_generation].bytes_allocated += region_size; - gc_assert(byte_cnt - orig_first_page_bytes_used == region_size); + gc_assert(byte_cnt - orig_first_page_bytes_used == region_size); - /* - * Set the generations alloc restart page to the last page of - * the region. - */ - if (unboxed) - generations[gc_alloc_generation].alloc_unboxed_start_page = next_page-1; - else - generations[gc_alloc_generation].alloc_start_page = next_page - 1; + /* + * Set the generations alloc restart page to the last page of + * the region. + */ + if (unboxed) + generations[gc_alloc_generation].alloc_unboxed_start_page = + next_page - 1; + else + generations[gc_alloc_generation].alloc_start_page = next_page - 1; - /* Add the region to the new_areas if requested. */ - if (!unboxed) - add_new_area(first_page, orig_first_page_bytes_used, region_size); + /* Add the region to the new_areas if requested. */ + if (!unboxed) + add_new_area(first_page, orig_first_page_bytes_used, region_size); #if 0 - fprintf(stderr, " gc_alloc_update_page_tables update %d bytes to gen %d\n", - region_size, gc_alloc_generation); + fprintf(stderr, + " gc_alloc_update_page_tables update %d bytes to gen %d\n", + region_size, gc_alloc_generation); #endif - } - else - /* - * No bytes allocated. Unallocate the first_page if there are 0 bytes_used. - */ + } else + /* + * No bytes allocated. Unallocate the first_page if there are 0 bytes_used. + */ if (page_table[first_page].bytes_used == 0) - page_table[first_page].flags &= ~PAGE_ALLOCATED_MASK; + page_table[first_page].flags &= ~PAGE_ALLOCATED_MASK; - /* Unallocate any unused pages. */ - while (next_page <= alloc_region->last_page) { - gc_assert(page_table[next_page].bytes_used == 0); - page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK; - next_page++; - } + /* Unallocate any unused pages. */ + while (next_page <= alloc_region->last_page) { + gc_assert(page_table[next_page].bytes_used == 0); + page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK; + next_page++; + } - /* Reset the alloc_region. */ - alloc_region->first_page = 0; - alloc_region->last_page = -1; - alloc_region->start_addr = page_address(0); - alloc_region->free_pointer = page_address(0); - alloc_region->end_addr = page_address(0); + /* Reset the alloc_region. */ + alloc_region->first_page = 0; + alloc_region->last_page = -1; + alloc_region->start_addr = page_address(0); + alloc_region->free_pointer = page_address(0); + alloc_region->end_addr = page_address(0); #if 0 - fprintf(stderr, "\n"); + fprintf(stderr, "\n"); #endif } @@ -1226,311 +1252,318 @@ static inline void *gc_quick_alloc(int nbytes); /* * Allocate a possibly large object. */ -static void *gc_alloc_large(int nbytes, int unboxed, - struct alloc_region *alloc_region) -{ - int first_page; - int last_page; - int region_size; - int restart_page; - int bytes_found; - int num_pages; - int orig_first_page_bytes_used; - int byte_cnt; - int more; - int bytes_used; - int next_page; - int large = (nbytes >= large_object_size); - int mmask, mflags; - - - /* Shut up some compiler warnings */ - last_page = bytes_found = 0; - -#if 0 - if (nbytes > 200000) - fprintf(stderr, "*** alloc_large %d\n", nbytes); -#endif +static void * +gc_alloc_large(int nbytes, int unboxed, struct alloc_region *alloc_region) +{ + int first_page; + int last_page; + int region_size; + int restart_page; + int bytes_found; + int num_pages; + int orig_first_page_bytes_used; + int byte_cnt; + int more; + int bytes_used; + int next_page; + int large = (nbytes >= large_object_size); + int mmask, mflags; -#if 0 - fprintf(stderr, "gc_alloc_large for %d bytes from gen %d\n", - nbytes, gc_alloc_generation); -#endif - - /* - * If the object is small, and there is room in the current region - * then allocation it in the current region. - */ - if (!large && alloc_region->end_addr - alloc_region->free_pointer >= nbytes) - return gc_quick_alloc(nbytes); - - /* - * Search for a contiguous free region of at least nbytes. If it's a - * large object then align it on a page boundary by searching for a - * free page. - */ - - /* - * To allow the allocation of small objects without the danger of - * using a page in the current boxed region, the search starts after - * the current boxed free region. XX could probably keep a page - * index ahead of the current region and bumped up here to save a - * lot of re-scanning. - */ - if (unboxed) - restart_page = generations[gc_alloc_generation].alloc_large_unboxed_start_page; - else - restart_page = generations[gc_alloc_generation].alloc_large_start_page; - if (restart_page <= alloc_region->last_page) - restart_page = alloc_region->last_page + 1; - - /* Setup the mask and matching flags. */ - - mmask = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK - | PAGE_LARGE_OBJECT_MASK | PAGE_DONT_MOVE_MASK - | PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK; - mflags = PAGE_ALLOCATED_MASK | (unboxed << PAGE_UNBOXED_SHIFT) - | gc_alloc_generation; - - do { - first_page = restart_page; - if (large) - while (first_page < dynamic_space_pages && PAGE_ALLOCATED(first_page)) - first_page++; - else - while (first_page < dynamic_space_pages) { - int flags = page_table[first_page].flags; - if (!(flags & PAGE_ALLOCATED_MASK) - || ((flags & mmask) == mflags && - page_table[first_page].bytes_used < PAGE_SIZE - 32)) - break; - first_page++; - } + /* Shut up some compiler warnings */ + last_page = bytes_found = 0; - /* Check for a failure */ - if (first_page >= dynamic_space_pages - reserved_heap_pages) { #if 0 - handle_heap_overflow("*A2 gc_alloc_large failed, nbytes=%d.\n", nbytes); -#else - break; + if (nbytes > 200000) + fprintf(stderr, "*** alloc_large %d\n", nbytes); #endif - } - gc_assert(!PAGE_WRITE_PROTECTED(first_page)); #if 0 - fprintf(stderr, " first_page=%d bytes_used=%d\n", - first_page, page_table[first_page].bytes_used); -#endif - - last_page = first_page; - bytes_found = PAGE_SIZE - page_table[first_page].bytes_used; - num_pages = 1; - while (bytes_found < nbytes - && last_page < dynamic_space_pages - 1 - && !PAGE_ALLOCATED(last_page + 1)) { - last_page++; - num_pages++; - bytes_found += PAGE_SIZE; - gc_assert(!PAGE_WRITE_PROTECTED(last_page)); - } - - region_size = (PAGE_SIZE - page_table[first_page].bytes_used) - + PAGE_SIZE * (last_page - first_page); - - gc_assert(bytes_found == region_size); - -#if 0 - fprintf(stderr, " last_page=%d bytes_found=%d num_pages=%d\n", - last_page, bytes_found, num_pages); -#endif - - restart_page = last_page + 1; - } - while ((restart_page < dynamic_space_pages) && (bytes_found < nbytes)); - - if (first_page >= dynamic_space_pages - reserved_heap_pages) { - handle_heap_overflow("*A2 gc_alloc_large failed, nbytes=%d.\n", nbytes); - } - - /* Check for a failure */ - if (restart_page >= (dynamic_space_pages - reserved_heap_pages) && bytes_found < nbytes) { - handle_heap_overflow("*A1 gc_alloc_large failed, nbytes=%d.\n", nbytes); - } - -#if 0 - if (large) - fprintf(stderr, "gc_alloc_large gen %d: %d of %d bytes: from pages %d to %d: addr=%x\n", - gc_alloc_generation, nbytes, bytes_found, - first_page, last_page, page_address(first_page)); -#endif - - gc_assert(first_page > alloc_region->last_page); - if (unboxed) - generations[gc_alloc_generation].alloc_large_unboxed_start_page = - last_page; - else - generations[gc_alloc_generation].alloc_large_start_page = last_page; - - /* Setup the pages. */ - orig_first_page_bytes_used = page_table[first_page].bytes_used; - - /* - * If the first page was free then setup the gen, and - * first_object_offset. - */ - - if (large) - mflags |= PAGE_LARGE_OBJECT_MASK; - if (page_table[first_page].bytes_used == 0) { - PAGE_FLAGS_UPDATE(first_page, mmask, mflags); - page_table[first_page].first_object_offset = 0; - } - - gc_assert(PAGE_ALLOCATED(first_page)); - gc_assert(PAGE_UNBOXED_VAL(first_page) == unboxed); - gc_assert(PAGE_GENERATION(first_page) == gc_alloc_generation); - gc_assert(PAGE_LARGE_OBJECT_VAL(first_page) == large); - - byte_cnt = 0; - - /* - * Calc. the number of bytes used in this page. This is not - * always the number of new bytes, unless it was free. - */ - more = 0; - bytes_used = nbytes + orig_first_page_bytes_used; - if (bytes_used > PAGE_SIZE) { - bytes_used = PAGE_SIZE; - more = 1; - } - page_table[first_page].bytes_used = bytes_used; - byte_cnt += bytes_used; - - next_page = first_page + 1; - - /* - * All the rest of the pages should be free. Need to set their - * first_object_offset pointer to the start of the region, and set - * the bytes_used. - */ - while (more) { -#if 0 - fprintf(stderr, "+"); + fprintf(stderr, "gc_alloc_large for %d bytes from gen %d\n", + nbytes, gc_alloc_generation); #endif - gc_assert(!PAGE_ALLOCATED(next_page)); - gc_assert(page_table[next_page].bytes_used == 0); - PAGE_FLAGS_UPDATE(next_page, mmask, mflags); + /* + * If the object is small, and there is room in the current region + * then allocation it in the current region. + */ + if (!large && alloc_region->end_addr - alloc_region->free_pointer >= nbytes) + return gc_quick_alloc(nbytes); + + /* + * Search for a contiguous free region of at least nbytes. If it's a + * large object then align it on a page boundary by searching for a + * free page. + */ - page_table[next_page].first_object_offset = - orig_first_page_bytes_used - PAGE_SIZE * (next_page - first_page); + /* + * To allow the allocation of small objects without the danger of + * using a page in the current boxed region, the search starts after + * the current boxed free region. XX could probably keep a page + * index ahead of the current region and bumped up here to save a + * lot of re-scanning. + */ + if (unboxed) + restart_page = + generations[gc_alloc_generation].alloc_large_unboxed_start_page; + else + restart_page = generations[gc_alloc_generation].alloc_large_start_page; + if (restart_page <= alloc_region->last_page) + restart_page = alloc_region->last_page + 1; - /* Calc. the number of bytes used in this page. */ - more = 0; - bytes_used = nbytes + orig_first_page_bytes_used - byte_cnt; - if (bytes_used > PAGE_SIZE) { - bytes_used = PAGE_SIZE; - more = 1; - } - page_table[next_page].bytes_used = bytes_used; - byte_cnt += bytes_used; + /* Setup the mask and matching flags. */ - next_page++; - } + mmask = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK + | PAGE_LARGE_OBJECT_MASK | PAGE_DONT_MOVE_MASK + | PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK; + mflags = PAGE_ALLOCATED_MASK | (unboxed << PAGE_UNBOXED_SHIFT) + | gc_alloc_generation; - gc_assert(byte_cnt - orig_first_page_bytes_used == nbytes); + do { + first_page = restart_page; - bytes_allocated += nbytes; - generations[gc_alloc_generation].bytes_allocated += nbytes; + if (large) + while (first_page < dynamic_space_pages + && PAGE_ALLOCATED(first_page)) first_page++; + else + while (first_page < dynamic_space_pages) { + int flags = page_table[first_page].flags; + + if (!(flags & PAGE_ALLOCATED_MASK) + || ((flags & mmask) == mflags && + page_table[first_page].bytes_used < PAGE_SIZE - 32)) + break; + first_page++; + } - /* Add the region to the new_areas if requested. */ - if (!unboxed) - add_new_area(first_page, orig_first_page_bytes_used, nbytes); + /* Check for a failure */ + if (first_page >= dynamic_space_pages - reserved_heap_pages) { +#if 0 + handle_heap_overflow("*A2 gc_alloc_large failed, nbytes=%d.\n", + nbytes); +#else + break; +#endif + } + gc_assert(!PAGE_WRITE_PROTECTED(first_page)); - /* Bump up the last_free_page */ - if (last_page + 1 > last_free_page) { - last_free_page = last_page + 1; - set_alloc_pointer((lispobj) ((char *) heap_base + - PAGE_SIZE * last_free_page)); - } +#if 0 + fprintf(stderr, " first_page=%d bytes_used=%d\n", + first_page, page_table[first_page].bytes_used); +#endif + + last_page = first_page; + bytes_found = PAGE_SIZE - page_table[first_page].bytes_used; + num_pages = 1; + while (bytes_found < nbytes + && last_page < dynamic_space_pages - 1 + && !PAGE_ALLOCATED(last_page + 1)) { + last_page++; + num_pages++; + bytes_found += PAGE_SIZE; + gc_assert(!PAGE_WRITE_PROTECTED(last_page)); + } - return (void *) (page_address(first_page) + orig_first_page_bytes_used); -} + region_size = (PAGE_SIZE - page_table[first_page].bytes_used) + + PAGE_SIZE * (last_page - first_page); -/* - * Allocate bytes from the boxed_region. It first checks if there is - * room, if not then it calls gc_alloc_new_region to find a new region - * with enough space. A pointer to the start of the region is returned. - */ -static void *gc_alloc(int nbytes) -{ - char *new_free_pointer; + gc_assert(bytes_found == region_size); #if 0 - fprintf(stderr, "gc_alloc %d\n",nbytes); + fprintf(stderr, " last_page=%d bytes_found=%d num_pages=%d\n", + last_page, bytes_found, num_pages); #endif - /* Check if there is room in the current alloc region. */ - new_free_pointer = boxed_region.free_pointer + nbytes; + restart_page = last_page + 1; + } + while ((restart_page < dynamic_space_pages) && (bytes_found < nbytes)); - if (new_free_pointer <= boxed_region.end_addr) { - /* If so then allocate from the current alloc region. */ - char *new_obj = boxed_region.free_pointer; - boxed_region.free_pointer = new_free_pointer; + if (first_page >= dynamic_space_pages - reserved_heap_pages) { + handle_heap_overflow("*A2 gc_alloc_large failed, nbytes=%d.\n", nbytes); + } + + /* Check for a failure */ + if (restart_page >= (dynamic_space_pages - reserved_heap_pages) + && bytes_found < nbytes) { + handle_heap_overflow("*A1 gc_alloc_large failed, nbytes=%d.\n", nbytes); + } +#if 0 + if (large) + fprintf(stderr, + "gc_alloc_large gen %d: %d of %d bytes: from pages %d to %d: addr=%x\n", + gc_alloc_generation, nbytes, bytes_found, first_page, last_page, + page_address(first_page)); +#endif + + gc_assert(first_page > alloc_region->last_page); + if (unboxed) + generations[gc_alloc_generation].alloc_large_unboxed_start_page = + last_page; + else + generations[gc_alloc_generation].alloc_large_start_page = last_page; + + /* Setup the pages. */ + orig_first_page_bytes_used = page_table[first_page].bytes_used; + + /* + * If the first page was free then setup the gen, and + * first_object_offset. + */ - /* Check if the alloc region is almost empty. */ - if (boxed_region.end_addr - boxed_region.free_pointer <= 32) { - /* If so finished with the current region. */ - gc_alloc_update_page_tables(0, &boxed_region); - /* Setup a new region. */ - gc_alloc_new_region(32, 0, &boxed_region); + if (large) + mflags |= PAGE_LARGE_OBJECT_MASK; + if (page_table[first_page].bytes_used == 0) { + PAGE_FLAGS_UPDATE(first_page, mmask, mflags); + page_table[first_page].first_object_offset = 0; } - return (void *) new_obj; - } - /* Else not enough free space in the current region. */ + gc_assert(PAGE_ALLOCATED(first_page)); + gc_assert(PAGE_UNBOXED_VAL(first_page) == unboxed); + gc_assert(PAGE_GENERATION(first_page) == gc_alloc_generation); + gc_assert(PAGE_LARGE_OBJECT_VAL(first_page) == large); - /* - * If there is a bit of room left in the current region then - * allocate a large object. - */ - if (boxed_region.end_addr - boxed_region.free_pointer > 32) - return gc_alloc_large(nbytes, 0, &boxed_region); + byte_cnt = 0; - /* Else find a new region. */ + /* + * Calc. the number of bytes used in this page. This is not + * always the number of new bytes, unless it was free. + */ + more = 0; + bytes_used = nbytes + orig_first_page_bytes_used; + if (bytes_used > PAGE_SIZE) { + bytes_used = PAGE_SIZE; + more = 1; + } + page_table[first_page].bytes_used = bytes_used; + byte_cnt += bytes_used; - /* Finished with the current region. */ - gc_alloc_update_page_tables(0, &boxed_region); + next_page = first_page + 1; - /* Setup a new region. */ - gc_alloc_new_region(nbytes, 0, &boxed_region); + /* + * All the rest of the pages should be free. Need to set their + * first_object_offset pointer to the start of the region, and set + * the bytes_used. + */ + while (more) { +#if 0 + fprintf(stderr, "+"); +#endif + + gc_assert(!PAGE_ALLOCATED(next_page)); + gc_assert(page_table[next_page].bytes_used == 0); + PAGE_FLAGS_UPDATE(next_page, mmask, mflags); + + page_table[next_page].first_object_offset = + orig_first_page_bytes_used - PAGE_SIZE * (next_page - first_page); + + /* Calc. the number of bytes used in this page. */ + more = 0; + bytes_used = nbytes + orig_first_page_bytes_used - byte_cnt; + if (bytes_used > PAGE_SIZE) { + bytes_used = PAGE_SIZE; + more = 1; + } + page_table[next_page].bytes_used = bytes_used; + byte_cnt += bytes_used; + + next_page++; + } + + gc_assert(byte_cnt - orig_first_page_bytes_used == nbytes); + + bytes_allocated += nbytes; + generations[gc_alloc_generation].bytes_allocated += nbytes; + + /* Add the region to the new_areas if requested. */ + if (!unboxed) + add_new_area(first_page, orig_first_page_bytes_used, nbytes); + + /* Bump up the last_free_page */ + if (last_page + 1 > last_free_page) { + last_free_page = last_page + 1; + set_alloc_pointer((lispobj) ((char *) heap_base + + PAGE_SIZE * last_free_page)); + } + + return (void *) (page_address(first_page) + orig_first_page_bytes_used); +} + +/* + * Allocate bytes from the boxed_region. It first checks if there is + * room, if not then it calls gc_alloc_new_region to find a new region + * with enough space. A pointer to the start of the region is returned. + */ +static void * +gc_alloc(int nbytes) +{ + char *new_free_pointer; - /* Should now be enough room. */ +#if 0 + fprintf(stderr, "gc_alloc %d\n", nbytes); +#endif - /* Check if there is room in the current region. */ - new_free_pointer = boxed_region.free_pointer + nbytes; + /* Check if there is room in the current alloc region. */ + new_free_pointer = boxed_region.free_pointer + nbytes; - if (new_free_pointer <= boxed_region.end_addr) { - /* If so then allocate from the current region. */ - void *new_obj = boxed_region.free_pointer; - boxed_region.free_pointer = new_free_pointer; + if (new_free_pointer <= boxed_region.end_addr) { + /* If so then allocate from the current alloc region. */ + char *new_obj = boxed_region.free_pointer; - /* Check if the current region is almost empty. */ - if (boxed_region.end_addr - boxed_region.free_pointer <= 32) { - /* If so find, finished with the current region. */ - gc_alloc_update_page_tables(0, &boxed_region); + boxed_region.free_pointer = new_free_pointer; - /* Setup a new region. */ - gc_alloc_new_region(32, 0, &boxed_region); + /* Check if the alloc region is almost empty. */ + if (boxed_region.end_addr - boxed_region.free_pointer <= 32) { + /* If so finished with the current region. */ + gc_alloc_update_page_tables(0, &boxed_region); + /* Setup a new region. */ + gc_alloc_new_region(32, 0, &boxed_region); + } + return (void *) new_obj; } - return (void *) new_obj; - } + /* Else not enough free space in the current region. */ + + /* + * If there is a bit of room left in the current region then + * allocate a large object. + */ + if (boxed_region.end_addr - boxed_region.free_pointer > 32) + return gc_alloc_large(nbytes, 0, &boxed_region); + + /* Else find a new region. */ + + /* Finished with the current region. */ + gc_alloc_update_page_tables(0, &boxed_region); + + /* Setup a new region. */ + gc_alloc_new_region(nbytes, 0, &boxed_region); + + /* Should now be enough room. */ + + /* Check if there is room in the current region. */ + new_free_pointer = boxed_region.free_pointer + nbytes; + + if (new_free_pointer <= boxed_region.end_addr) { + /* If so then allocate from the current region. */ + void *new_obj = boxed_region.free_pointer; + + boxed_region.free_pointer = new_free_pointer; - /* Shouldn't happen? */ - gc_assert(0); - return 0; + /* Check if the current region is almost empty. */ + if (boxed_region.end_addr - boxed_region.free_pointer <= 32) { + /* If so find, finished with the current region. */ + gc_alloc_update_page_tables(0, &boxed_region); + + /* Setup a new region. */ + gc_alloc_new_region(32, 0, &boxed_region); + } + + return (void *) new_obj; + } + + /* Shouldn't happen? */ + gc_assert(0); + return 0; } /* @@ -1538,22 +1571,24 @@ static void *gc_alloc(int nbytes) * space then call gc_alloc to do the job. A pointer to the start of * the region is returned. */ -static inline void *gc_quick_alloc(int nbytes) +static inline void * +gc_quick_alloc(int nbytes) { - char *new_free_pointer; + char *new_free_pointer; - /* Check if there is room in the current region. */ - new_free_pointer = boxed_region.free_pointer + nbytes; + /* Check if there is room in the current region. */ + new_free_pointer = boxed_region.free_pointer + nbytes; - if (new_free_pointer <= boxed_region.end_addr) { - /* If so then allocate from the current region. */ - void *new_obj = boxed_region.free_pointer; - boxed_region.free_pointer = new_free_pointer; - return (void *) new_obj; - } + if (new_free_pointer <= boxed_region.end_addr) { + /* If so then allocate from the current region. */ + void *new_obj = boxed_region.free_pointer; + + boxed_region.free_pointer = new_free_pointer; + return (void *) new_obj; + } - /* Else call gc_alloc */ - return gc_alloc(nbytes); + /* Else call gc_alloc */ + return gc_alloc(nbytes); } /* @@ -1562,119 +1597,126 @@ static inline void *gc_quick_alloc(int nbytes) * not enough free space then call gc_alloc to do the job. A pointer * to the start of the region is returned. */ -static inline void *gc_quick_alloc_large(int nbytes) +static inline void * +gc_quick_alloc_large(int nbytes) { - char *new_free_pointer; + char *new_free_pointer; - if (nbytes >= large_object_size) - return gc_alloc_large(nbytes,0,&boxed_region); + if (nbytes >= large_object_size) + return gc_alloc_large(nbytes, 0, &boxed_region); - /* Check if there is room in the current region. */ - new_free_pointer = boxed_region.free_pointer + nbytes; + /* Check if there is room in the current region. */ + new_free_pointer = boxed_region.free_pointer + nbytes; - if (new_free_pointer <= boxed_region.end_addr) { - /* If so then allocate from the current region. */ - void *new_obj = boxed_region.free_pointer; - boxed_region.free_pointer = new_free_pointer; - return (void *) new_obj; - } + if (new_free_pointer <= boxed_region.end_addr) { + /* If so then allocate from the current region. */ + void *new_obj = boxed_region.free_pointer; - /* Else call gc_alloc */ - return gc_alloc(nbytes); + boxed_region.free_pointer = new_free_pointer; + return (void *) new_obj; + } + + /* Else call gc_alloc */ + return gc_alloc(nbytes); } -static void *gc_alloc_unboxed(int nbytes) +static void * +gc_alloc_unboxed(int nbytes) { - char *new_free_pointer; + char *new_free_pointer; #if 0 - fprintf(stderr, "gc_alloc_unboxed %d\n",nbytes); + fprintf(stderr, "gc_alloc_unboxed %d\n", nbytes); #endif - /* Check if there is room in the current region. */ - new_free_pointer = unboxed_region.free_pointer + nbytes; + /* Check if there is room in the current region. */ + new_free_pointer = unboxed_region.free_pointer + nbytes; - if (new_free_pointer <= unboxed_region.end_addr) { - /* If so then allocate from the current region. */ - void *new_obj = unboxed_region.free_pointer; - unboxed_region.free_pointer = new_free_pointer; + if (new_free_pointer <= unboxed_region.end_addr) { + /* If so then allocate from the current region. */ + void *new_obj = unboxed_region.free_pointer; - /* Check if the current region is almost empty. */ - if ((unboxed_region.end_addr - unboxed_region.free_pointer) <= 32) { - /* If so finished with the current region. */ - gc_alloc_update_page_tables(1, &unboxed_region); + unboxed_region.free_pointer = new_free_pointer; - /* Setup a new region. */ - gc_alloc_new_region(32, 1, &unboxed_region); + /* Check if the current region is almost empty. */ + if ((unboxed_region.end_addr - unboxed_region.free_pointer) <= 32) { + /* If so finished with the current region. */ + gc_alloc_update_page_tables(1, &unboxed_region); + + /* Setup a new region. */ + gc_alloc_new_region(32, 1, &unboxed_region); + } + + return (void *) new_obj; } - return (void *) new_obj; - } + /* Else not enough free space in the current region. */ - /* Else not enough free space in the current region. */ + /* + * If there is a bit of room left in the current region then + * allocate a large object. + */ + if (unboxed_region.end_addr - unboxed_region.free_pointer > 32) + return gc_alloc_large(nbytes, 1, &unboxed_region); - /* - * If there is a bit of room left in the current region then - * allocate a large object. - */ - if (unboxed_region.end_addr - unboxed_region.free_pointer > 32) - return gc_alloc_large(nbytes, 1, &unboxed_region); + /* Else find a new region. */ - /* Else find a new region. */ + /* Finished with the current region. */ + gc_alloc_update_page_tables(1, &unboxed_region); - /* Finished with the current region. */ - gc_alloc_update_page_tables(1,&unboxed_region); + /* Setup a new region. */ + gc_alloc_new_region(nbytes, 1, &unboxed_region); - /* Setup a new region. */ - gc_alloc_new_region(nbytes,1,&unboxed_region); + /* Should now be enough room. */ - /* Should now be enough room. */ + /* Check if there is room in the current region. */ + new_free_pointer = unboxed_region.free_pointer + nbytes; - /* Check if there is room in the current region. */ - new_free_pointer = unboxed_region.free_pointer + nbytes; + if (new_free_pointer <= unboxed_region.end_addr) { + /* If so then allocate from the current region. */ + void *new_obj = unboxed_region.free_pointer; - if (new_free_pointer <= unboxed_region.end_addr) { - /* If so then allocate from the current region. */ - void *new_obj = unboxed_region.free_pointer; - unboxed_region.free_pointer = new_free_pointer; + unboxed_region.free_pointer = new_free_pointer; - /* Check if the current region is almost empty. */ - if ((unboxed_region.end_addr - unboxed_region.free_pointer) <= 32) { - /* If so find, finished with the current region. */ - gc_alloc_update_page_tables(1, &unboxed_region); + /* Check if the current region is almost empty. */ + if ((unboxed_region.end_addr - unboxed_region.free_pointer) <= 32) { + /* If so find, finished with the current region. */ + gc_alloc_update_page_tables(1, &unboxed_region); - /* Setup a new region. */ - gc_alloc_new_region(32, 1, &unboxed_region); - } + /* Setup a new region. */ + gc_alloc_new_region(32, 1, &unboxed_region); + } - return (void *) new_obj; - } + return (void *) new_obj; + } - /* Shouldn't happen? */ - gc_assert(0); - return 0; + /* Shouldn't happen? */ + gc_assert(0); + return 0; } -static inline void *gc_quick_alloc_unboxed(int nbytes) +static inline void * +gc_quick_alloc_unboxed(int nbytes) { - char *new_free_pointer; + char *new_free_pointer; + + /* Check if there is room in the current region. */ + new_free_pointer = unboxed_region.free_pointer + nbytes; - /* Check if there is room in the current region. */ - new_free_pointer = unboxed_region.free_pointer + nbytes; + if (new_free_pointer <= unboxed_region.end_addr) { + /* If so then allocate from the current region. */ + void *new_obj = unboxed_region.free_pointer; - if (new_free_pointer <= unboxed_region.end_addr) { - /* If so then allocate from the current region. */ - void *new_obj = unboxed_region.free_pointer; - unboxed_region.free_pointer = new_free_pointer; + unboxed_region.free_pointer = new_free_pointer; - return (void *) new_obj; + return (void *) new_obj; } - /* Else call gc_alloc */ - return gc_alloc_unboxed(nbytes); + /* Else call gc_alloc */ + return gc_alloc_unboxed(nbytes); } /* @@ -1684,96 +1726,105 @@ static inline void *gc_quick_alloc_unboxed(int nbytes) * * A pointer to the start of the region is returned. */ -static inline void *gc_quick_alloc_large_unboxed(int nbytes) +static inline void * +gc_quick_alloc_large_unboxed(int nbytes) { - char *new_free_pointer; + char *new_free_pointer; - if (nbytes >= large_object_size) - return gc_alloc_large(nbytes,1,&unboxed_region); + if (nbytes >= large_object_size) + return gc_alloc_large(nbytes, 1, &unboxed_region); - /* Check if there is room in the current region. */ - new_free_pointer = unboxed_region.free_pointer + nbytes; + /* Check if there is room in the current region. */ + new_free_pointer = unboxed_region.free_pointer + nbytes; - if (new_free_pointer <= unboxed_region.end_addr) { - /* If so then allocate from the current region. */ - void *new_obj = unboxed_region.free_pointer; - unboxed_region.free_pointer = new_free_pointer; + if (new_free_pointer <= unboxed_region.end_addr) { + /* If so then allocate from the current region. */ + void *new_obj = unboxed_region.free_pointer; - return (void *) new_obj; - } + unboxed_region.free_pointer = new_free_pointer; + + return (void *) new_obj; + } - /* Else call gc_alloc */ - return gc_alloc_unboxed(nbytes); + /* Else call gc_alloc */ + return gc_alloc_unboxed(nbytes); } /***************************************************************************/ - + /* Scavenging/transporting routines derived from gc.c */ -static int (*scavtab[256])(lispobj *where, lispobj object); -static lispobj (*transother[256])(lispobj object); -static int (*sizetab[256])(lispobj *where); +static int (*scavtab[256]) (lispobj * where, lispobj object); +static lispobj(*transother[256]) (lispobj object); +static int (*sizetab[256]) (lispobj * where); static struct weak_pointer *weak_pointers; static struct scavenger_hook *scavenger_hooks = (struct scavenger_hook *) NIL; #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1))) - + /* Predicates */ -static inline boolean from_space_p(lispobj obj) +static inline boolean +from_space_p(lispobj obj) { - int page_index = (char*) obj - heap_base; - return page_index >= 0 - && (page_index = (unsigned int) page_index / PAGE_SIZE) < dynamic_space_pages - && PAGE_GENERATION(page_index) == from_space; + int page_index = (char *) obj - heap_base; + + return page_index >= 0 + && (page_index = + (unsigned int) page_index / PAGE_SIZE) < dynamic_space_pages + && PAGE_GENERATION(page_index) == from_space; } -static inline boolean new_space_p(lispobj obj) +static inline boolean +new_space_p(lispobj obj) { - int page_index = (char*) obj - heap_base; - return page_index >= 0 - && (page_index = (unsigned int) page_index / PAGE_SIZE) < dynamic_space_pages - && PAGE_GENERATION(page_index) == new_space; -} + int page_index = (char *) obj - heap_base; + return page_index >= 0 + && (page_index = + (unsigned int) page_index / PAGE_SIZE) < dynamic_space_pages + && PAGE_GENERATION(page_index) == new_space; +} + /* Copying Objects */ /* Copying Boxed Objects */ -static inline lispobj copy_object(lispobj object, int nwords) +static inline lispobj +copy_object(lispobj object, int nwords) { - int tag; - lispobj *new; - lispobj *source, *dest; + int tag; + lispobj *new; + lispobj *source, *dest; - gc_assert(Pointerp(object)); - gc_assert(from_space_p(object)); - gc_assert((nwords & 0x01) == 0); + gc_assert(Pointerp(object)); + gc_assert(from_space_p(object)); + gc_assert((nwords & 0x01) == 0); - /* get tag of object */ - tag = LowtagOf(object); + /* get tag of object */ + tag = LowtagOf(object); - /* allocate space */ - new = gc_quick_alloc(nwords*sizeof(lispobj)); + /* allocate space */ + new = gc_quick_alloc(nwords * sizeof(lispobj)); - dest = new; - source = (lispobj *) PTR(object); + dest = new; + source = (lispobj *) PTR(object); - /* copy the object */ - while (nwords > 0) { - dest[0] = source[0]; - dest[1] = source[1]; - dest += 2; - source += 2; - nwords -= 2; - } + /* copy the object */ + while (nwords > 0) { + dest[0] = source[0]; + dest[1] = source[1]; + dest += 2; + source += 2; + nwords -= 2; + } - /* return lisp pointer of new object */ - return (lispobj) new | tag; + /* return lisp pointer of new object */ + return (lispobj) new | tag; } /* @@ -1784,177 +1835,180 @@ static inline lispobj copy_object(lispobj object, int nwords) * Vectors may have shrunk. If the object is not copied the space * needs to be reclaimed, and the page_tables corrected. */ -static lispobj copy_large_object(lispobj object, int nwords) +static lispobj +copy_large_object(lispobj object, int nwords) { - int tag; - lispobj *new; - lispobj *source, *dest; - int first_page; + int tag; + lispobj *new; + lispobj *source, *dest; + int first_page; - gc_assert(Pointerp(object)); - gc_assert(from_space_p(object)); - gc_assert((nwords & 0x01) == 0); + gc_assert(Pointerp(object)); + gc_assert(from_space_p(object)); + gc_assert((nwords & 0x01) == 0); - if (gencgc_verbose && nwords > 1024 * 1024) - fprintf(stderr, "** copy_large_object: %d\n", nwords * sizeof(lispobj)); + if (gencgc_verbose && nwords > 1024 * 1024) + fprintf(stderr, "** copy_large_object: %d\n", nwords * sizeof(lispobj)); - /* Check if it's a large object. */ - first_page = find_page_index((void *) object); - gc_assert(first_page >= 0); + /* Check if it's a large object. */ + first_page = find_page_index((void *) object); + gc_assert(first_page >= 0); - if (PAGE_LARGE_OBJECT(first_page)) { - /* Promote the object. */ - int remaining_bytes; - int next_page; - int bytes_freed; - int old_bytes_used; - int mmask, mflags; + if (PAGE_LARGE_OBJECT(first_page)) { + /* Promote the object. */ + int remaining_bytes; + int next_page; + int bytes_freed; + int old_bytes_used; + int mmask, mflags; - /* - * Note: Any page write protection must be removed, else a later - * scavenge_newspace may incorrectly not scavenge these pages. - * This would not be necessary if they are added to the new areas, - * but lets do it for them all (they'll probably be written - * anyway?). - */ + /* + * Note: Any page write protection must be removed, else a later + * scavenge_newspace may incorrectly not scavenge these pages. + * This would not be necessary if they are added to the new areas, + * but lets do it for them all (they'll probably be written + * anyway?). + */ - gc_assert(page_table[first_page].first_object_offset == 0); + gc_assert(page_table[first_page].first_object_offset == 0); - next_page = first_page; - remaining_bytes = nwords * sizeof(lispobj); - while (remaining_bytes > PAGE_SIZE) { - gc_assert(PAGE_GENERATION(next_page) == from_space); - gc_assert(PAGE_ALLOCATED(next_page)); - gc_assert(!PAGE_UNBOXED(next_page)); - gc_assert(PAGE_LARGE_OBJECT(next_page)); - gc_assert(page_table[next_page].first_object_offset == - PAGE_SIZE * (first_page - next_page)); - gc_assert(page_table[next_page].bytes_used == PAGE_SIZE); - - PAGE_FLAGS_UPDATE(next_page, PAGE_GENERATION_MASK, new_space); - - /* - * Remove any write protection. Should be able to religh on the - * WP flag to avoid redundant calls. - */ - if (PAGE_WRITE_PROTECTED(next_page)) { - os_protect((os_vm_address_t) page_address(next_page), PAGE_SIZE, OS_VM_PROT_ALL); - page_table[next_page].flags &= ~PAGE_WRITE_PROTECTED_MASK; - } - remaining_bytes -= PAGE_SIZE; - next_page++; - } + next_page = first_page; + remaining_bytes = nwords * sizeof(lispobj); + while (remaining_bytes > PAGE_SIZE) { + gc_assert(PAGE_GENERATION(next_page) == from_space); + gc_assert(PAGE_ALLOCATED(next_page)); + gc_assert(!PAGE_UNBOXED(next_page)); + gc_assert(PAGE_LARGE_OBJECT(next_page)); + gc_assert(page_table[next_page].first_object_offset == + PAGE_SIZE * (first_page - next_page)); + gc_assert(page_table[next_page].bytes_used == PAGE_SIZE); - /* - * Now only one page remains, but the object may have shrunk so - * there may be more unused pages which will be freed. - */ + PAGE_FLAGS_UPDATE(next_page, PAGE_GENERATION_MASK, new_space); - /* Object may have shrunk but shouldn't have grown - check. */ - gc_assert(page_table[next_page].bytes_used >= remaining_bytes); + /* + * Remove any write protection. Should be able to religh on the + * WP flag to avoid redundant calls. + */ + if (PAGE_WRITE_PROTECTED(next_page)) { + os_protect((os_vm_address_t) page_address(next_page), PAGE_SIZE, + OS_VM_PROT_ALL); + page_table[next_page].flags &= ~PAGE_WRITE_PROTECTED_MASK; + } + remaining_bytes -= PAGE_SIZE; + next_page++; + } - PAGE_FLAGS_UPDATE(next_page, PAGE_GENERATION_MASK, new_space); - gc_assert(PAGE_ALLOCATED(next_page)); - gc_assert(!PAGE_UNBOXED(next_page)); + /* + * Now only one page remains, but the object may have shrunk so + * there may be more unused pages which will be freed. + */ - /* Adjust the bytes_used. */ - old_bytes_used = page_table[next_page].bytes_used; - page_table[next_page].bytes_used = remaining_bytes; + /* Object may have shrunk but shouldn't have grown - check. */ + gc_assert(page_table[next_page].bytes_used >= remaining_bytes); - bytes_freed = old_bytes_used - remaining_bytes; + PAGE_FLAGS_UPDATE(next_page, PAGE_GENERATION_MASK, new_space); + gc_assert(PAGE_ALLOCATED(next_page)); + gc_assert(!PAGE_UNBOXED(next_page)); - mmask = PAGE_ALLOCATED_MASK | PAGE_UNBOXED_MASK | PAGE_LARGE_OBJECT_MASK - | PAGE_GENERATION_MASK; - mflags = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK | from_space; + /* Adjust the bytes_used. */ + old_bytes_used = page_table[next_page].bytes_used; + page_table[next_page].bytes_used = remaining_bytes; - /* Free any remaining pages; needs care. */ - next_page++; - while (old_bytes_used == PAGE_SIZE && - PAGE_FLAGS(next_page, mmask) == mflags && - page_table[next_page].first_object_offset == PAGE_SIZE * (first_page - - next_page)) { - /* - * Checks out OK, free the page. Don't need to both zeroing - * pages as this should have been done before shrinking the - * object. These pages shouldn't be write protected as they - * should be zero filled. - */ - gc_assert(!PAGE_WRITE_PROTECTED(next_page)); - - old_bytes_used = page_table[next_page].bytes_used; - page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK; - page_table[next_page].bytes_used = 0; - bytes_freed += old_bytes_used; - next_page++; - } + bytes_freed = old_bytes_used - remaining_bytes; - if (gencgc_verbose && bytes_freed > 0) - fprintf(stderr, "* copy_large_boxed bytes_freed %d\n", bytes_freed); + mmask = PAGE_ALLOCATED_MASK | PAGE_UNBOXED_MASK | PAGE_LARGE_OBJECT_MASK + | PAGE_GENERATION_MASK; + mflags = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK | from_space; - generations[from_space].bytes_allocated -= sizeof(lispobj) * nwords + bytes_freed; - generations[new_space].bytes_allocated += sizeof(lispobj) * nwords; - bytes_allocated -= bytes_freed; + /* Free any remaining pages; needs care. */ + next_page++; + while (old_bytes_used == PAGE_SIZE && + PAGE_FLAGS(next_page, mmask) == mflags && + page_table[next_page].first_object_offset == + PAGE_SIZE * (first_page - next_page)) { + /* + * Checks out OK, free the page. Don't need to both zeroing + * pages as this should have been done before shrinking the + * object. These pages shouldn't be write protected as they + * should be zero filled. + */ + gc_assert(!PAGE_WRITE_PROTECTED(next_page)); - /* Add the region to the new_areas if requested. */ - add_new_area(first_page, 0, nwords * sizeof(lispobj)); + old_bytes_used = page_table[next_page].bytes_used; + page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK; + page_table[next_page].bytes_used = 0; + bytes_freed += old_bytes_used; + next_page++; + } - return object; - } - else { - /* get tag of object */ - tag = LowtagOf(object); + if (gencgc_verbose && bytes_freed > 0) + fprintf(stderr, "* copy_large_boxed bytes_freed %d\n", bytes_freed); - /* allocate space */ - new = gc_quick_alloc_large(nwords * sizeof(lispobj)); + generations[from_space].bytes_allocated -= + sizeof(lispobj) * nwords + bytes_freed; + generations[new_space].bytes_allocated += sizeof(lispobj) * nwords; + bytes_allocated -= bytes_freed; - dest = new; - source = (lispobj *) PTR(object); + /* Add the region to the new_areas if requested. */ + add_new_area(first_page, 0, nwords * sizeof(lispobj)); - /* copy the object */ - while (nwords > 0) { - dest[0] = source[0]; - dest[1] = source[1]; - dest += 2; - source += 2; - nwords -= 2; - } + return object; + } else { + /* get tag of object */ + tag = LowtagOf(object); + + /* allocate space */ + new = gc_quick_alloc_large(nwords * sizeof(lispobj)); + + dest = new; + source = (lispobj *) PTR(object); + + /* copy the object */ + while (nwords > 0) { + dest[0] = source[0]; + dest[1] = source[1]; + dest += 2; + source += 2; + nwords -= 2; + } - /* return lisp pointer of new object */ - return (lispobj) new | tag; - } + /* return lisp pointer of new object */ + return (lispobj) new | tag; + } } /* Copying UnBoxed Objects. */ -static inline lispobj copy_unboxed_object(lispobj object, int nwords) +static inline lispobj +copy_unboxed_object(lispobj object, int nwords) { - int tag; - lispobj *new; - lispobj *source, *dest; + int tag; + lispobj *new; + lispobj *source, *dest; - gc_assert(Pointerp(object)); - gc_assert(from_space_p(object)); - gc_assert((nwords & 0x01) == 0); + gc_assert(Pointerp(object)); + gc_assert(from_space_p(object)); + gc_assert((nwords & 0x01) == 0); - /* get tag of object */ - tag = LowtagOf(object); + /* get tag of object */ + tag = LowtagOf(object); - /* allocate space */ - new = gc_quick_alloc_unboxed(nwords*sizeof(lispobj)); + /* allocate space */ + new = gc_quick_alloc_unboxed(nwords * sizeof(lispobj)); - dest = new; - source = (lispobj *) PTR(object); + dest = new; + source = (lispobj *) PTR(object); - /* Copy the object */ - while (nwords > 0) { - dest[0] = source[0]; - dest[1] = source[1]; - dest += 2; - source += 2; - nwords -= 2; - } + /* Copy the object */ + while (nwords > 0) { + dest[0] = source[0]; + dest[1] = source[1]; + dest += 2; + source += 2; + nwords -= 2; + } - /* Return lisp pointer of new object. */ - return (lispobj) new | tag; + /* Return lisp pointer of new object. */ + return (lispobj) new | tag; } @@ -1966,131 +2020,135 @@ static inline lispobj copy_unboxed_object(lispobj object, int nwords) * Bignums and vectors may have shrunk. If the object is not copied * the space needs to be reclaimed, and the page_tables corrected. */ -static lispobj copy_large_unboxed_object(lispobj object, int nwords) +static lispobj +copy_large_unboxed_object(lispobj object, int nwords) { - int tag; - lispobj *new; - lispobj *source, *dest; - int first_page; - - gc_assert(Pointerp(object)); - gc_assert(from_space_p(object)); - gc_assert((nwords & 0x01) == 0); + int tag; + lispobj *new; + lispobj *source, *dest; + int first_page; - if (gencgc_verbose && nwords > 1024 * 1024) - fprintf(stderr, "** copy_large_unboxed_object: %d\n", nwords * sizeof(lispobj)); + gc_assert(Pointerp(object)); + gc_assert(from_space_p(object)); + gc_assert((nwords & 0x01) == 0); - /* Check if it's a large object. */ - first_page = find_page_index((void *) object); - gc_assert(first_page >= 0); + if (gencgc_verbose && nwords > 1024 * 1024) + fprintf(stderr, "** copy_large_unboxed_object: %d\n", + nwords * sizeof(lispobj)); - if (PAGE_LARGE_OBJECT(first_page)) { - /* - * Promote the object. Note: Unboxed objects may have been - * allocated to a BOXED region so it may be necessary to change - * the region to UNBOXED. - */ - int remaining_bytes; - int next_page; - int bytes_freed; - int old_bytes_used; - int mmask, mflags; - - gc_assert(page_table[first_page].first_object_offset == 0); + /* Check if it's a large object. */ + first_page = find_page_index((void *) object); + gc_assert(first_page >= 0); - next_page = first_page; - remaining_bytes = nwords * sizeof(lispobj); - while (remaining_bytes > PAGE_SIZE) { - gc_assert(PAGE_GENERATION(next_page) == from_space); - gc_assert(PAGE_ALLOCATED(next_page)); - gc_assert(PAGE_LARGE_OBJECT(next_page)); - gc_assert(page_table[next_page].first_object_offset == - PAGE_SIZE * (first_page - next_page)); - gc_assert(page_table[next_page].bytes_used == PAGE_SIZE); - - PAGE_FLAGS_UPDATE(next_page, PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK, - PAGE_UNBOXED_MASK | new_space); - remaining_bytes -= PAGE_SIZE; - next_page++; - } - - /* - * Now only one page remains, but the object may have shrunk so - * there may be more unused pages which will be freed. - */ + if (PAGE_LARGE_OBJECT(first_page)) { + /* + * Promote the object. Note: Unboxed objects may have been + * allocated to a BOXED region so it may be necessary to change + * the region to UNBOXED. + */ + int remaining_bytes; + int next_page; + int bytes_freed; + int old_bytes_used; + int mmask, mflags; + + gc_assert(page_table[first_page].first_object_offset == 0); + + next_page = first_page; + remaining_bytes = nwords * sizeof(lispobj); + while (remaining_bytes > PAGE_SIZE) { + gc_assert(PAGE_GENERATION(next_page) == from_space); + gc_assert(PAGE_ALLOCATED(next_page)); + gc_assert(PAGE_LARGE_OBJECT(next_page)); + gc_assert(page_table[next_page].first_object_offset == + PAGE_SIZE * (first_page - next_page)); + gc_assert(page_table[next_page].bytes_used == PAGE_SIZE); + + PAGE_FLAGS_UPDATE(next_page, + PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK, + PAGE_UNBOXED_MASK | new_space); + remaining_bytes -= PAGE_SIZE; + next_page++; + } - /* Object may have shrunk but shouldn't have grown - check. */ - gc_assert(page_table[next_page].bytes_used >= remaining_bytes); + /* + * Now only one page remains, but the object may have shrunk so + * there may be more unused pages which will be freed. + */ - PAGE_FLAGS_UPDATE(next_page, PAGE_ALLOCATED_MASK | PAGE_UNBOXED_MASK - | PAGE_GENERATION_MASK, - PAGE_ALLOCATED_MASK | PAGE_UNBOXED_MASK | new_space); + /* Object may have shrunk but shouldn't have grown - check. */ + gc_assert(page_table[next_page].bytes_used >= remaining_bytes); - /* Adjust the bytes_used. */ - old_bytes_used = page_table[next_page].bytes_used; - page_table[next_page].bytes_used = remaining_bytes; + PAGE_FLAGS_UPDATE(next_page, PAGE_ALLOCATED_MASK | PAGE_UNBOXED_MASK + | PAGE_GENERATION_MASK, + PAGE_ALLOCATED_MASK | PAGE_UNBOXED_MASK | new_space); - bytes_freed = old_bytes_used - remaining_bytes; + /* Adjust the bytes_used. */ + old_bytes_used = page_table[next_page].bytes_used; + page_table[next_page].bytes_used = remaining_bytes; - mmask = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK - | PAGE_GENERATION_MASK; - mflags = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK | from_space; + bytes_freed = old_bytes_used - remaining_bytes; - /* Free any remaining pages; needs care. */ - next_page++; - while (old_bytes_used == PAGE_SIZE && - PAGE_FLAGS(next_page, mmask) == mflags && - page_table[next_page].first_object_offset == PAGE_SIZE * (first_page - - next_page)) { - /* - * Checks out OK, free the page. Don't need to both zeroing - * pages as this should have been done before shrinking the - * object. These pages shouldn't be write protected, even if - * boxed they should be zero filled. - */ - gc_assert(!PAGE_WRITE_PROTECTED(next_page)); - - old_bytes_used = page_table[next_page].bytes_used; - page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK; - page_table[next_page].bytes_used = 0; - bytes_freed += old_bytes_used; - next_page++; - } + mmask = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK + | PAGE_GENERATION_MASK; + mflags = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK | from_space; - if (gencgc_verbose && bytes_freed > 0) - fprintf(stderr, "* copy_large_unboxed bytes_freed %d\n", bytes_freed); + /* Free any remaining pages; needs care. */ + next_page++; + while (old_bytes_used == PAGE_SIZE && + PAGE_FLAGS(next_page, mmask) == mflags && + page_table[next_page].first_object_offset == + PAGE_SIZE * (first_page - next_page)) { + /* + * Checks out OK, free the page. Don't need to both zeroing + * pages as this should have been done before shrinking the + * object. These pages shouldn't be write protected, even if + * boxed they should be zero filled. + */ + gc_assert(!PAGE_WRITE_PROTECTED(next_page)); - generations[from_space].bytes_allocated -= sizeof(lispobj) * nwords + bytes_freed; - generations[new_space].bytes_allocated += sizeof(lispobj) * nwords; - bytes_allocated -= bytes_freed; + old_bytes_used = page_table[next_page].bytes_used; + page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK; + page_table[next_page].bytes_used = 0; + bytes_freed += old_bytes_used; + next_page++; + } - return object; - } - else { - /* get tag of object */ - tag = LowtagOf(object); + if (gencgc_verbose && bytes_freed > 0) + fprintf(stderr, "* copy_large_unboxed bytes_freed %d\n", + bytes_freed); - /* allocate space */ - new = gc_quick_alloc_large_unboxed(nwords * sizeof(lispobj)); + generations[from_space].bytes_allocated -= + sizeof(lispobj) * nwords + bytes_freed; + generations[new_space].bytes_allocated += sizeof(lispobj) * nwords; + bytes_allocated -= bytes_freed; - dest = new; - source = (lispobj *) PTR(object); + return object; + } else { + /* get tag of object */ + tag = LowtagOf(object); + + /* allocate space */ + new = gc_quick_alloc_large_unboxed(nwords * sizeof(lispobj)); + + dest = new; + source = (lispobj *) PTR(object); + + /* copy the object */ + while (nwords > 0) { + dest[0] = source[0]; + dest[1] = source[1]; + dest += 2; + source += 2; + nwords -= 2; + } - /* copy the object */ - while (nwords > 0) { - dest[0] = source[0]; - dest[1] = source[1]; - dest += 2; - source += 2; - nwords -= 2; + /* return lisp pointer of new object */ + return (lispobj) new | tag; } - - /* return lisp pointer of new object */ - return (lispobj) new | tag; - } } - + /* Scavenging */ /* @@ -2107,175 +2165,168 @@ static lispobj copy_large_unboxed_object(lispobj object, int nwords) #define DIRECT_SCAV 0 static void -scavenge (void *start_obj, long nwords) +scavenge(void *start_obj, long nwords) { - lispobj* start; + lispobj *start; - start = (lispobj*) start_obj; - - while (nwords > 0) - { - lispobj object; - int words_scavenged; + start = (lispobj *) start_obj; - object = *start; - /* Not a forwarding pointer. */ - gc_assert (object != 0x01); + while (nwords > 0) { + lispobj object; + int words_scavenged; + + object = *start; + /* Not a forwarding pointer. */ + gc_assert(object != 0x01); #if DIRECT_SCAV - words_scavenged = scavtab[TypeOf (object)] (start, object); -#else /* not DIRECT_SCAV */ - if (Pointerp (object)) - { + words_scavenged = scavtab[TypeOf(object)] (start, object); +#else /* not DIRECT_SCAV */ + if (Pointerp(object)) { #ifdef GC_ASSERTIONS - check_escaped_stack_object (start, object); + check_escaped_stack_object(start, object); #endif - - if (from_space_p (object)) - { - lispobj *ptr = (lispobj *) PTR (object); - lispobj first_word = *ptr; - if (first_word == 0x01) - { - *start = ptr[1]; - words_scavenged = 1; - } - else - words_scavenged = scavtab[TypeOf (object)] (start, object); - } - else + if (from_space_p(object)) { + lispobj *ptr = (lispobj *) PTR(object); + lispobj first_word = *ptr; + + if (first_word == 0x01) { + *start = ptr[1]; + words_scavenged = 1; + } else + words_scavenged = scavtab[TypeOf(object)] (start, object); + } else + words_scavenged = 1; + } else if ((object & 3) == 0) words_scavenged = 1; - } - else if ((object & 3) == 0) - words_scavenged = 1; - else - words_scavenged = scavtab[TypeOf (object)] (start, object); + else + words_scavenged = scavtab[TypeOf(object)] (start, object); #endif /* not DIRECT_SCAV */ - start += words_scavenged; - nwords -= words_scavenged; + start += words_scavenged; + nwords -= words_scavenged; } - - gc_assert (nwords == 0); -} + gc_assert(nwords == 0); +} + #if !(defined(i386) || defined(__x86_64)) /* Scavenging Interrupt Contexts */ static int boxed_registers[] = BOXED_REGISTERS; -static void scavenge_interrupt_context(os_context_t *context) +static void +scavenge_interrupt_context(os_context_t * context) { - int i; + int i; + #ifdef reg_LIP - unsigned long lip; - unsigned long lip_offset; - int lip_register_pair; + unsigned long lip; + unsigned long lip_offset; + int lip_register_pair; #endif - unsigned long pc_code_offset; + unsigned long pc_code_offset; + #ifdef SC_NPC - unsigned long npc_code_offset; + unsigned long npc_code_offset; #endif #ifdef reg_LIP - /* Find the LIP's register pair and calculate it's offset */ - /* before we scavenge the context. */ - - /* - * I (RLT) think this is trying to find the boxed register that is - * closest to the LIP address, without going past it. Usually, it's - * reg_CODE or reg_LRA. But sometimes, nothing can be found. - */ - lip = SC_REG(context, reg_LIP); - lip_offset = 0x7FFFFFFF; - lip_register_pair = -1; - for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) - { - unsigned long reg; - long offset; - int index; - - index = boxed_registers[i]; - reg = SC_REG(context, index); - if (Pointerp(reg) && PTR(reg) <= lip) { - offset = lip - reg; - if (offset < lip_offset) { - lip_offset = offset; - lip_register_pair = index; - } - } + /* Find the LIP's register pair and calculate it's offset */ + /* before we scavenge the context. */ + + /* + * I (RLT) think this is trying to find the boxed register that is + * closest to the LIP address, without going past it. Usually, it's + * reg_CODE or reg_LRA. But sometimes, nothing can be found. + */ + lip = SC_REG(context, reg_LIP); + lip_offset = 0x7FFFFFFF; + lip_register_pair = -1; + for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) { + unsigned long reg; + long offset; + int index; + + index = boxed_registers[i]; + reg = SC_REG(context, index); + if (Pointerp(reg) && PTR(reg) <= lip) { + offset = lip - reg; + if (offset < lip_offset) { + lip_offset = offset; + lip_register_pair = index; + } + } } #endif /* reg_LIP */ - /* Compute the PC's offset from the start of the CODE */ - /* register. */ - pc_code_offset = SC_PC(context) - SC_REG(context, reg_CODE); + /* Compute the PC's offset from the start of the CODE */ + /* register. */ + pc_code_offset = SC_PC(context) - SC_REG(context, reg_CODE); #ifdef SC_NPC - npc_code_offset = SC_NPC(context) - SC_REG(context, reg_CODE); + npc_code_offset = SC_NPC(context) - SC_REG(context, reg_CODE); #endif /* SC_NPC */ - - /* Scanvenge all boxed registers in the context. */ - for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) - { - int index; - lispobj foo; - - index = boxed_registers[i]; - foo = SC_REG(context,index); - scavenge(&foo, 1); - SC_REG(context,index) = foo; - - scavenge(&(SC_REG(context, index)), 1); + + /* Scanvenge all boxed registers in the context. */ + for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) { + int index; + lispobj foo; + + index = boxed_registers[i]; + foo = SC_REG(context, index); + scavenge(&foo, 1); + SC_REG(context, index) = foo; + + scavenge(&(SC_REG(context, index)), 1); } #ifdef reg_LIP - /* Fix the LIP */ - - /* - * But what happens if lip_register_pair is -1? SC_REG on Solaris - * (see solaris_register_address in solaris-os.c) will return - * &context->uc_mcontext.gregs[2]. But gregs[2] is REG_nPC. Is - * that what we really want? My guess is that that is not what we - * want, so if lip_register_pair is -1, we don't touch reg_LIP at - * all. But maybe it doesn't really matter if LIP is trashed? - */ - if (lip_register_pair >= 0) - { - SC_REG(context, reg_LIP) = - SC_REG(context, lip_register_pair) + lip_offset; + /* Fix the LIP */ + + /* + * But what happens if lip_register_pair is -1? SC_REG on Solaris + * (see solaris_register_address in solaris-os.c) will return + * &context->uc_mcontext.gregs[2]. But gregs[2] is REG_nPC. Is + * that what we really want? My guess is that that is not what we + * want, so if lip_register_pair is -1, we don't touch reg_LIP at + * all. But maybe it doesn't really matter if LIP is trashed? + */ + if (lip_register_pair >= 0) { + SC_REG(context, reg_LIP) = + SC_REG(context, lip_register_pair) + lip_offset; } #endif /* reg_LIP */ - - /* Fix the PC if it was in from space */ - if (from_space_p(SC_PC(context))) - SC_PC(context) = SC_REG(context, reg_CODE) + pc_code_offset; + + /* Fix the PC if it was in from space */ + if (from_space_p(SC_PC(context))) + SC_PC(context) = SC_REG(context, reg_CODE) + pc_code_offset; #ifdef SC_NPC - if (from_space_p(SC_NPC(context))) - SC_NPC(context) = SC_REG(context, reg_CODE) + npc_code_offset; + if (from_space_p(SC_NPC(context))) + SC_NPC(context) = SC_REG(context, reg_CODE) + npc_code_offset; #endif /* SC_NPC */ } -void scavenge_interrupt_contexts(void) +void +scavenge_interrupt_contexts(void) { - int i, index; - os_context_t *context; + int i, index; + os_context_t *context; #ifdef PRINTNOISE - printf("Scavenging interrupt contexts ...\n"); + printf("Scavenging interrupt contexts ...\n"); #endif - index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)); + index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)); #if defined(DEBUG_PRINT_CONTEXT_INDEX) - printf("Number of active contexts: %d\n", index); + printf("Number of active contexts: %d\n", index); #endif - for (i = 0; i < index; i++) - { - context = lisp_interrupt_contexts[i]; - scavenge_interrupt_context(context); + for (i = 0; i < index; i++) { + context = lisp_interrupt_contexts[i]; + scavenge_interrupt_context(context); } } #endif @@ -2296,100 +2347,101 @@ static lispobj trans_function_header(lispobj object); static lispobj trans_boxed(lispobj object); #if DIRECT_SCAV -static int scav_function_pointer(lispobj *where, lispobj object) +static int +scav_function_pointer(lispobj * where, lispobj object) { - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - if (from_space_p(object)) { - lispobj first, *first_pointer; + if (from_space_p(object)) { + lispobj first, *first_pointer; - /* - * Object is a pointer into from space - check to see if it has - * been forwarded. - */ - first_pointer = (lispobj *) PTR(object); - first = *first_pointer; + /* + * Object is a pointer into from space - check to see if it has + * been forwarded. + */ + first_pointer = (lispobj *) PTR(object); + first = *first_pointer; - if (first == 0x01) { - /* Forwarded */ - *where = first_pointer[1]; - return 1; - } - else { - int type; - lispobj copy; + if (first == 0x01) { + /* Forwarded */ + *where = first_pointer[1]; + return 1; + } else { + int type; + lispobj copy; - /* - * Must transport object -- object may point to either a - * function header, a closure function header, or to a closure - * header. - */ + /* + * Must transport object -- object may point to either a + * function header, a closure function header, or to a closure + * header. + */ - type = TypeOf(first); - switch (type) { - case type_FunctionHeader: - case type_ClosureFunctionHeader: - copy = trans_function_header(object); - break; - default: - copy = trans_boxed(object); - break; - } + type = TypeOf(first); + switch (type) { + case type_FunctionHeader: + case type_ClosureFunctionHeader: + copy = trans_function_header(object); + break; + default: + copy = trans_boxed(object); + break; + } - if (copy != object) { - /* Set forwarding pointer. */ - first_pointer[0] = 0x01; - first_pointer[1] = copy; - } + if (copy != object) { + /* Set forwarding pointer. */ + first_pointer[0] = 0x01; + first_pointer[1] = copy; + } - first = copy; - } + first = copy; + } - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); + gc_assert(Pointerp(first)); + gc_assert(!from_space_p(first)); - *where = first; - } - return 1; + *where = first; + } + return 1; } #else -static int scav_function_pointer(lispobj *where, lispobj object) +static int +scav_function_pointer(lispobj * where, lispobj object) { - lispobj *first_pointer; - lispobj copy; + lispobj *first_pointer; + lispobj copy; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - /* Object is a pointer into from space - no a FP. */ - first_pointer = (lispobj *) PTR(object); + /* Object is a pointer into from space - no a FP. */ + first_pointer = (lispobj *) PTR(object); - /* - * Must transport object -- object may point to either a function - * header, a closure function header, or to a closure header. - */ + /* + * Must transport object -- object may point to either a function + * header, a closure function header, or to a closure header. + */ - switch (TypeOf(*first_pointer)) { - case type_FunctionHeader: - case type_ClosureFunctionHeader: - copy = trans_function_header(object); - break; - default: - copy = trans_boxed(object); - break; - } + switch (TypeOf(*first_pointer)) { + case type_FunctionHeader: + case type_ClosureFunctionHeader: + copy = trans_function_header(object); + break; + default: + copy = trans_boxed(object); + break; + } - if (copy != object) { - /* Set forwarding pointer */ - first_pointer[0] = 0x01; - first_pointer[1] = copy; - } + if (copy != object) { + /* Set forwarding pointer */ + first_pointer[0] = 0x01; + first_pointer[1] = copy; + } - gc_assert(Pointerp(copy)); - gc_assert(!from_space_p(copy)); + gc_assert(Pointerp(copy)); + gc_assert(!from_space_p(copy)); - *where = copy; + *where = copy; - return 1; + return 1; } #endif @@ -2405,455 +2457,505 @@ static int scav_function_pointer(lispobj *where, lispobj object) * Currently only absolution fixups to the constant vector, or to the * code area are checked. */ -void sniff_code_object(struct code *code, unsigned displacement) +void +sniff_code_object(struct code *code, unsigned displacement) { - int nheader_words, ncode_words, nwords; - void *p; - void *constants_start_addr, *constants_end_addr; - void *code_start_addr, *code_end_addr; - int fixup_found = 0; + int nheader_words, ncode_words, nwords; + void *p; + void *constants_start_addr, *constants_end_addr; + void *code_start_addr, *code_end_addr; + int fixup_found = 0; - if (!check_code_fixups) - return; + if (!check_code_fixups) + return; - /* - * It's ok if it's byte compiled code. The trace table offset will - * be a fixnum if it's x86 compiled code - check. - */ - if (code->trace_table_offset & 0x3) { + /* + * It's ok if it's byte compiled code. The trace table offset will + * be a fixnum if it's x86 compiled code - check. + */ + if (code->trace_table_offset & 0x3) { #if 0 - fprintf(stderr, "*** Sniffing byte compiled code object at %x.\n",code); + fprintf(stderr, "*** Sniffing byte compiled code object at %x.\n", + code); #endif - return; - } + return; + } - /* Else it's x86 machine code. */ + /* Else it's x86 machine code. */ - ncode_words = fixnum_value(code->code_size); - nheader_words = HeaderValue(*(lispobj *) code); - nwords = ncode_words + nheader_words; + ncode_words = fixnum_value(code->code_size); + nheader_words = HeaderValue(*(lispobj *) code); + nwords = ncode_words + nheader_words; - constants_start_addr = (void *) code + 5 * sizeof(lispobj); - constants_end_addr = (void *) code + nheader_words * sizeof(lispobj); - code_start_addr = (void *) code + nheader_words * sizeof(lispobj); - code_end_addr = (void *) code + nwords * sizeof(lispobj); + constants_start_addr = (void *) code + 5 * sizeof(lispobj); + constants_end_addr = (void *) code + nheader_words * sizeof(lispobj); + code_start_addr = (void *) code + nheader_words * sizeof(lispobj); + code_end_addr = (void *) code + nwords * sizeof(lispobj); - /* Work through the unboxed code. */ - for (p = code_start_addr; p < code_end_addr; p++) { - void *data = *(void **) p; - unsigned d1 = *((unsigned char *) p - 1); - unsigned d2 = *((unsigned char *) p - 2); - unsigned d3 = *((unsigned char *) p - 3); - unsigned d4 = *((unsigned char *) p - 4); - unsigned d5 = *((unsigned char *) p - 5); - unsigned d6 = *((unsigned char *) p - 6); + /* Work through the unboxed code. */ + for (p = code_start_addr; p < code_end_addr; p++) { + void *data = *(void **) p; + unsigned d1 = *((unsigned char *) p - 1); + unsigned d2 = *((unsigned char *) p - 2); + unsigned d3 = *((unsigned char *) p - 3); + unsigned d4 = *((unsigned char *) p - 4); + unsigned d5 = *((unsigned char *) p - 5); + unsigned d6 = *((unsigned char *) p - 6); - /* - * Check for code references. - * - * Check for a 32 bit word that looks like an absolute reference - * to within the code adea of the code object. - */ - if (data >= code_start_addr - displacement - && data < code_end_addr - displacement) { - /* Function header */ - if (d4 == 0x5e - && ((unsigned long) p - 4 - 4 * HeaderValue(*((unsigned long *) p - 1))) == (unsigned long) code) { - /* Skip the function header */ - p += 6 * 4 - 4 - 1; - continue; - } - /* Push imm32 */ - if (d1 == 0x68) { - fixup_found = 1; - fprintf(stderr, "Code ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", - (unsigned long) p, d6,d5,d4,d3,d2,d1, - (unsigned long) data); - fprintf(stderr, "*** Push $0x%.8lx\n", (unsigned long) data); - } - /* Mov [reg-8],imm32 */ - if (d3 == 0xc7 - && (d2 == 0x40 || d2 == 0x41 || d2 == 0x42 || d2 == 0x43 - || d2 == 0x45 || d2 == 0x46 || d2 == 0x47) - && d1 == 0xf8) { - fixup_found = 1; - fprintf(stderr, "Code ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", - (unsigned long) p, d6,d5,d4,d3,d2,d1, (unsigned long) data); - fprintf(stderr, "*** Mov [reg-8],$0x%.8lx\n", (unsigned long) data); - } - /* Lea reg, [disp32] */ - if (d2 == 0x8d && (d1 & 0xc7) == 5) { - fixup_found = 1; - fprintf(stderr, "Code ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", - (unsigned long) p, d6,d5,d4,d3,d2,d1, (unsigned long) data); - fprintf(stderr, "*** Lea reg,[$0x%.8lx]\n", (unsigned long) data); - } + /* + * Check for code references. + * + * Check for a 32 bit word that looks like an absolute reference + * to within the code adea of the code object. + */ + if (data >= code_start_addr - displacement + && data < code_end_addr - displacement) { + /* Function header */ + if (d4 == 0x5e + && ((unsigned long) p - 4 - + 4 * HeaderValue(*((unsigned long *) p - 1))) == + (unsigned long) code) { + /* Skip the function header */ + p += 6 * 4 - 4 - 1; + continue; + } + /* Push imm32 */ + if (d1 == 0x68) { + fixup_found = 1; + fprintf(stderr, + "Code ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", + (unsigned long) p, d6, d5, d4, d3, d2, d1, + (unsigned long) data); + fprintf(stderr, "*** Push $0x%.8lx\n", (unsigned long) data); + } + /* Mov [reg-8],imm32 */ + if (d3 == 0xc7 + && (d2 == 0x40 || d2 == 0x41 || d2 == 0x42 || d2 == 0x43 + || d2 == 0x45 || d2 == 0x46 || d2 == 0x47) + && d1 == 0xf8) { + fixup_found = 1; + fprintf(stderr, + "Code ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", + (unsigned long) p, d6, d5, d4, d3, d2, d1, + (unsigned long) data); + fprintf(stderr, "*** Mov [reg-8],$0x%.8lx\n", + (unsigned long) data); + } + /* Lea reg, [disp32] */ + if (d2 == 0x8d && (d1 & 0xc7) == 5) { + fixup_found = 1; + fprintf(stderr, + "Code ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", + (unsigned long) p, d6, d5, d4, d3, d2, d1, + (unsigned long) data); + fprintf(stderr, "*** Lea reg,[$0x%.8lx]\n", + (unsigned long) data); + } + } + + /* + * Check for constant references. + * + * Check for a 32 bit word that looks like an absolution reference + * to within the constant vector. Constant references will be + * aligned. + */ + if (data >= constants_start_addr - displacement + && data < constants_end_addr - displacement + && ((unsigned long) data & 0x3) == 0) { + /* Mov eax,m32 */ + if (d1 == 0xa1) { + fixup_found = 1; + fprintf(stderr, + "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", + (unsigned long) p, d6, d5, d4, d3, d2, d1, + (unsigned long) data); + fprintf(stderr, "*** Mov eax,0x%.8lx\n", (unsigned long) data); + } + + /* Mov m32,eax */ + if (d1 == 0xa3) { + fixup_found = 1; + fprintf(stderr, + "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", + (unsigned long) p, d6, d5, d4, d3, d2, d1, + (unsigned long) data); + fprintf(stderr, "*** Mov 0x%.8lx,eax\n", (unsigned long) data); + } + + /* Cmp m32,imm32 */ + if (d1 == 0x3d && d2 == 0x81) { + fixup_found = 1; + fprintf(stderr, + "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", + (unsigned long) p, d6, d5, d4, d3, d2, d1, + (unsigned long) data); + /* XX Check this */ + fprintf(stderr, "*** Cmp 0x%.8lx,immed32\n", + (unsigned long) data); + } + + /* Check for a mod=00, r/m=101 byte. */ + if ((d1 & 0xc7) == 5) { + /* Cmp m32,reg */ + if (d2 == 0x39) { + fixup_found = 1; + fprintf(stderr, + "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", + (unsigned long) p, d6, d5, d4, d3, d2, d1, + (unsigned long) data); + fprintf(stderr, "*** Cmp 0x%.8lx,reg\n", + (unsigned long) data); + } + /* Cmp reg32,m32 */ + if (d2 == 0x3b) { + fixup_found = 1; + fprintf(stderr, + "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", + (unsigned long) p, d6, d5, d4, d3, d2, d1, + (unsigned long) data); + fprintf(stderr, "*** Cmp reg32,0x%.8lx\n", + (unsigned long) data); + } + /* Mov m32,reg32 */ + if (d2 == 0x89) { + fixup_found = 1; + fprintf(stderr, + "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", + (unsigned long) p, d6, d5, d4, d3, d2, d1, + (unsigned long) data); + fprintf(stderr, "*** Mov 0x%.8lx,reg32\n", + (unsigned long) data); + } + /* Mov reg32,m32 */ + if (d2 == 0x8b) { + fixup_found = 1; + fprintf(stderr, + "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", + (unsigned long) p, d6, d5, d4, d3, d2, d1, + (unsigned long) data); + fprintf(stderr, "*** Mov reg32,0x%.8lx\n", + (unsigned long) data); + } + /* Lea reg32,m32 */ + if (d2 == 0x8d) { + fixup_found = 1; + fprintf(stderr, + "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", + (unsigned long) p, d6, d5, d4, d3, d2, d1, + (unsigned long) data); + fprintf(stderr, "*** Lea reg32,0x%.8lx\n", + (unsigned long) data); + } + } + } } + /* If anything was found print out some info. on the code object. */ + if (fixup_found) { + fprintf(stderr, + "*** Compiled code object at %lx: header_words=%d code_words=%d .\n", + (unsigned long) code, nheader_words, ncode_words); + fprintf(stderr, + "*** Const. start = %lx; end= %lx; Code start = %lx; end = %lx\n", + (unsigned long) constants_start_addr, + (unsigned long) constants_end_addr, + (unsigned long) code_start_addr, (unsigned long) code_end_addr); + } +} + +static void +apply_code_fixups(struct code *old_code, struct code *new_code) +{ + int nheader_words, ncode_words, nwords; + void *constants_start_addr, *constants_end_addr; + void *code_start_addr, *code_end_addr; + lispobj fixups = NIL; + unsigned long displacement = + + (unsigned long) new_code - (unsigned long) old_code; + struct vector *fixups_vector; + /* - * Check for constant references. - * - * Check for a 32 bit word that looks like an absolution reference - * to within the constant vector. Constant references will be - * aligned. + * It's ok if it's byte compiled code. The trace table offset will + * be a fixnum if it's x86 compiled code - check. */ - if (data >= constants_start_addr - displacement - && data < constants_end_addr - displacement - && ((unsigned long) data & 0x3) == 0) { - /* Mov eax,m32 */ - if (d1 == 0xa1) { - fixup_found = 1; - fprintf(stderr, "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", - (unsigned long) p, d6, d5, d4, d3, d2, d1, (unsigned long) data); - fprintf(stderr, "*** Mov eax,0x%.8lx\n", (unsigned long) data); - } - - /* Mov m32,eax */ - if (d1 == 0xa3) { - fixup_found = 1; - fprintf(stderr, "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", - (unsigned long) p, d6, d5, d4, d3, d2, d1, (unsigned long) data); - fprintf(stderr, "*** Mov 0x%.8lx,eax\n", (unsigned long) data); - } - - /* Cmp m32,imm32 */ - if (d1 == 0x3d && d2 == 0x81) { - fixup_found = 1; - fprintf(stderr, "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", - (unsigned long) p, d6, d5, d4, d3, d2, d1, (unsigned long) data); - /* XX Check this */ - fprintf(stderr, "*** Cmp 0x%.8lx,immed32\n", (unsigned long) data); - } - - /* Check for a mod=00, r/m=101 byte. */ - if ((d1 & 0xc7) == 5) { - /* Cmp m32,reg */ - if (d2 == 0x39) { - fixup_found = 1; - fprintf(stderr, "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", - (unsigned long) p, d6, d5, d4, d3, d2, d1, (unsigned long) data); - fprintf(stderr, "*** Cmp 0x%.8lx,reg\n", (unsigned long) data); - } - /* Cmp reg32,m32 */ - if (d2 == 0x3b) { - fixup_found = 1; - fprintf(stderr, "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", - (unsigned long) p, d6, d5, d4, d3, d2, d1, (unsigned long) data); - fprintf(stderr, "*** Cmp reg32,0x%.8lx\n", (unsigned long) data); - } - /* Mov m32,reg32 */ - if (d2 == 0x89) { - fixup_found = 1; - fprintf(stderr, "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", - (unsigned long) p, d6, d5, d4, d3, d2, d1, (unsigned long) data); - fprintf(stderr, "*** Mov 0x%.8lx,reg32\n", (unsigned long) data); - } - /* Mov reg32,m32 */ - if (d2 == 0x8b) { - fixup_found = 1; - fprintf(stderr, "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", - (unsigned long) p, d6, d5, d4, d3, d2, d1, (unsigned long) data); - fprintf(stderr, "*** Mov reg32,0x%.8lx\n", (unsigned long) data); - } - /* Lea reg32,m32 */ - if (d2 == 0x8d) { - fixup_found = 1; - fprintf(stderr, "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n", - (unsigned long) p, d6, d5, d4, d3, d2, d1, (unsigned long) data); - fprintf(stderr, "*** Lea reg32,0x%.8lx\n", (unsigned long) data); - } - } - } - } - - /* If anything was found print out some info. on the code object. */ - if (fixup_found) { - fprintf(stderr, "*** Compiled code object at %lx: header_words=%d code_words=%d .\n", - (unsigned long) code, nheader_words, ncode_words); - fprintf(stderr, "*** Const. start = %lx; end= %lx; Code start = %lx; end = %lx\n", - (unsigned long) constants_start_addr, (unsigned long) constants_end_addr, - (unsigned long) code_start_addr, (unsigned long) code_end_addr); - } -} - -static void apply_code_fixups(struct code *old_code, struct code *new_code) -{ - int nheader_words, ncode_words, nwords; - void *constants_start_addr, *constants_end_addr; - void *code_start_addr, *code_end_addr; - lispobj fixups = NIL; - unsigned long displacement = (unsigned long) new_code - (unsigned long) old_code; - struct vector *fixups_vector; - - /* - * It's ok if it's byte compiled code. The trace table offset will - * be a fixnum if it's x86 compiled code - check. - */ - if (new_code->trace_table_offset & 0x3) { + if (new_code->trace_table_offset & 0x3) { #if 0 - fprintf(stderr, "*** Byte compiled code object at %x.\n", new_code); + fprintf(stderr, "*** Byte compiled code object at %x.\n", new_code); #endif - return; - } + return; + } - /* Else it's x86 machine code. */ - ncode_words = fixnum_value(new_code->code_size); - nheader_words = HeaderValue(*(lispobj *) new_code); - nwords = ncode_words + nheader_words; + /* Else it's x86 machine code. */ + ncode_words = fixnum_value(new_code->code_size); + nheader_words = HeaderValue(*(lispobj *) new_code); + nwords = ncode_words + nheader_words; #if 0 - fprintf(stderr, "*** Compiled code object at %x: header_words=%d code_words=%d .\n", - new_code, nheader_words, ncode_words); + fprintf(stderr, + "*** Compiled code object at %x: header_words=%d code_words=%d .\n", + new_code, nheader_words, ncode_words); #endif - constants_start_addr = (void *) new_code + 5 * sizeof(lispobj); - constants_end_addr = (void *) new_code + nheader_words * sizeof(lispobj); - code_start_addr = (void *) new_code + nheader_words * sizeof(lispobj); - code_end_addr = (void *)new_code + nwords*sizeof(lispobj); + constants_start_addr = (void *) new_code + 5 * sizeof(lispobj); + constants_end_addr = (void *) new_code + nheader_words * sizeof(lispobj); + code_start_addr = (void *) new_code + nheader_words * sizeof(lispobj); + code_end_addr = (void *) new_code + nwords * sizeof(lispobj); #if 0 - fprintf(stderr, "*** Const. start = %x; end= %x; Code start = %x; end = %x\n", - constants_start_addr, constants_end_addr, - code_start_addr, code_end_addr); -#endif - - /* - * The first constant should be a pointer to the fixups for this - * code objects - Check. - */ - fixups = new_code->constants[0]; - - /* - * It will be 0 or the unbound-marker if there are no fixups, and - * will be an other pointer if it is valid. - */ - if (fixups == 0 || fixups == type_UnboundMarker || !Pointerp(fixups)) { - /* Check for possible errors. */ - if (check_code_fixups) - sniff_code_object(new_code, displacement); + fprintf(stderr, + "*** Const. start = %x; end= %x; Code start = %x; end = %x\n", + constants_start_addr, constants_end_addr, code_start_addr, + code_end_addr); +#endif + + /* + * The first constant should be a pointer to the fixups for this + * code objects - Check. + */ + fixups = new_code->constants[0]; + + /* + * It will be 0 or the unbound-marker if there are no fixups, and + * will be an other pointer if it is valid. + */ + if (fixups == 0 || fixups == type_UnboundMarker || !Pointerp(fixups)) { + /* Check for possible errors. */ + if (check_code_fixups) + sniff_code_object(new_code, displacement); #if 0 - fprintf(stderr, "Fixups for code object not found!?\n"); - fprintf(stderr, "*** Compiled code object at %x: header_words=%d code_words=%d .\n", - new_code, nheader_words, ncode_words); - fprintf(stderr, "*** Const. start = %x; end= %x; Code start = %x; end = %x\n", - constants_start_addr, constants_end_addr, - code_start_addr, code_end_addr); -#endif - return; - } + fprintf(stderr, "Fixups for code object not found!?\n"); + fprintf(stderr, + "*** Compiled code object at %x: header_words=%d code_words=%d .\n", + new_code, nheader_words, ncode_words); + fprintf(stderr, + "*** Const. start = %x; end= %x; Code start = %x; end = %x\n", + constants_start_addr, constants_end_addr, code_start_addr, + code_end_addr); +#endif + return; + } - fixups_vector = (struct vector *) PTR(fixups); + fixups_vector = (struct vector *) PTR(fixups); - /* Could be pointing to a forwarding pointer. */ - if (Pointerp(fixups) && find_page_index((void*) fixups_vector) != -1 - && fixups_vector->header == 0x01) { + /* Could be pointing to a forwarding pointer. */ + if (Pointerp(fixups) && find_page_index((void *) fixups_vector) != -1 + && fixups_vector->header == 0x01) { #if 0 - fprintf(stderr, "* FF\n"); + fprintf(stderr, "* FF\n"); #endif - /* If so then follow it. */ - fixups_vector = (struct vector *) PTR((lispobj) fixups_vector->length); - } - + /* If so then follow it. */ + fixups_vector = (struct vector *) PTR((lispobj) fixups_vector->length); + } #if 0 - fprintf(stderr, "Got the fixups\n"); + fprintf(stderr, "Got the fixups\n"); #endif - if (TypeOf(fixups_vector->header) == type_SimpleArrayUnsignedByte32) { - /* - * Got the fixups for the code block. Now work through the - * vector, and apply a fixup at each address. - */ - 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. */ - unsigned long old_value = *(unsigned long *) ((unsigned long) code_start_addr + offset); - - /* - * If it's within the old_code object then it must be an - * absolute fixup (relative ones are not saved). - */ - if (old_value >= (unsigned long) old_code - && old_value < (unsigned long) old_code + nwords * sizeof(lispobj)) - /* So add the dispacement. */ - *(unsigned long *) ((unsigned long) code_start_addr + offset) = old_value - + displacement; - else + if (TypeOf(fixups_vector->header) == type_SimpleArrayUnsignedByte32) { /* - * It is outside the old code object so it must be a relative - * fixup (absolute fixups are not saved). So subtract the - * displacement. + * Got the fixups for the code block. Now work through the + * vector, and apply a fixup at each address. */ - *(unsigned long *) ((unsigned long) code_start_addr + offset) = old_value - - displacement; + 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. */ + unsigned long old_value = + *(unsigned long *) ((unsigned long) code_start_addr + offset); + + /* + * If it's within the old_code object then it must be an + * absolute fixup (relative ones are not saved). + */ + if (old_value >= (unsigned long) old_code + && old_value < + (unsigned long) old_code + nwords * sizeof(lispobj)) + /* So add the dispacement. */ + *(unsigned long *) ((unsigned long) code_start_addr + offset) = + old_value + displacement; + else + /* + * It is outside the old code object so it must be a relative + * fixup (absolute fixups are not saved). So subtract the + * displacement. + */ + *(unsigned long *) ((unsigned long) code_start_addr + offset) = + old_value - displacement; + } } - } - /* Check for possible errors. */ - if (check_code_fixups) - sniff_code_object(new_code, displacement); + /* Check for possible errors. */ + if (check_code_fixups) + sniff_code_object(new_code, displacement); } #endif -static struct code * trans_code(struct code *code) +static struct code * +trans_code(struct code *code) { - struct code *new_code; - lispobj l_code, l_new_code; - int nheader_words, ncode_words, nwords; - unsigned long displacement; - lispobj fheaderl, *prev_pointer; + struct code *new_code; + lispobj l_code, l_new_code; + int nheader_words, ncode_words, nwords; + unsigned long displacement; + lispobj fheaderl, *prev_pointer; #if 0 - fprintf(stderr, "\nTransporting code object located at 0x%08x.\n", - (unsigned long) code); + fprintf(stderr, "\nTransporting code object located at 0x%08x.\n", + (unsigned long) code); #endif - /* If object has already been transported, just return pointer */ - if (*(lispobj *) code == 0x01) - { - return (struct code*) (((lispobj *) code)[1]); + /* If object has already been transported, just return pointer */ + if (*(lispobj *) code == 0x01) { + return (struct code *) (((lispobj *) code)[1]); } - - gc_assert(TypeOf(code->header) == type_CodeHeader); - /* prepare to transport the code vector */ - l_code = (lispobj) code | type_OtherPointer; + gc_assert(TypeOf(code->header) == type_CodeHeader); - ncode_words = fixnum_value(code->code_size); - nheader_words = HeaderValue(code->header); - nwords = ncode_words + nheader_words; - nwords = CEILING(nwords, 2); + /* prepare to transport the code vector */ + l_code = (lispobj) code | type_OtherPointer; - l_new_code = copy_large_object(l_code, nwords); - new_code = (struct code *) PTR(l_new_code); + ncode_words = fixnum_value(code->code_size); + nheader_words = HeaderValue(code->header); + nwords = ncode_words + nheader_words; + nwords = CEILING(nwords, 2); - /* May not have been moved. */ - if (new_code == code) - return new_code; + l_new_code = copy_large_object(l_code, nwords); + new_code = (struct code *) PTR(l_new_code); - displacement = l_new_code - l_code; + /* May not have been moved. */ + if (new_code == code) + return new_code; + + displacement = l_new_code - l_code; #if 0 - fprintf(stderr, "Old code object at 0x%08x, new code object at 0x%08x.\n", - (unsigned long) code, (unsigned long) new_code); - fprintf(stderr, "Code object is %d words long.\n", nwords); + fprintf(stderr, "Old code object at 0x%08x, new code object at 0x%08x.\n", + (unsigned long) code, (unsigned long) new_code); + fprintf(stderr, "Code object is %d words long.\n", nwords); #endif - /* set forwarding pointer */ - ((lispobj *) code)[0] = 0x01; - ((lispobj *) code)[1] = l_new_code; + /* set forwarding pointer */ + ((lispobj *) code)[0] = 0x01; + ((lispobj *) code)[1] = l_new_code; - /* - * Set forwarding pointers for all the function headers in the code - * object; also fix all self pointers. - */ + /* + * Set forwarding pointers for all the function headers in the code + * object; also fix all self pointers. + */ - fheaderl = code->entry_points; - prev_pointer = &new_code->entry_points; + fheaderl = code->entry_points; + prev_pointer = &new_code->entry_points; - while (fheaderl != NIL) { - struct function *fheaderp, *nfheaderp; - lispobj nfheaderl; + while (fheaderl != NIL) { + struct function *fheaderp, *nfheaderp; + lispobj nfheaderl; - fheaderp = (struct function *) PTR(fheaderl); - gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); + fheaderp = (struct function *) PTR(fheaderl); + gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); - /* - * Calcuate the new function pointer and the new function header. - */ - nfheaderl = fheaderl + displacement; - nfheaderp = (struct function *) PTR(nfheaderl); + /* + * Calcuate the new function pointer and the new function header. + */ + nfheaderl = fheaderl + displacement; + nfheaderp = (struct function *) PTR(nfheaderl); - /* set forwarding pointer */ - ((lispobj *) fheaderp)[0] = 0x01; - ((lispobj *) fheaderp)[1] = nfheaderl; + /* set forwarding pointer */ + ((lispobj *) fheaderp)[0] = 0x01; + ((lispobj *) fheaderp)[1] = nfheaderl; - /* Fix self pointer */ - nfheaderp->self = nfheaderl + RAW_ADDR_OFFSET; + /* Fix self pointer */ + nfheaderp->self = nfheaderl + RAW_ADDR_OFFSET; - *prev_pointer = nfheaderl; + *prev_pointer = nfheaderl; - fheaderl = fheaderp->next; - prev_pointer = &nfheaderp->next; - } + fheaderl = fheaderp->next; + prev_pointer = &nfheaderp->next; + } #if 0 - sniff_code_object(new_code, displacement); + sniff_code_object(new_code, displacement); #endif #if defined(i386) || defined(__x86_64) - apply_code_fixups(code, new_code); + apply_code_fixups(code, new_code); #else - /* From gc.c */ + /* From gc.c */ #ifndef MACH - os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words), - ncode_words * sizeof(int)); + os_flush_icache((os_vm_address_t) (((int *) new_code) + nheader_words), + ncode_words * sizeof(int)); #endif #endif - return new_code; + return new_code; } -static int scav_code_header(lispobj *where, lispobj object) +static int +scav_code_header(lispobj * where, lispobj object) { - struct code *code; - int nheader_words, ncode_words, nwords; - lispobj fheaderl; - struct function *fheaderp; + struct code *code; + int nheader_words, ncode_words, nwords; + lispobj fheaderl; + struct function *fheaderp; - code = (struct code *) where; - ncode_words = fixnum_value(code->code_size); - nheader_words = HeaderValue(object); - nwords = ncode_words + nheader_words; - nwords = CEILING(nwords, 2); + code = (struct code *) where; + ncode_words = fixnum_value(code->code_size); + nheader_words = HeaderValue(object); + nwords = ncode_words + nheader_words; + nwords = CEILING(nwords, 2); - /* Scavenge the boxed section of the code data block */ - scavenge(where + 1, nheader_words - 1); + /* Scavenge the boxed section of the code data block */ + scavenge(where + 1, nheader_words - 1); - /* - * Scavenge the boxed section of each function object in the code - * data block - */ - fheaderl = code->entry_points; - while (fheaderl != NIL) { - fheaderp = (struct function *) PTR(fheaderl); - gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); + /* + * Scavenge the boxed section of each function object in the code + * data block + */ + fheaderl = code->entry_points; + while (fheaderl != NIL) { + fheaderp = (struct function *) PTR(fheaderl); + gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); - scavenge(&fheaderp->name, 1); - scavenge(&fheaderp->arglist, 1); - scavenge(&fheaderp->type, 1); + scavenge(&fheaderp->name, 1); + scavenge(&fheaderp->arglist, 1); + scavenge(&fheaderp->type, 1); - fheaderl = fheaderp->next; - } + fheaderl = fheaderp->next; + } - return nwords; + return nwords; } -static lispobj trans_code_header(lispobj object) +static lispobj +trans_code_header(lispobj object) { - struct code *ncode; + struct code *ncode; - ncode = trans_code((struct code *) PTR(object)); - return (lispobj) ncode | type_OtherPointer; + ncode = trans_code((struct code *) PTR(object)); + return (lispobj) ncode | type_OtherPointer; } -static int size_code_header(lispobj *where) +static int +size_code_header(lispobj * where) { - struct code *code; - int nheader_words, ncode_words, nwords; + struct code *code; + int nheader_words, ncode_words, nwords; - code = (struct code *) where; + code = (struct code *) where; - ncode_words = fixnum_value(code->code_size); - nheader_words = HeaderValue(code->header); - nwords = ncode_words + nheader_words; - nwords = CEILING(nwords, 2); + ncode_words = fixnum_value(code->code_size); + nheader_words = HeaderValue(code->header); + nwords = ncode_words + nheader_words; + nwords = CEILING(nwords, 2); - return nwords; + return nwords; } #if !(defined(i386) || defined(__x86_64)) -static int scav_return_pc_header(lispobj *where, lispobj object) +static int +scav_return_pc_header(lispobj * where, lispobj object) { fprintf(stderr, "GC lossage. Should not be scavenging a "); fprintf(stderr, "Return PC Header.\n"); @@ -2865,21 +2967,22 @@ static int scav_return_pc_header(lispobj *where, lispobj object) #endif /* not i386 */ -static lispobj trans_return_pc_header(lispobj object) +static lispobj +trans_return_pc_header(lispobj object) { - struct function *return_pc; - unsigned long offset; - struct code *code, *ncode; + struct function *return_pc; + unsigned long offset; + struct code *code, *ncode; - return_pc = (struct function *) PTR(object); - offset = HeaderValue(return_pc->header) * sizeof(lispobj); + return_pc = (struct function *) PTR(object); + offset = HeaderValue(return_pc->header) * sizeof(lispobj); - /* Transport the whole code object */ - code = (struct code *) ((unsigned long) return_pc - offset); - - ncode = trans_code(code); + /* Transport the whole code object */ + code = (struct code *) ((unsigned long) return_pc - offset); - return ((lispobj) ncode + offset) | type_OtherPointer; + ncode = trans_code(code); + + return ((lispobj) ncode + offset) | type_OtherPointer; } /* @@ -2888,27 +2991,29 @@ static lispobj trans_return_pc_header(lispobj object) */ #if defined(i386) || defined(__x86_64) -static int scav_closure_header(lispobj *where, lispobj object) +static int +scav_closure_header(lispobj * where, lispobj object) { - struct closure *closure; - lispobj fun; + struct closure *closure; + lispobj fun; - closure = (struct closure *)where; - fun = closure->function - RAW_ADDR_OFFSET; - scavenge(&fun, 1); - /* The function may have moved so update the raw address. But don't - write unnecessarily. */ - if (closure->function != fun + RAW_ADDR_OFFSET) - closure->function = fun + RAW_ADDR_OFFSET; + closure = (struct closure *) where; + fun = closure->function - RAW_ADDR_OFFSET; + scavenge(&fun, 1); + /* The function may have moved so update the raw address. But don't + write unnecessarily. */ + if (closure->function != fun + RAW_ADDR_OFFSET) + closure->function = fun + RAW_ADDR_OFFSET; - return 2; + return 2; } #endif /* i386 */ #if !(defined(i386) || defined(__x86_64)) -static int scav_function_header(lispobj *where, lispobj object) +static int +scav_function_header(lispobj * where, lispobj object) { fprintf(stderr, "GC lossage. Should not be scavenging a "); fprintf(stderr, "Function Header.\n"); @@ -2920,440 +3025,466 @@ static int scav_function_header(lispobj *where, lispobj object) #endif /* not i386 */ -static lispobj trans_function_header(lispobj object) +static lispobj +trans_function_header(lispobj object) { - struct function *fheader; - unsigned long offset; - struct code *code, *ncode; + struct function *fheader; + unsigned long offset; + struct code *code, *ncode; - fheader = (struct function *) PTR(object); - offset = HeaderValue(fheader->header) * sizeof(lispobj); + fheader = (struct function *) PTR(object); + offset = HeaderValue(fheader->header) * sizeof(lispobj); - /* Transport the whole code object */ - code = (struct code *) ((unsigned long) fheader - offset); - ncode = trans_code(code); + /* Transport the whole code object */ + code = (struct code *) ((unsigned long) fheader - offset); + ncode = trans_code(code); - return ((lispobj) ncode + offset) | type_FunctionPointer; + return ((lispobj) ncode + offset) | type_FunctionPointer; } - + /* Instances */ #if DIRECT_SCAV -static int scav_instance_pointer(lispobj *where, lispobj object) +static int +scav_instance_pointer(lispobj * where, lispobj object) { - if (from_space_p(object)) { - lispobj first, *first_pointer; + if (from_space_p(object)) { + lispobj first, *first_pointer; - /* - * object is a pointer into from space. check to see if it has - * been forwarded - */ - first_pointer = (lispobj *) PTR(object); - first = *first_pointer; - - if (first == 0x01) - /* Forwarded. */ - first = first_pointer[1]; - else { - first = trans_boxed(object); - gc_assert(first != object); - /* Set forwarding pointer */ - first_pointer[0] = 0x01; - first_pointer[1] = first; + /* + * object is a pointer into from space. check to see if it has + * been forwarded + */ + first_pointer = (lispobj *) PTR(object); + first = *first_pointer; + + if (first == 0x01) + /* Forwarded. */ + first = first_pointer[1]; + else { + first = trans_boxed(object); + gc_assert(first != object); + /* Set forwarding pointer */ + first_pointer[0] = 0x01; + first_pointer[1] = first; + } + *where = first; } - *where = first; - } - return 1; + return 1; } #else -static int scav_instance_pointer(lispobj *where, lispobj object) +static int +scav_instance_pointer(lispobj * where, lispobj object) { - lispobj copy, *first_pointer; + lispobj copy, *first_pointer; - /* Object is a pointer into from space - not a FP */ - copy = trans_boxed(object); + /* Object is a pointer into from space - not a FP */ + copy = trans_boxed(object); - gc_assert(copy != object); + gc_assert(copy != object); - first_pointer = (lispobj *) PTR(object); + first_pointer = (lispobj *) PTR(object); - /* Set forwarding pointer. */ - first_pointer[0] = 0x01; - first_pointer[1] = copy; - *where = copy; + /* Set forwarding pointer. */ + first_pointer[0] = 0x01; + first_pointer[1] = copy; + *where = copy; - return 1; + return 1; } #endif - + /* Lists and Conses */ static lispobj trans_list(lispobj object); #if DIRECT_SCAV -static int scav_list_pointer(lispobj *where, lispobj object) +static int +scav_list_pointer(lispobj * where, lispobj object) { - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - if (from_space_p(object)) { - lispobj first, *first_pointer; + if (from_space_p(object)) { + lispobj first, *first_pointer; - /* - * Object is a pointer into from space - check to see if it has - * been forwarded. - */ - first_pointer = (lispobj *) PTR(object); - first = *first_pointer; - - if (first == 0x01) - /* Forwarded. */ - first = first_pointer[1]; - else { - first = trans_list(object); + /* + * Object is a pointer into from space - check to see if it has + * been forwarded. + */ + first_pointer = (lispobj *) PTR(object); + first = *first_pointer; + + if (first == 0x01) + /* Forwarded. */ + first = first_pointer[1]; + else { + first = trans_list(object); + + /* Set forwarding pointer */ + first_pointer[0] = 0x01; + first_pointer[1] = first; + } - /* Set forwarding pointer */ - first_pointer[0] = 0x01; - first_pointer[1] = first; + gc_assert(Pointerp(first)); + gc_assert(!from_space_p(first)); + *where = first; } - - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); - *where = first; - } - return 1; + return 1; } #else -static int scav_list_pointer(lispobj *where, lispobj object) +static int +scav_list_pointer(lispobj * where, lispobj object) { - lispobj first, *first_pointer; + lispobj first, *first_pointer; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - /* Object is a pointer into from space - not FP */ + /* Object is a pointer into from space - not FP */ - first = trans_list(object); - gc_assert(first != object); + first = trans_list(object); + gc_assert(first != object); - first_pointer = (lispobj *) PTR(object); + first_pointer = (lispobj *) PTR(object); - /* Set forwarding pointer */ - first_pointer[0] = 0x01; - first_pointer[1] = first; + /* Set forwarding pointer */ + first_pointer[0] = 0x01; + first_pointer[1] = first; - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); - *where = first; - return 1; + gc_assert(Pointerp(first)); + gc_assert(!from_space_p(first)); + *where = first; + return 1; } #endif -static lispobj trans_list(lispobj object) +static lispobj +trans_list(lispobj object) { - lispobj new_list_pointer; - struct cons *cons, *new_cons; - lispobj cdr; + lispobj new_list_pointer; + struct cons *cons, *new_cons; + lispobj cdr; - gc_assert(from_space_p(object)); + gc_assert(from_space_p(object)); - cons = (struct cons *) PTR(object); + cons = (struct cons *) PTR(object); - /* copy 'object' */ - new_cons = (struct cons *) gc_quick_alloc(sizeof(struct cons)); - new_cons->car = cons->car; - new_cons->cdr = cons->cdr; /* updated later */ - new_list_pointer = (lispobj) new_cons | LowtagOf(object); + /* copy 'object' */ + new_cons = (struct cons *) gc_quick_alloc(sizeof(struct cons)); - /* Grab the cdr before it is clobbered */ - cdr = cons->cdr; + new_cons->car = cons->car; + new_cons->cdr = cons->cdr; /* updated later */ + new_list_pointer = (lispobj) new_cons | LowtagOf(object); - /* Set forwarding pointer (clobbers start of list). */ - cons->car = 0x01; - cons->cdr = new_list_pointer; + /* Grab the cdr before it is clobbered */ + cdr = cons->cdr; - /* Try to linearize the list in the cdr direction to help reduce paging. */ - while (1) { - lispobj new_cdr; - struct cons *cdr_cons, *new_cdr_cons; + /* Set forwarding pointer (clobbers start of list). */ + cons->car = 0x01; + cons->cdr = new_list_pointer; - if (LowtagOf(cdr) != type_ListPointer || !from_space_p(cdr) - || *((lispobj *) PTR(cdr)) == 0x01) - break; + /* Try to linearize the list in the cdr direction to help reduce paging. */ + while (1) { + lispobj new_cdr; + struct cons *cdr_cons, *new_cdr_cons; - cdr_cons = (struct cons *) PTR(cdr); + if (LowtagOf(cdr) != type_ListPointer || !from_space_p(cdr) + || *((lispobj *) PTR(cdr)) == 0x01) + break; - /* copy 'cdr' */ - new_cdr_cons = (struct cons*) gc_quick_alloc(sizeof(struct cons)); - new_cdr_cons->car = cdr_cons->car; - new_cdr_cons->cdr = cdr_cons->cdr; - new_cdr = (lispobj) new_cdr_cons | LowtagOf(cdr); + cdr_cons = (struct cons *) PTR(cdr); - /* Grab the cdr before it is clobbered */ - cdr = cdr_cons->cdr; + /* copy 'cdr' */ + new_cdr_cons = (struct cons *) gc_quick_alloc(sizeof(struct cons)); - /* Set forwarding pointer */ - cdr_cons->car = 0x01; - cdr_cons->cdr = new_cdr; + new_cdr_cons->car = cdr_cons->car; + new_cdr_cons->cdr = cdr_cons->cdr; + new_cdr = (lispobj) new_cdr_cons | LowtagOf(cdr); - /* - * Update the cdr of the last cons copied into new space to keep - * the newspace scavenge from having to do it. - */ - new_cons->cdr = new_cdr; + /* Grab the cdr before it is clobbered */ + cdr = cdr_cons->cdr; - new_cons = new_cdr_cons; - } + /* Set forwarding pointer */ + cdr_cons->car = 0x01; + cdr_cons->cdr = new_cdr; - return new_list_pointer; -} + /* + * Update the cdr of the last cons copied into new space to keep + * the newspace scavenge from having to do it. + */ + new_cons->cdr = new_cdr; + + new_cons = new_cdr_cons; + } + return new_list_pointer; +} + /* Scavenging and Transporting Other Pointers */ #if DIRECT_SCAV -static int scav_other_pointer(lispobj *where, lispobj object) +static int +scav_other_pointer(lispobj * where, lispobj object) { - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); + + if (from_space_p(object)) { + lispobj first, *first_pointer; + + /* + * Object is a pointer into from space. check to see if it has + * been forwarded. + */ + first_pointer = (lispobj *) PTR(object); + first = *first_pointer; + + if (first == 0x01) { + /* Forwarded. */ + first = first_pointer[1]; + *where = first; + } else { + first = (transother[TypeOf(first)]) (object); + + if (first != object) { + /* Set forwarding pointer */ + first_pointer[0] = 0x01; + first_pointer[1] = first; + *where = first; + } + } - if (from_space_p(object)) { + gc_assert(Pointerp(first)); + gc_assert(!from_space_p(first)); + } + return 1; +} +#else +static int +scav_other_pointer(lispobj * where, lispobj object) +{ lispobj first, *first_pointer; - /* - * Object is a pointer into from space. check to see if it has - * been forwarded. - */ + gc_assert(Pointerp(object)); + + /* Object is a pointer into from space - not FP */ first_pointer = (lispobj *) PTR(object); - first = *first_pointer; - if (first == 0x01) { - /* Forwarded. */ - first = first_pointer[1]; - *where = first; - } else { - first = (transother[TypeOf(first)])(object); + first = (transother[TypeOf(*first_pointer)]) (object); - if (first != object) { + if (first != object) { /* Set forwarding pointer */ first_pointer[0] = 0x01; first_pointer[1] = first; *where = first; - } } gc_assert(Pointerp(first)); gc_assert(!from_space_p(first)); - } - return 1; -} -#else -static int scav_other_pointer(lispobj *where, lispobj object) -{ - lispobj first, *first_pointer; - - gc_assert(Pointerp(object)); - - /* Object is a pointer into from space - not FP */ - first_pointer = (lispobj *) PTR(object); - first = (transother[TypeOf(*first_pointer)])(object); - - if (first != object) { - /* Set forwarding pointer */ - first_pointer[0] = 0x01; - first_pointer[1] = first; - *where = first; - } - - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); - - return 1; + return 1; } #endif - + /* Immediate, Boxed, and Unboxed Objects */ -static int size_pointer(lispobj *where) +static int +size_pointer(lispobj * where) { return 1; } -static int scav_immediate(lispobj *where, lispobj object) +static int +scav_immediate(lispobj * where, lispobj object) { return 1; } -static lispobj trans_immediate(lispobj object) +static lispobj +trans_immediate(lispobj object) { fprintf(stderr, "GC lossage. Trying to transport an immediate!?\n"); lose(NULL); return NIL; } -static int size_immediate(lispobj *where) +static int +size_immediate(lispobj * where) { return 1; } -static int scav_boxed(lispobj *where, lispobj object) +static int +scav_boxed(lispobj * where, lispobj object) { return 1; } -static lispobj trans_boxed(lispobj object) +static lispobj +trans_boxed(lispobj object) { - lispobj header; - unsigned long length; + lispobj header; + unsigned long length; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - header = *((lispobj *) PTR(object)); - length = HeaderValue(header) + 1; - length = CEILING(length, 2); + header = *((lispobj *) PTR(object)); + length = HeaderValue(header) + 1; + length = CEILING(length, 2); - return copy_object(object, length); + return copy_object(object, length); } -static lispobj trans_boxed_large(lispobj object) +static lispobj +trans_boxed_large(lispobj object) { - lispobj header; - unsigned long length; + lispobj header; + unsigned long length; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - header = *((lispobj *) PTR(object)); - length = HeaderValue(header) + 1; - length = CEILING(length, 2); + header = *((lispobj *) PTR(object)); + length = HeaderValue(header) + 1; + length = CEILING(length, 2); - return copy_large_object(object, length); + return copy_large_object(object, length); } -static int size_boxed(lispobj *where) +static int +size_boxed(lispobj * where) { - lispobj header; - unsigned long length; + lispobj header; + unsigned long length; - header = *where; - length = HeaderValue(header) + 1; - length = CEILING(length, 2); + header = *where; + length = HeaderValue(header) + 1; + length = CEILING(length, 2); - return length; + return length; } /* Not needed on sparc because the raw_addr has a function lowtag */ #ifndef sparc -static int scav_fdefn(lispobj *where, lispobj object) +static int +scav_fdefn(lispobj * where, lispobj object) { - struct fdefn *fdefn; + struct fdefn *fdefn; - fdefn = (struct fdefn *)where; + fdefn = (struct fdefn *) where; - if ((char *) (fdefn->function + RAW_ADDR_OFFSET) == fdefn->raw_addr) { - scavenge(where + 1, sizeof(struct fdefn) / sizeof(lispobj) - 1); + if ((char *) (fdefn->function + RAW_ADDR_OFFSET) == fdefn->raw_addr) { + scavenge(where + 1, sizeof(struct fdefn) / sizeof(lispobj) - 1); - /* Don't write unnecessarily */ - if (fdefn->raw_addr != (char *)(fdefn->function + RAW_ADDR_OFFSET)) - fdefn->raw_addr = (char *)(fdefn->function + RAW_ADDR_OFFSET); + /* Don't write unnecessarily */ + if (fdefn->raw_addr != (char *) (fdefn->function + RAW_ADDR_OFFSET)) + fdefn->raw_addr = (char *) (fdefn->function + RAW_ADDR_OFFSET); - return sizeof(struct fdefn) / sizeof(lispobj); - } - else - return 1; + return sizeof(struct fdefn) / sizeof(lispobj); + } else + return 1; } #endif -static int scav_unboxed(lispobj *where, lispobj object) +static int +scav_unboxed(lispobj * where, lispobj object) { - unsigned long length; + unsigned long length; - length = HeaderValue(object) + 1; - length = CEILING(length, 2); + length = HeaderValue(object) + 1; + length = CEILING(length, 2); - return length; + return length; } -static lispobj trans_unboxed(lispobj object) +static lispobj +trans_unboxed(lispobj object) { - lispobj header; - unsigned long length; + lispobj header; + unsigned long length; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - header = *((lispobj *) PTR(object)); - length = HeaderValue(header) + 1; - length = CEILING(length, 2); + header = *((lispobj *) PTR(object)); + length = HeaderValue(header) + 1; + length = CEILING(length, 2); - return copy_unboxed_object(object, length); + return copy_unboxed_object(object, length); } -static lispobj trans_unboxed_large(lispobj object) +static lispobj +trans_unboxed_large(lispobj object) { - lispobj header; - unsigned long length; + lispobj header; + unsigned long length; - gc_assert(Pointerp(object)); + gc_assert(Pointerp(object)); - header = *((lispobj *) PTR(object)); - length = HeaderValue(header) + 1; - length = CEILING(length, 2); + header = *((lispobj *) PTR(object)); + length = HeaderValue(header) + 1; + length = CEILING(length, 2); - return copy_large_unboxed_object(object, length); + return copy_large_unboxed_object(object, length); } -static int size_unboxed(lispobj *where) +static int +size_unboxed(lispobj * where) { - lispobj header; - unsigned long length; + lispobj header; + unsigned long length; - header = *where; - length = HeaderValue(header) + 1; - length = CEILING(length, 2); + header = *where; + length = HeaderValue(header) + 1; + length = CEILING(length, 2); - return length; + return length; } - + /* Vector-Like Objects */ #define NWORDS(x,y) (CEILING((x),(y)) / (y)) -static int size_string(lispobj *where) +static int +size_string(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - /* - * NOTE: Strings contain one more byte of data than the length - * slot indicates. - */ + /* + * NOTE: Strings contain one more byte of data than the length + * slot indicates. + */ - vector = (struct vector *) where; - length = fixnum_value(vector->length) + 1; + vector = (struct vector *) where; + length = fixnum_value(vector->length) + 1; #ifdef __x86_64 - nwords = CEILING(NWORDS(length, 8) + 2, 2); + nwords = CEILING(NWORDS(length, 8) + 2, 2); #else - nwords = CEILING(NWORDS(length, 4) + 2, 2); + nwords = CEILING(NWORDS(length, 4) + 2, 2); #endif - return nwords; + return nwords; } -static int scav_string(lispobj *where, lispobj object) +static int +scav_string(lispobj * where, lispobj object) { - return size_string(where); + return size_string(where); } -static lispobj trans_string(lispobj object) +static lispobj +trans_string(lispobj object) { - gc_assert(Pointerp(object)); - return copy_large_unboxed_object(object, size_string((lispobj *)PTR(object))); + gc_assert(Pointerp(object)); + return copy_large_unboxed_object(object, + size_string((lispobj *) PTR(object))); } - + /************************************************************************ Hash Tables ************************************************************************/ @@ -3361,24 +3492,23 @@ static lispobj trans_string(lispobj object) /* This struct corresponds to the Lisp HASH-TABLE structure defined in hash-new.lisp. */ -struct hash_table -{ - lispobj instance_header; /* 0 */ - lispobj dummy2; - lispobj test; - lispobj test_fun; - lispobj hash_fun; - lispobj rehash_size; /* 5 */ - lispobj rehash_threshold; - lispobj rehash_trigger; - lispobj number_entries; - lispobj table; - lispobj weak_p; /* 10 */ - lispobj needing_rehash; - lispobj next_free_kv; - lispobj index_vector; - lispobj next_vector; - lispobj hash_vector; /* 15 */ +struct hash_table { + lispobj instance_header; /* 0 */ + lispobj dummy2; + lispobj test; + lispobj test_fun; + lispobj hash_fun; + lispobj rehash_size; /* 5 */ + lispobj rehash_threshold; + lispobj rehash_trigger; + lispobj number_entries; + lispobj table; + lispobj weak_p; /* 10 */ + lispobj needing_rehash; + lispobj next_free_kv; + lispobj index_vector; + lispobj next_vector; + lispobj hash_vector; /* 15 */ }; /* The size of a hash-table in Lisp objects. */ @@ -3403,11 +3533,11 @@ static lispobj weak_hash_tables; /* Return true if OBJ will survive the current GC. */ static inline int -survives_gc (lispobj obj) +survives_gc(lispobj obj) { - if (!Pointerp (obj) || !from_space_p (obj)) - return 1; - return *(lispobj *) PTR (obj) == 1; + if (!Pointerp(obj) || !from_space_p(obj)) + return 1; + return *(lispobj *) PTR(obj) == 1; } /* If OBJ is a (UNSIGNED-BYTE 32) array, return a pointer to its first @@ -3415,23 +3545,21 @@ survives_gc (lispobj obj) the array's length. */ static inline unsigned * -u32_vector (lispobj obj, unsigned *length) +u32_vector(lispobj obj, unsigned *length) { - unsigned *ptr = NULL; - - if (Pointerp (obj)) - { - lispobj *p = (lispobj *) PTR (obj); - - if (TypeOf (p[0]) == type_SimpleArrayUnsignedByte32) - { - ptr = (unsigned *) (p + 2); - if (length) - *length = fixnum_value (p[1]); + unsigned *ptr = NULL; + + if (Pointerp(obj)) { + lispobj *p = (lispobj *) PTR(obj); + + if (TypeOf(p[0]) == type_SimpleArrayUnsignedByte32) { + ptr = (unsigned *) (p + 2); + if (length) + *length = fixnum_value(p[1]); } } - return ptr; + return ptr; } /* Free an entry of hash-table HASH-TABLE whose hash index (index in @@ -3439,76 +3567,72 @@ u32_vector (lispobj obj, unsigned *length) in the hash-table's TABLE vector is KV_INDEX. */ static inline void -free_hash_entry (struct hash_table *hash_table, int hash_index, - int kv_index) -{ - unsigned *index_vector = u32_vector (hash_table->index_vector, 0); - unsigned *next_vector = u32_vector (hash_table->next_vector, 0); - int free_p = 1; - - if (index_vector[hash_index] == kv_index) - /* The entry is the first in the collinion chain. - Pop it from the list. */ - index_vector[hash_index] = next_vector[kv_index]; - else - { - /* The entry is not the first in the collision chain. */ - unsigned prev = index_vector[hash_index]; - unsigned i = next_vector[prev]; +free_hash_entry(struct hash_table *hash_table, int hash_index, int kv_index) +{ + unsigned *index_vector = u32_vector(hash_table->index_vector, 0); + unsigned *next_vector = u32_vector(hash_table->next_vector, 0); + int free_p = 1; + + if (index_vector[hash_index] == kv_index) + /* The entry is the first in the collinion chain. + Pop it from the list. */ + index_vector[hash_index] = next_vector[kv_index]; + else { + /* The entry is not the first in the collision chain. */ + unsigned prev = index_vector[hash_index]; + unsigned i = next_vector[prev]; - while (i && i != kv_index) - prev = i, i = next_vector[i]; + while (i && i != kv_index) + prev = i, i = next_vector[i]; - if (i == kv_index) - next_vector[prev] = next_vector[kv_index]; - else - free_p = 0; + if (i == kv_index) + next_vector[prev] = next_vector[kv_index]; + else + free_p = 0; } - if (free_p) - { - unsigned count = fixnum_value (hash_table->number_entries); - gc_assert (count > 0); - hash_table->number_entries = make_fixnum (count - 1); - next_vector[kv_index] = fixnum_value (hash_table->next_free_kv); - hash_table->next_free_kv = make_fixnum (kv_index); + if (free_p) { + unsigned count = fixnum_value(hash_table->number_entries); + + gc_assert(count > 0); + hash_table->number_entries = make_fixnum(count - 1); + next_vector[kv_index] = fixnum_value(hash_table->next_free_kv); + hash_table->next_free_kv = make_fixnum(kv_index); } } - + /* Record an entry of hash-table HASH-TABLE whose hash index (index in the hash-table's INDEX-VECTOR) is HASH_INDEX, and whose index in the hash-table's TABLE vector is KV_INDEX, for rehashing. */ static inline void -record_for_rehashing (struct hash_table *hash_table, int hash_index, - int kv_index) -{ - unsigned *index_vector = u32_vector (hash_table->index_vector, 0); - unsigned *next_vector = u32_vector (hash_table->next_vector, 0); - int rehash_p = 1; - - if (index_vector[hash_index] == kv_index) - /* This entry is at the head of the collision chain. - Pop it from that list. */ - index_vector[hash_index] = next_vector[kv_index]; - else - { - unsigned prev = index_vector[hash_index]; - unsigned i = next_vector[prev]; - - while (i && i != kv_index) - prev = i, i = next_vector[i]; - - if (i == kv_index) - next_vector[prev] = next_vector[kv_index]; - else - rehash_p = 0; +record_for_rehashing(struct hash_table *hash_table, int hash_index, + int kv_index) +{ + unsigned *index_vector = u32_vector(hash_table->index_vector, 0); + unsigned *next_vector = u32_vector(hash_table->next_vector, 0); + int rehash_p = 1; + + if (index_vector[hash_index] == kv_index) + /* This entry is at the head of the collision chain. + Pop it from that list. */ + index_vector[hash_index] = next_vector[kv_index]; + else { + unsigned prev = index_vector[hash_index]; + unsigned i = next_vector[prev]; + + while (i && i != kv_index) + prev = i, i = next_vector[i]; + + if (i == kv_index) + next_vector[prev] = next_vector[kv_index]; + else + rehash_p = 0; } - if (rehash_p) - { - next_vector[kv_index] = fixnum_value (hash_table->needing_rehash); - hash_table->needing_rehash = make_fixnum (kv_index); + if (rehash_p) { + next_vector[kv_index] = fixnum_value(hash_table->needing_rehash); + hash_table->needing_rehash = make_fixnum(kv_index); } } @@ -3517,56 +3641,53 @@ record_for_rehashing (struct hash_table *hash_table, int hash_index, end of a GC. WEAK zero means this function is called for scavenging a non-weak hash-table. Value is the number of entries scheduled for rehashing or removed. */ - + static void -scav_hash_entries (struct hash_table *hash_table, int weak) -{ - unsigned kv_length; - lispobj *kv_vector; - unsigned *index_vector, *next_vector, *hash_vector; - unsigned length; - lispobj empty_symbol; - unsigned next_vector_length; - unsigned i; - - kv_vector = (lispobj *) PTR (hash_table->table); - kv_length = fixnum_value (kv_vector[1]); - kv_vector += 2; - - empty_symbol = kv_vector[1]; - - index_vector = u32_vector (hash_table->index_vector, &length); - next_vector = u32_vector (hash_table->next_vector, &next_vector_length); - hash_vector = u32_vector (hash_table->hash_vector, 0); - - gc_assert (index_vector && next_vector); - gc_assert (next_vector_length * 2 == kv_length); - - for (i = 1; i < next_vector_length; i++) - { - lispobj old_key = kv_vector[2 * i]; - unsigned int old_index = EQ_HASH (old_key) % length; - lispobj new_key; - unsigned int new_index; - - if (weak - && !survives_gc (old_key) - && index_vector[old_index] != 0 - && (hash_vector == 0 || hash_vector[i] == 0x80000000)) - free_hash_entry (hash_table, old_index, i); - else - { - /* If the key is EQ-hashed and moves, schedule it for rehashing. */ - scavenge (&kv_vector[2 * i], 2); - new_key = kv_vector[2 * i]; - new_index = EQ_HASH (new_key) % length; - - if (old_index != new_index - && index_vector[old_index] != 0 - && (hash_vector == 0 || hash_vector[i] == 0x80000000) - && (new_key != empty_symbol - || kv_vector[2 * i + 1] != empty_symbol)) - record_for_rehashing (hash_table, old_index, i); +scav_hash_entries(struct hash_table *hash_table, int weak) +{ + unsigned kv_length; + lispobj *kv_vector; + unsigned *index_vector, *next_vector, *hash_vector; + unsigned length; + lispobj empty_symbol; + unsigned next_vector_length; + unsigned i; + + kv_vector = (lispobj *) PTR(hash_table->table); + kv_length = fixnum_value(kv_vector[1]); + kv_vector += 2; + + empty_symbol = kv_vector[1]; + + index_vector = u32_vector(hash_table->index_vector, &length); + next_vector = u32_vector(hash_table->next_vector, &next_vector_length); + hash_vector = u32_vector(hash_table->hash_vector, 0); + + gc_assert(index_vector && next_vector); + gc_assert(next_vector_length * 2 == kv_length); + + for (i = 1; i < next_vector_length; i++) { + lispobj old_key = kv_vector[2 * i]; + unsigned int old_index = EQ_HASH(old_key) % length; + lispobj new_key; + unsigned int new_index; + + if (weak && !survives_gc(old_key) + && index_vector[old_index] != 0 + && (hash_vector == 0 || hash_vector[i] == 0x80000000)) + free_hash_entry(hash_table, old_index, i); + else { + /* If the key is EQ-hashed and moves, schedule it for rehashing. */ + scavenge(&kv_vector[2 * i], 2); + new_key = kv_vector[2 * i]; + new_index = EQ_HASH(new_key) % length; + + if (old_index != new_index + && index_vector[old_index] != 0 + && (hash_vector == 0 || hash_vector[i] == 0x80000000) + && (new_key != empty_symbol + || kv_vector[2 * i + 1] != empty_symbol)) + record_for_rehashing(hash_table, old_index, i); } } } @@ -3576,506 +3697,569 @@ scav_hash_entries (struct hash_table *hash_table, int weak) otherwise. */ static int -scav_weak_entries (struct hash_table *hash_table) -{ - lispobj *kv_vector; - unsigned *index_vector, *hash_vector; - unsigned length; - unsigned next_vector_length; - unsigned i, scavenged = 0; - - kv_vector = (lispobj *) PTR (hash_table->table) + 2; - - index_vector = u32_vector (hash_table->index_vector, &length); - u32_vector (hash_table->next_vector, &next_vector_length); - hash_vector = u32_vector (hash_table->hash_vector, 0); - - for (i = 1; i < next_vector_length; i++) - { - lispobj old_key = kv_vector[2 * i]; - unsigned int old_index = EQ_HASH (old_key) % length; - - /* If the key survives, scavenge its value, for the case that - the only reference to a key in a weak table is a value in - another weak table. Don't scavenge the value twice; - scan_weak_tables calls this function more than once for the - same hash table. */ - if (survives_gc (old_key) - && index_vector[old_index] != 0 - && (hash_vector == 0 || hash_vector[old_index] == 0x80000000) - && !survives_gc (kv_vector[2 * i + 1])) - { - scavenge (&kv_vector[2 * i + 1], 1); - scavenged = 1; +scav_weak_entries(struct hash_table *hash_table) +{ + lispobj *kv_vector; + unsigned *index_vector, *hash_vector; + unsigned length; + unsigned next_vector_length; + unsigned i, scavenged = 0; + + kv_vector = (lispobj *) PTR(hash_table->table) + 2; + + index_vector = u32_vector(hash_table->index_vector, &length); + u32_vector(hash_table->next_vector, &next_vector_length); + hash_vector = u32_vector(hash_table->hash_vector, 0); + + for (i = 1; i < next_vector_length; i++) { + lispobj old_key = kv_vector[2 * i]; + unsigned int old_index = EQ_HASH(old_key) % length; + + /* If the key survives, scavenge its value, for the case that + the only reference to a key in a weak table is a value in + another weak table. Don't scavenge the value twice; + scan_weak_tables calls this function more than once for the + same hash table. */ + if (survives_gc(old_key) + && index_vector[old_index] != 0 + && (hash_vector == 0 || hash_vector[old_index] == 0x80000000) + && !survives_gc(kv_vector[2 * i + 1])) { + scavenge(&kv_vector[2 * i + 1], 1); + scavenged = 1; } } - return scavenged; + return scavenged; } /* Process weak hash-tables at the end of a GC. */ static void -scan_weak_tables (void) +scan_weak_tables(void) { - lispobj table, next; - int more_scavenged; + lispobj table, next; + int more_scavenged; - /* Scavenge hash values of surviving keys, until there is nothing - new. This is for the case that the only reference to a weak key - is a value in another weak table. */ - do - { - more_scavenged = 0; - - for (table = weak_hash_tables; table != NIL; table = next) - { - struct hash_table *ht = (struct hash_table *) PTR (table); - next = ht->weak_p; - if (scav_weak_entries (ht)) - more_scavenged = 1; + /* Scavenge hash values of surviving keys, until there is nothing + new. This is for the case that the only reference to a weak key + is a value in another weak table. */ + do { + more_scavenged = 0; + + for (table = weak_hash_tables; table != NIL; table = next) { + struct hash_table *ht = (struct hash_table *) PTR(table); + + next = ht->weak_p; + if (scav_weak_entries(ht)) + more_scavenged = 1; } } - while (more_scavenged); - - for (table = weak_hash_tables; table != NIL; table = next) - { - struct hash_table *ht = (struct hash_table *) PTR (table); - next = ht->weak_p; - ht->weak_p = T; - scav_hash_entries (ht, 1); + while (more_scavenged); + + for (table = weak_hash_tables; table != NIL; table = next) { + struct hash_table *ht = (struct hash_table *) PTR(table); + + next = ht->weak_p; + ht->weak_p = T; + scav_hash_entries(ht, 1); } - weak_hash_tables = NIL; + weak_hash_tables = NIL; } /* Scavenge a key/value vector of a hash-table. */ static int -scav_hash_vector (lispobj *where, lispobj object) +scav_hash_vector(lispobj * where, lispobj object) { - unsigned int kv_length; - lispobj *kv_vector; - lispobj empty_symbol, hash_table_obj; - struct hash_table *hash_table; + unsigned int kv_length; + lispobj *kv_vector; + lispobj empty_symbol, hash_table_obj; + struct hash_table *hash_table; - if (HeaderValue (object) != subtype_VectorValidHashing) - return 1; + if (HeaderValue(object) != subtype_VectorValidHashing) + return 1; + + /* WHERE is a hash table key/value vector. First word is header, + second is vector length. Keys and values follow after the + length. The first value is the symbol :empty, the first key is a + reference to the hash-table containing the key/value vector. + (See hash-new.lisp, MAKE-HASH-TABLE.) */ + + kv_length = fixnum_value(where[1]); + kv_vector = where + 2; - /* WHERE is a hash table key/value vector. First word is header, - second is vector length. Keys and values follow after the - length. The first value is the symbol :empty, the first key is a - reference to the hash-table containing the key/value vector. - (See hash-new.lisp, MAKE-HASH-TABLE.) */ - - kv_length = fixnum_value (where[1]); - kv_vector = where + 2; - - scavenge (kv_vector, 2); - - gc_assert (Pointerp (kv_vector[0])); - gc_assert (Pointerp (kv_vector[1])); - - hash_table_obj = kv_vector[0]; - hash_table = (struct hash_table *) PTR (hash_table_obj); - empty_symbol = kv_vector[1]; - - /* - * For some reason, the following GC assert doesn't always hold true - * on Sparc/gencgc. I (RLT) don't know why that is. So turn it off - * for now. I leave these printfs here so I can see it happening, - * just in case. - * - * Some checks using an *after-gc-hooks* to check hash tables - * indicates that the invariant we're testing is actually still - * true. It appears that it just happens not to be true when we're - * scavenging the hash vector. I don't know why. - */ + scavenge(kv_vector, 2); + + gc_assert(Pointerp(kv_vector[0])); + gc_assert(Pointerp(kv_vector[1])); + + hash_table_obj = kv_vector[0]; + hash_table = (struct hash_table *) PTR(hash_table_obj); + empty_symbol = kv_vector[1]; + + /* + * For some reason, the following GC assert doesn't always hold true + * on Sparc/gencgc. I (RLT) don't know why that is. So turn it off + * for now. I leave these printfs here so I can see it happening, + * just in case. + * + * Some checks using an *after-gc-hooks* to check hash tables + * indicates that the invariant we're testing is actually still + * true. It appears that it just happens not to be true when we're + * scavenging the hash vector. I don't know why. + */ #if 0 && defined(sparc) - if (where != (lispobj *) PTR (hash_table->table)) - { - fprintf(stderr, "Hash table invariant failed during scavenging!\n"); - fprintf(stderr, " *** where = %lx\n", where); - fprintf(stderr, " *** hash_table = %lx\n", hash_table); - fprintf(stderr, " *** hash_table->table = %lx\n", PTR(hash_table->table)); + if (where != (lispobj *) PTR(hash_table->table)) { + fprintf(stderr, "Hash table invariant failed during scavenging!\n"); + fprintf(stderr, " *** where = %lx\n", where); + fprintf(stderr, " *** hash_table = %lx\n", hash_table); + fprintf(stderr, " *** hash_table->table = %lx\n", + PTR(hash_table->table)); } -#endif +#endif #ifndef sparc - gc_assert (where == (lispobj *) PTR (hash_table->table)); + gc_assert(where == (lispobj *) PTR(hash_table->table)); #endif - gc_assert (TypeOf (hash_table->instance_header) == type_InstanceHeader); - gc_assert (TypeOf (*(lispobj *) PTR (empty_symbol)) == type_SymbolHeader); + gc_assert(TypeOf(hash_table->instance_header) == type_InstanceHeader); + gc_assert(TypeOf(*(lispobj *) PTR(empty_symbol)) == type_SymbolHeader); - /* Scavenging the hash table which fix the positions of the other - needed objects. */ - scavenge ((lispobj *) hash_table, HASH_TABLE_SIZE); + /* Scavenging the hash table which fix the positions of the other + needed objects. */ + scavenge((lispobj *) hash_table, HASH_TABLE_SIZE); - /* Testing for T here instead of NIL automatially makes sure we - don't add the same table twice to the list of weak tables, should - this function ever be called twice for the same object. */ - if (hash_table->weak_p == T) - { - hash_table->weak_p = weak_hash_tables; - weak_hash_tables = hash_table_obj; - } - else - scav_hash_entries (hash_table, 0); - - return CEILING (kv_length + 2, 2); -} + /* Testing for T here instead of NIL automatially makes sure we + don't add the same table twice to the list of weak tables, should + this function ever be called twice for the same object. */ + if (hash_table->weak_p == T) { + hash_table->weak_p = weak_hash_tables; + weak_hash_tables = hash_table_obj; + } else + scav_hash_entries(hash_table, 0); + return CEILING(kv_length + 2, 2); +} -static int size_vector(lispobj *where) + +static int +size_vector(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + vector = (struct vector *) where; + length = fixnum_value(vector->length); + nwords = CEILING(length + 2, 2); - return nwords; + return nwords; } -static lispobj trans_vector(lispobj object) +static lispobj +trans_vector(lispobj object) { - gc_assert(Pointerp(object)); - return copy_large_object(object, size_vector((lispobj *)PTR(object))); + gc_assert(Pointerp(object)); + return copy_large_object(object, size_vector((lispobj *) PTR(object))); } -static int size_vector_bit(lispobj *where) +static int +size_vector_bit(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef __x86_64 - nwords = CEILING(NWORDS(length, 64) + 2, 2); + nwords = CEILING(NWORDS(length, 64) + 2, 2); #else - nwords = CEILING(NWORDS(length, 32) + 2, 2); + nwords = CEILING(NWORDS(length, 32) + 2, 2); #endif - return nwords; + return nwords; } -static int scav_vector_bit(lispobj *where, lispobj object) +static int +scav_vector_bit(lispobj * where, lispobj object) { - return size_vector_bit(where); + return size_vector_bit(where); } -static lispobj trans_vector_bit(lispobj object) +static lispobj +trans_vector_bit(lispobj object) { - gc_assert(Pointerp(object)); - return copy_large_unboxed_object(object, size_vector_bit((lispobj *)PTR(object))); + gc_assert(Pointerp(object)); + return copy_large_unboxed_object(object, + size_vector_bit((lispobj *) PTR(object))); } -static int size_vector_unsigned_byte_2(lispobj *where) +static int +size_vector_unsigned_byte_2(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef __x86_64 - nwords = CEILING(NWORDS(length, 32) + 2, 2); + nwords = CEILING(NWORDS(length, 32) + 2, 2); #else - nwords = CEILING(NWORDS(length, 16) + 2, 2); + nwords = CEILING(NWORDS(length, 16) + 2, 2); #endif - return nwords; + return nwords; } -static int scav_vector_unsigned_byte_2(lispobj *where, lispobj object) +static int +scav_vector_unsigned_byte_2(lispobj * where, lispobj object) { - return size_vector_unsigned_byte_2(where); + return size_vector_unsigned_byte_2(where); } -static lispobj trans_vector_unsigned_byte_2(lispobj object) +static lispobj +trans_vector_unsigned_byte_2(lispobj object) { - gc_assert(Pointerp(object)); - return copy_large_unboxed_object(object, size_vector_unsigned_byte_2((lispobj *)PTR(object))); + gc_assert(Pointerp(object)); + return copy_large_unboxed_object(object, + size_vector_unsigned_byte_2((lispobj *) + PTR(object))); } -static int size_vector_unsigned_byte_4(lispobj *where) +static int +size_vector_unsigned_byte_4(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef __x86_64 - nwords = CEILING(NWORDS(length, 16) + 2, 2); + nwords = CEILING(NWORDS(length, 16) + 2, 2); #else - nwords = CEILING(NWORDS(length, 8) + 2, 2); + nwords = CEILING(NWORDS(length, 8) + 2, 2); #endif - return nwords; + return nwords; } -static int scav_vector_unsigned_byte_4(lispobj *where, lispobj object) +static int +scav_vector_unsigned_byte_4(lispobj * where, lispobj object) { - return size_vector_unsigned_byte_4(where); + return size_vector_unsigned_byte_4(where); } -static lispobj trans_vector_unsigned_byte_4(lispobj object) +static lispobj +trans_vector_unsigned_byte_4(lispobj object) { - gc_assert(Pointerp(object)); - return copy_large_unboxed_object(object, size_vector_unsigned_byte_4((lispobj *)PTR(object))); + gc_assert(Pointerp(object)); + return copy_large_unboxed_object(object, + size_vector_unsigned_byte_4((lispobj *) + PTR(object))); } -static int size_vector_unsigned_byte_8(lispobj *where) +static int +size_vector_unsigned_byte_8(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef __x86_64 - nwords = CEILING(NWORDS(length, 8) + 2, 2); + nwords = CEILING(NWORDS(length, 8) + 2, 2); #else - nwords = CEILING(NWORDS(length, 4) + 2, 2); + nwords = CEILING(NWORDS(length, 4) + 2, 2); #endif - return nwords; + return nwords; } -static int scav_vector_unsigned_byte_8(lispobj *where, lispobj object) +static int +scav_vector_unsigned_byte_8(lispobj * where, lispobj object) { - return size_vector_unsigned_byte_8(where); + return size_vector_unsigned_byte_8(where); } -static lispobj trans_vector_unsigned_byte_8(lispobj object) +static lispobj +trans_vector_unsigned_byte_8(lispobj object) { - gc_assert(Pointerp(object)); - return copy_large_unboxed_object(object, size_vector_unsigned_byte_8((lispobj *)PTR(object))); + gc_assert(Pointerp(object)); + return copy_large_unboxed_object(object, + size_vector_unsigned_byte_8((lispobj *) + PTR(object))); } -static int size_vector_unsigned_byte_16(lispobj *where) +static int +size_vector_unsigned_byte_16(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef __x86_64 - nwords = CEILING(NWORDS(length, 4) + 2, 2); + nwords = CEILING(NWORDS(length, 4) + 2, 2); #else - nwords = CEILING(NWORDS(length, 2) + 2, 2); + nwords = CEILING(NWORDS(length, 2) + 2, 2); #endif - return nwords; + return nwords; } -static int scav_vector_unsigned_byte_16(lispobj *where, lispobj object) +static int +scav_vector_unsigned_byte_16(lispobj * where, lispobj object) { - return size_vector_unsigned_byte_16(where); + return size_vector_unsigned_byte_16(where); } -static lispobj trans_vector_unsigned_byte_16(lispobj object) +static lispobj +trans_vector_unsigned_byte_16(lispobj object) { - gc_assert(Pointerp(object)); - return copy_large_unboxed_object(object, size_vector_unsigned_byte_16((lispobj *)PTR(object))); + gc_assert(Pointerp(object)); + return copy_large_unboxed_object(object, + size_vector_unsigned_byte_16((lispobj *) + PTR(object))); } -static int size_vector_unsigned_byte_32(lispobj *where) +static int +size_vector_unsigned_byte_32(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef __x86_64 - nwords = CEILING(NWORDS(length, 2) + 2, 2); + nwords = CEILING(NWORDS(length, 2) + 2, 2); #else - nwords = CEILING(length + 2, 2); + nwords = CEILING(length + 2, 2); #endif - return nwords; + return nwords; } -static int scav_vector_unsigned_byte_32(lispobj *where, lispobj object) +static int +scav_vector_unsigned_byte_32(lispobj * where, lispobj object) { - return size_vector_unsigned_byte_32(where); + return size_vector_unsigned_byte_32(where); } -static lispobj trans_vector_unsigned_byte_32(lispobj object) +static lispobj +trans_vector_unsigned_byte_32(lispobj object) { - gc_assert(Pointerp(object)); - return copy_large_unboxed_object(object, size_vector_unsigned_byte_32((lispobj *)PTR(object))); + gc_assert(Pointerp(object)); + return copy_large_unboxed_object(object, + size_vector_unsigned_byte_32((lispobj *) + PTR(object))); } -static int size_vector_single_float(lispobj *where) +static int +size_vector_single_float(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef __x86_64 - nwords = CEILING(NWORDS(length,2) + 2, 2); + nwords = CEILING(NWORDS(length, 2) + 2, 2); #else - nwords = CEILING(length + 2, 2); + nwords = CEILING(length + 2, 2); #endif - return nwords; + return nwords; } -static int scav_vector_single_float(lispobj *where, lispobj object) +static int +scav_vector_single_float(lispobj * where, lispobj object) { return size_vector_single_float(where); } -static lispobj trans_vector_single_float(lispobj object) +static lispobj +trans_vector_single_float(lispobj object) { - gc_assert(Pointerp(object)); - return copy_large_unboxed_object(object, size_vector_single_float((lispobj *)PTR(object))); + gc_assert(Pointerp(object)); + return copy_large_unboxed_object(object, + size_vector_single_float((lispobj *) + PTR(object))); } -static int size_vector_double_float(lispobj *where) +static int +size_vector_double_float(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef __x86_64 - nwords = CEILING(length + 2, 2); + nwords = CEILING(length + 2, 2); #else - nwords = length * 2 + 2; /* alignment guaranteed */ + nwords = length * 2 + 2; /* alignment guaranteed */ #endif - return nwords; + return nwords; } -static int scav_vector_double_float(lispobj *where, lispobj object) +static int +scav_vector_double_float(lispobj * where, lispobj object) { - return size_vector_double_float(where); + return size_vector_double_float(where); } -static lispobj trans_vector_double_float(lispobj object) +static lispobj +trans_vector_double_float(lispobj object) { - gc_assert(Pointerp(object)); - return copy_large_unboxed_object(object, size_vector_double_float((lispobj *)PTR(object))); + gc_assert(Pointerp(object)); + return copy_large_unboxed_object(object, + size_vector_double_float((lispobj *) + PTR(object))); } #ifdef type_SimpleArrayLongFloat -static int size_vector_long_float(lispobj *where) +static int +size_vector_long_float(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef __x86_64 - nwords = length * 2 + 2; /* alignment guaranteed */ + nwords = length * 2 + 2; /* alignment guaranteed */ #else - nwords = CEILING(length * 3 + 2, 2); + nwords = CEILING(length * 3 + 2, 2); #endif - return nwords; + return nwords; } -static int scav_vector_long_float(lispobj *where, lispobj object) +static int +scav_vector_long_float(lispobj * where, lispobj object) { return size_vector_long_float(where); } -static lispobj trans_vector_long_float(lispobj object) +static lispobj +trans_vector_long_float(lispobj object) { - gc_assert(Pointerp(object)); - return copy_large_unboxed_object(object, size_vector_long_float((lispobj *)PTR(object))); + gc_assert(Pointerp(object)); + return copy_large_unboxed_object(object, + size_vector_long_float((lispobj *) + PTR(object))); } #endif #ifdef type_SimpleArrayComplexSingleFloat -static int size_vector_complex_single_float(lispobj *where) +static int +size_vector_complex_single_float(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef __x86_64 - nwords = CEILING(length + 2, 2); + nwords = CEILING(length + 2, 2); #else - nwords = length * 2 + 2; /* this must be an even number */ + nwords = length * 2 + 2; /* this must be an even number */ #endif - return nwords; + return nwords; } -static int scav_vector_complex_single_float(lispobj *where, lispobj object) +static int +scav_vector_complex_single_float(lispobj * where, lispobj object) { - return size_vector_complex_single_float(where); + return size_vector_complex_single_float(where); } -static lispobj trans_vector_complex_single_float(lispobj object) +static lispobj +trans_vector_complex_single_float(lispobj object) { - gc_assert(Pointerp(object)); - return copy_large_unboxed_object(object, size_vector_complex_single_float((lispobj *)PTR(object))); + gc_assert(Pointerp(object)); + return copy_large_unboxed_object(object, + size_vector_complex_single_float( + (lispobj + *) + PTR + (object))); } #endif #ifdef type_SimpleArrayComplexDoubleFloat -static int size_vector_complex_double_float(lispobj *where) +static int +size_vector_complex_double_float(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef __x86_64 - nwords = length * 2 + 2; /* alignment guaranteed */ + nwords = length * 2 + 2; /* alignment guaranteed */ #else - nwords = length * 4 + 2; /* this must be an even number */ + nwords = length * 4 + 2; /* this must be an even number */ #endif - return nwords; + return nwords; } -static int scav_vector_complex_double_float(lispobj *where, lispobj object) +static int +scav_vector_complex_double_float(lispobj * where, lispobj object) { - return size_vector_complex_double_float(where); + return size_vector_complex_double_float(where); } -static lispobj trans_vector_complex_double_float(lispobj object) +static lispobj +trans_vector_complex_double_float(lispobj object) { - gc_assert(Pointerp(object)); - return copy_large_unboxed_object(object, size_vector_complex_double_float((lispobj *)PTR(object))); + gc_assert(Pointerp(object)); + return copy_large_unboxed_object(object, + size_vector_complex_double_float( + (lispobj + *) + PTR + (object))); } #endif #ifdef type_SimpleArrayComplexLongFloat -static int size_vector_complex_long_float(lispobj *where) +static int +size_vector_complex_long_float(lispobj * where) { - struct vector *vector; - int length, nwords; + struct vector *vector; + int length, nwords; - vector = (struct vector *) where; - length = fixnum_value(vector->length); + vector = (struct vector *) where; + length = fixnum_value(vector->length); #ifdef __x86_64 - nwords = length * 4 + 2; /* alignment guaranteed */ + nwords = length * 4 + 2; /* alignment guaranteed */ #else - nwords = length * 6 + 2; /* alignment guaranteed */ + nwords = length * 6 + 2; /* alignment guaranteed */ #endif - return nwords; + return nwords; } -static int scav_vector_complex_long_float(lispobj *where, lispobj object) +static int +scav_vector_complex_long_float(lispobj * where, lispobj object) { - return size_vector_complex_long_float(where); + return size_vector_complex_long_float(where); } -static lispobj trans_vector_complex_long_float(lispobj object) +static lispobj +trans_vector_complex_long_float(lispobj object) { - gc_assert(Pointerp(object)); - return copy_large_unboxed_object(object, size_vector_complex_long_float((lispobj *)PTR(object))); + gc_assert(Pointerp(object)); + return copy_large_unboxed_object(object, + size_vector_complex_long_float((lispobj *) + PTR + (object))); } #endif - + /* Weak Pointers */ /* @@ -4089,120 +4273,121 @@ static lispobj trans_vector_complex_long_float(lispobj object) CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2) static int -scav_weak_pointer (lispobj *where, lispobj object) +scav_weak_pointer(lispobj * where, lispobj object) { - struct weak_pointer *this_wp = (struct weak_pointer *) where; - if (this_wp->mark_bit == NIL) - { - this_wp->mark_bit = T; - this_wp->next = weak_pointers; - weak_pointers = this_wp; + struct weak_pointer *this_wp = (struct weak_pointer *) where; + + if (this_wp->mark_bit == NIL) { + this_wp->mark_bit = T; + this_wp->next = weak_pointers; + weak_pointers = this_wp; } - return WEAK_POINTER_NWORDS; + return WEAK_POINTER_NWORDS; } static lispobj -trans_weak_pointer (lispobj object) +trans_weak_pointer(lispobj object) { - gc_assert (Pointerp (object)); - return copy_object (object, WEAK_POINTER_NWORDS); + gc_assert(Pointerp(object)); + return copy_object(object, WEAK_POINTER_NWORDS); } static int -size_weak_pointer (lispobj *where) +size_weak_pointer(lispobj * where) { - return WEAK_POINTER_NWORDS; + return WEAK_POINTER_NWORDS; } void -scan_weak_pointers (void) +scan_weak_pointers(void) { - struct weak_pointer *wp; - - for (wp = weak_pointers; wp; wp = wp->next) - { - lispobj value = wp->value; - lispobj *first_pointer = (lispobj *) PTR (value); - - wp->mark_bit = NIL; - if (Pointerp (value) && from_space_p (value)) - { - if (first_pointer[0] == 0x01) - wp->value = first_pointer[1]; - else - { - wp->value = NIL; - wp->broken = T; + struct weak_pointer *wp; + + for (wp = weak_pointers; wp; wp = wp->next) { + lispobj value = wp->value; + lispobj *first_pointer = (lispobj *) PTR(value); + + wp->mark_bit = NIL; + if (Pointerp(value) && from_space_p(value)) { + if (first_pointer[0] == 0x01) + wp->value = first_pointer[1]; + else { + wp->value = NIL; + wp->broken = T; } } } } - + /* Scavenged Hooks */ #define SCAVENGER_HOOK_NWORDS \ CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2) -static int scav_scavenger_hook(lispobj *where, lispobj object) +static int +scav_scavenger_hook(lispobj * where, lispobj object) { - struct scavenger_hook *scav_hook = (struct scavenger_hook *) where; - lispobj old_value = scav_hook->value; + struct scavenger_hook *scav_hook = (struct scavenger_hook *) where; + lispobj old_value = scav_hook->value; #if 0 - fprintf(stderr, "scav scav_hook %x; value %x\n", where, old_value); + fprintf(stderr, "scav scav_hook %x; value %x\n", where, old_value); #endif - /* Scavenge the value */ - scavenge(where + 1, 1); + /* Scavenge the value */ + scavenge(where + 1, 1); - if (scav_hook->value != old_value) { - /* Value object has moved */ + if (scav_hook->value != old_value) { + /* Value object has moved */ #if 0 - fprintf(stderr, " value object moved to %x\n", scav_hook->value); + fprintf(stderr, " value object moved to %x\n", scav_hook->value); #endif - /* Check if this hook is already noted. */ + /* Check if this hook is already noted. */ #if 0 - fprintf(stderr, " next=%x sh hooks=%x\n", - scav_hook->next, scavenger_hooks); + fprintf(stderr, " next=%x sh hooks=%x\n", + scav_hook->next, scavenger_hooks); #endif - if (scav_hook->next == NULL) { + if (scav_hook->next == NULL) { #if 0 - fprintf(stderr, " adding to scavenger_hooks\n"); + fprintf(stderr, " adding to scavenger_hooks\n"); #endif - scav_hook->next = scavenger_hooks; - scavenger_hooks = (struct scavenger_hook *) ((size_t) where | - type_OtherPointer); + scav_hook->next = scavenger_hooks; + scavenger_hooks = (struct scavenger_hook *) ((size_t) where | + type_OtherPointer); + } } - } - /* Scavenge the function and the tail scavenge_hook */ - return 2; + /* Scavenge the function and the tail scavenge_hook */ + return 2; } -static lispobj trans_scavenger_hook(lispobj object) +static lispobj +trans_scavenger_hook(lispobj object) { - lispobj copy; - gc_assert(Pointerp(object)); + lispobj copy; + + gc_assert(Pointerp(object)); #if 0 - printf("Transporting scav pointer from 0x%08x\n", object); + printf("Transporting scav pointer from 0x%08x\n", object); #endif - copy = copy_object(object, SCAVENGER_HOOK_NWORDS); - return copy; + copy = copy_object(object, SCAVENGER_HOOK_NWORDS); + return copy; } static int -size_scavenger_hook(lispobj *where) +size_scavenger_hook(lispobj * where) { - return SCAVENGER_HOOK_NWORDS; + return SCAVENGER_HOOK_NWORDS; } - + /* Initialization */ -static int scav_lose(lispobj *where, lispobj object) +static int +scav_lose(lispobj * where, lispobj object) { fprintf(stderr, "GC lossage. No scavenge function for object 0x%08lx\n", (unsigned long) object); @@ -4210,7 +4395,8 @@ static int scav_lose(lispobj *where, lispobj object) return 0; } -static lispobj trans_lose(lispobj object) +static lispobj +trans_lose(lispobj object) { fprintf(stderr, "GC lossage. No transport function for object 0x%08lx\n", (unsigned long) object); @@ -4218,548 +4404,563 @@ static lispobj trans_lose(lispobj object) return NIL; } -static int size_lose(lispobj *where) +static int +size_lose(lispobj * where) { - fprintf(stderr, "Size lossage. No size function for object at 0x%08lx\n", - (unsigned long) where); - fprintf(stderr, "First word of object: 0x%08lx\n", - (unsigned long) *where); - return 1; + fprintf(stderr, "Size lossage. No size function for object at 0x%08lx\n", + (unsigned long) where); + fprintf(stderr, "First word of object: 0x%08lx\n", (unsigned long) *where); + return 1; } -static void gc_init_tables(void) +static void +gc_init_tables(void) { - int i; + int i; - /* Scavenge Table */ - for (i = 0; i < 256; i++) - scavtab[i] = scav_lose; - - for (i = 0; i < 32; i++) { - scavtab[type_EvenFixnum | (i << 3)] = scav_immediate; - scavtab[type_FunctionPointer | (i<<3)] = scav_function_pointer; - /* OtherImmediate0 */ - scavtab[type_ListPointer | (i << 3)] = scav_list_pointer; - scavtab[type_OddFixnum | (i << 3)] = scav_immediate; - scavtab[type_InstancePointer | (i<<3)] = scav_instance_pointer; - /* OtherImmediate1 */ - scavtab[type_OtherPointer | (i << 3)] = scav_other_pointer; - } + /* Scavenge Table */ + for (i = 0; i < 256; i++) + scavtab[i] = scav_lose; + + for (i = 0; i < 32; i++) { + scavtab[type_EvenFixnum | (i << 3)] = scav_immediate; + scavtab[type_FunctionPointer | (i << 3)] = scav_function_pointer; + /* OtherImmediate0 */ + scavtab[type_ListPointer | (i << 3)] = scav_list_pointer; + scavtab[type_OddFixnum | (i << 3)] = scav_immediate; + scavtab[type_InstancePointer | (i << 3)] = scav_instance_pointer; + /* OtherImmediate1 */ + scavtab[type_OtherPointer | (i << 3)] = scav_other_pointer; + } - scavtab[type_Bignum] = scav_unboxed; - scavtab[type_Ratio] = scav_boxed; - scavtab[type_SingleFloat] = scav_unboxed; - scavtab[type_DoubleFloat] = scav_unboxed; + scavtab[type_Bignum] = scav_unboxed; + scavtab[type_Ratio] = scav_boxed; + scavtab[type_SingleFloat] = scav_unboxed; + scavtab[type_DoubleFloat] = scav_unboxed; #ifdef type_LongFloat - scavtab[type_LongFloat] = scav_unboxed; + scavtab[type_LongFloat] = scav_unboxed; #endif - scavtab[type_Complex] = scav_boxed; + scavtab[type_Complex] = scav_boxed; #ifdef type_ComplexSingleFloat - scavtab[type_ComplexSingleFloat] = scav_unboxed; + scavtab[type_ComplexSingleFloat] = scav_unboxed; #endif #ifdef type_ComplexDoubleFloat - scavtab[type_ComplexDoubleFloat] = scav_unboxed; + scavtab[type_ComplexDoubleFloat] = scav_unboxed; #endif #ifdef type_ComplexLongFloat - scavtab[type_ComplexLongFloat] = scav_unboxed; -#endif - scavtab[type_SimpleArray] = scav_boxed; - scavtab[type_SimpleString] = scav_string; - scavtab[type_SimpleBitVector] = scav_vector_bit; - scavtab[type_SimpleVector] = scav_hash_vector; - scavtab[type_SimpleArrayUnsignedByte2] = scav_vector_unsigned_byte_2; - scavtab[type_SimpleArrayUnsignedByte4] = scav_vector_unsigned_byte_4; - scavtab[type_SimpleArrayUnsignedByte8] = scav_vector_unsigned_byte_8; - scavtab[type_SimpleArrayUnsignedByte16] = scav_vector_unsigned_byte_16; - scavtab[type_SimpleArrayUnsignedByte32] = scav_vector_unsigned_byte_32; + scavtab[type_ComplexLongFloat] = scav_unboxed; +#endif + scavtab[type_SimpleArray] = scav_boxed; + scavtab[type_SimpleString] = scav_string; + scavtab[type_SimpleBitVector] = scav_vector_bit; + scavtab[type_SimpleVector] = scav_hash_vector; + scavtab[type_SimpleArrayUnsignedByte2] = scav_vector_unsigned_byte_2; + scavtab[type_SimpleArrayUnsignedByte4] = scav_vector_unsigned_byte_4; + scavtab[type_SimpleArrayUnsignedByte8] = scav_vector_unsigned_byte_8; + scavtab[type_SimpleArrayUnsignedByte16] = scav_vector_unsigned_byte_16; + scavtab[type_SimpleArrayUnsignedByte32] = scav_vector_unsigned_byte_32; #ifdef type_SimpleArraySignedByte8 - scavtab[type_SimpleArraySignedByte8] = scav_vector_unsigned_byte_8; + scavtab[type_SimpleArraySignedByte8] = scav_vector_unsigned_byte_8; #endif #ifdef type_SimpleArraySignedByte16 - scavtab[type_SimpleArraySignedByte16] = scav_vector_unsigned_byte_16; + scavtab[type_SimpleArraySignedByte16] = scav_vector_unsigned_byte_16; #endif #ifdef type_SimpleArraySignedByte30 - scavtab[type_SimpleArraySignedByte30] = scav_vector_unsigned_byte_32; + scavtab[type_SimpleArraySignedByte30] = scav_vector_unsigned_byte_32; #endif #ifdef type_SimpleArraySignedByte32 - scavtab[type_SimpleArraySignedByte32] = scav_vector_unsigned_byte_32; + scavtab[type_SimpleArraySignedByte32] = scav_vector_unsigned_byte_32; #endif - scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float; - scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float; + scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float; + scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float; #ifdef type_SimpleArrayLongFloat - scavtab[type_SimpleArrayLongFloat] = scav_vector_long_float; + scavtab[type_SimpleArrayLongFloat] = scav_vector_long_float; #endif #ifdef type_SimpleArrayComplexSingleFloat - scavtab[type_SimpleArrayComplexSingleFloat] = scav_vector_complex_single_float; + scavtab[type_SimpleArrayComplexSingleFloat] = + scav_vector_complex_single_float; #endif #ifdef type_SimpleArrayComplexDoubleFloat - scavtab[type_SimpleArrayComplexDoubleFloat] = scav_vector_complex_double_float; + scavtab[type_SimpleArrayComplexDoubleFloat] = + scav_vector_complex_double_float; #endif #ifdef type_SimpleArrayComplexLongFloat - scavtab[type_SimpleArrayComplexLongFloat] = scav_vector_complex_long_float; + scavtab[type_SimpleArrayComplexLongFloat] = scav_vector_complex_long_float; #endif - scavtab[type_ComplexString] = scav_boxed; - scavtab[type_ComplexBitVector] = scav_boxed; - scavtab[type_ComplexVector] = scav_boxed; - scavtab[type_ComplexArray] = scav_boxed; - scavtab[type_CodeHeader] = scav_code_header; + scavtab[type_ComplexString] = scav_boxed; + scavtab[type_ComplexBitVector] = scav_boxed; + scavtab[type_ComplexVector] = scav_boxed; + scavtab[type_ComplexArray] = scav_boxed; + scavtab[type_CodeHeader] = scav_code_header; #if !(defined(i386) || defined(__x86_64)) - scavtab[type_FunctionHeader] = scav_function_header; - scavtab[type_ClosureFunctionHeader] = scav_function_header; - scavtab[type_ReturnPcHeader] = scav_return_pc_header; + scavtab[type_FunctionHeader] = scav_function_header; + scavtab[type_ClosureFunctionHeader] = scav_function_header; + scavtab[type_ReturnPcHeader] = scav_return_pc_header; #endif #if defined(i386) || defined(__x86_64) - scavtab[type_ClosureHeader] = scav_closure_header; - scavtab[type_FuncallableInstanceHeader] = scav_closure_header; - scavtab[type_ByteCodeFunction] = scav_closure_header; - scavtab[type_ByteCodeClosure] = scav_closure_header; - scavtab[type_DylanFunctionHeader] = scav_closure_header; + scavtab[type_ClosureHeader] = scav_closure_header; + scavtab[type_FuncallableInstanceHeader] = scav_closure_header; + scavtab[type_ByteCodeFunction] = scav_closure_header; + scavtab[type_ByteCodeClosure] = scav_closure_header; + scavtab[type_DylanFunctionHeader] = scav_closure_header; #else - scavtab[type_ClosureHeader] = scav_boxed; - scavtab[type_FuncallableInstanceHeader] = scav_boxed; - scavtab[type_ByteCodeFunction] = scav_boxed; - scavtab[type_ByteCodeClosure] = scav_boxed; - scavtab[type_DylanFunctionHeader] = scav_boxed; -#endif - scavtab[type_ValueCellHeader] = scav_boxed; - scavtab[type_SymbolHeader] = scav_boxed; - scavtab[type_BaseChar] = scav_immediate; - scavtab[type_Sap] = scav_unboxed; - scavtab[type_UnboundMarker] = scav_immediate; - scavtab[type_WeakPointer] = scav_weak_pointer; - scavtab[type_InstanceHeader] = scav_boxed; - /* - * Note: on the sparc we don't have to do anything special for - * fdefns, cause the raw-addr has a function lowtag. - */ + scavtab[type_ClosureHeader] = scav_boxed; + scavtab[type_FuncallableInstanceHeader] = scav_boxed; + scavtab[type_ByteCodeFunction] = scav_boxed; + scavtab[type_ByteCodeClosure] = scav_boxed; + scavtab[type_DylanFunctionHeader] = scav_boxed; +#endif + scavtab[type_ValueCellHeader] = scav_boxed; + scavtab[type_SymbolHeader] = scav_boxed; + scavtab[type_BaseChar] = scav_immediate; + scavtab[type_Sap] = scav_unboxed; + scavtab[type_UnboundMarker] = scav_immediate; + scavtab[type_WeakPointer] = scav_weak_pointer; + scavtab[type_InstanceHeader] = scav_boxed; + /* + * Note: on the sparc we don't have to do anything special for + * fdefns, cause the raw-addr has a function lowtag. + */ #ifndef sparc - scavtab[type_Fdefn] = scav_fdefn; + scavtab[type_Fdefn] = scav_fdefn; #else - scavtab[type_Fdefn] = scav_boxed; + scavtab[type_Fdefn] = scav_boxed; #endif - scavtab[type_ScavengerHook] = scav_scavenger_hook; + scavtab[type_ScavengerHook] = scav_scavenger_hook; - /* Transport Other Table */ - for (i = 0; i < 256; i++) - transother[i] = trans_lose; + /* Transport Other Table */ + for (i = 0; i < 256; i++) + transother[i] = trans_lose; - transother[type_Bignum] = trans_unboxed_large; - transother[type_Ratio] = trans_boxed; - transother[type_SingleFloat] = trans_unboxed; - transother[type_DoubleFloat] = trans_unboxed; + transother[type_Bignum] = trans_unboxed_large; + transother[type_Ratio] = trans_boxed; + transother[type_SingleFloat] = trans_unboxed; + transother[type_DoubleFloat] = trans_unboxed; #ifdef type_LongFloat - transother[type_LongFloat] = trans_unboxed; + transother[type_LongFloat] = trans_unboxed; #endif - transother[type_Complex] = trans_boxed; + transother[type_Complex] = trans_boxed; #ifdef type_ComplexSingleFloat - transother[type_ComplexSingleFloat] = trans_unboxed; + transother[type_ComplexSingleFloat] = trans_unboxed; #endif #ifdef type_ComplexDoubleFloat - transother[type_ComplexDoubleFloat] = trans_unboxed; + transother[type_ComplexDoubleFloat] = trans_unboxed; #endif #ifdef type_ComplexLongFloat - transother[type_ComplexLongFloat] = trans_unboxed; -#endif - transother[type_SimpleArray] = trans_boxed_large; - transother[type_SimpleString] = trans_string; - transother[type_SimpleBitVector] = trans_vector_bit; - transother[type_SimpleVector] = trans_vector; - transother[type_SimpleArrayUnsignedByte2] = trans_vector_unsigned_byte_2; - transother[type_SimpleArrayUnsignedByte4] = trans_vector_unsigned_byte_4; - transother[type_SimpleArrayUnsignedByte8] = trans_vector_unsigned_byte_8; - transother[type_SimpleArrayUnsignedByte16] = trans_vector_unsigned_byte_16; - transother[type_SimpleArrayUnsignedByte32] = trans_vector_unsigned_byte_32; + transother[type_ComplexLongFloat] = trans_unboxed; +#endif + transother[type_SimpleArray] = trans_boxed_large; + transother[type_SimpleString] = trans_string; + transother[type_SimpleBitVector] = trans_vector_bit; + transother[type_SimpleVector] = trans_vector; + transother[type_SimpleArrayUnsignedByte2] = trans_vector_unsigned_byte_2; + transother[type_SimpleArrayUnsignedByte4] = trans_vector_unsigned_byte_4; + transother[type_SimpleArrayUnsignedByte8] = trans_vector_unsigned_byte_8; + transother[type_SimpleArrayUnsignedByte16] = trans_vector_unsigned_byte_16; + transother[type_SimpleArrayUnsignedByte32] = trans_vector_unsigned_byte_32; #ifdef type_SimpleArraySignedByte8 - transother[type_SimpleArraySignedByte8] = trans_vector_unsigned_byte_8; + transother[type_SimpleArraySignedByte8] = trans_vector_unsigned_byte_8; #endif #ifdef type_SimpleArraySignedByte16 - transother[type_SimpleArraySignedByte16] = trans_vector_unsigned_byte_16; + transother[type_SimpleArraySignedByte16] = trans_vector_unsigned_byte_16; #endif #ifdef type_SimpleArraySignedByte30 - transother[type_SimpleArraySignedByte30] = trans_vector_unsigned_byte_32; + transother[type_SimpleArraySignedByte30] = trans_vector_unsigned_byte_32; #endif #ifdef type_SimpleArraySignedByte32 - transother[type_SimpleArraySignedByte32] = trans_vector_unsigned_byte_32; + transother[type_SimpleArraySignedByte32] = trans_vector_unsigned_byte_32; #endif - transother[type_SimpleArraySingleFloat] = trans_vector_single_float; - transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float; + transother[type_SimpleArraySingleFloat] = trans_vector_single_float; + transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float; #ifdef type_SimpleArrayLongFloat - transother[type_SimpleArrayLongFloat] = trans_vector_long_float; + transother[type_SimpleArrayLongFloat] = trans_vector_long_float; #endif #ifdef type_SimpleArrayComplexSingleFloat - transother[type_SimpleArrayComplexSingleFloat] = trans_vector_complex_single_float; + transother[type_SimpleArrayComplexSingleFloat] = + trans_vector_complex_single_float; #endif #ifdef type_SimpleArrayComplexDoubleFloat - transother[type_SimpleArrayComplexDoubleFloat] = trans_vector_complex_double_float; + transother[type_SimpleArrayComplexDoubleFloat] = + trans_vector_complex_double_float; #endif #ifdef type_SimpleArrayComplexLongFloat - transother[type_SimpleArrayComplexLongFloat] = trans_vector_complex_long_float; -#endif - transother[type_ComplexString] = trans_boxed; - transother[type_ComplexBitVector] = trans_boxed; - transother[type_ComplexVector] = trans_boxed; - transother[type_ComplexArray] = trans_boxed; - transother[type_CodeHeader] = trans_code_header; - transother[type_FunctionHeader] = trans_function_header; - transother[type_ClosureFunctionHeader] = trans_function_header; - transother[type_ReturnPcHeader] = trans_return_pc_header; - transother[type_ClosureHeader] = trans_boxed; - transother[type_FuncallableInstanceHeader] = trans_boxed; - transother[type_ByteCodeFunction] = trans_boxed; - transother[type_ByteCodeClosure] = trans_boxed; - transother[type_ValueCellHeader] = trans_boxed; - transother[type_SymbolHeader] = trans_boxed; - transother[type_BaseChar] = trans_immediate; - transother[type_Sap] = trans_unboxed; - transother[type_UnboundMarker] = trans_immediate; - transother[type_WeakPointer] = trans_weak_pointer; - transother[type_InstanceHeader] = trans_boxed; - transother[type_Fdefn] = trans_boxed; - transother[type_ScavengerHook] = trans_scavenger_hook; - - /* Size table */ - - for (i = 0; i < 256; i++) - sizetab[i] = size_lose; - - for (i = 0; i < 32; i++) { - sizetab[type_EvenFixnum | (i << 3)] = size_immediate; - sizetab[type_FunctionPointer | (i << 3)] = size_pointer; - /* OtherImmediate0 */ - sizetab[type_ListPointer | (i << 3)] = size_pointer; - sizetab[type_OddFixnum | (i << 3)] = size_immediate; - sizetab[type_InstancePointer | (i << 3)] = size_pointer; - /* OtherImmediate1 */ - sizetab[type_OtherPointer | (i << 3)] = size_pointer; - } + transother[type_SimpleArrayComplexLongFloat] = + trans_vector_complex_long_float; +#endif + transother[type_ComplexString] = trans_boxed; + transother[type_ComplexBitVector] = trans_boxed; + transother[type_ComplexVector] = trans_boxed; + transother[type_ComplexArray] = trans_boxed; + transother[type_CodeHeader] = trans_code_header; + transother[type_FunctionHeader] = trans_function_header; + transother[type_ClosureFunctionHeader] = trans_function_header; + transother[type_ReturnPcHeader] = trans_return_pc_header; + transother[type_ClosureHeader] = trans_boxed; + transother[type_FuncallableInstanceHeader] = trans_boxed; + transother[type_ByteCodeFunction] = trans_boxed; + transother[type_ByteCodeClosure] = trans_boxed; + transother[type_ValueCellHeader] = trans_boxed; + transother[type_SymbolHeader] = trans_boxed; + transother[type_BaseChar] = trans_immediate; + transother[type_Sap] = trans_unboxed; + transother[type_UnboundMarker] = trans_immediate; + transother[type_WeakPointer] = trans_weak_pointer; + transother[type_InstanceHeader] = trans_boxed; + transother[type_Fdefn] = trans_boxed; + transother[type_ScavengerHook] = trans_scavenger_hook; + + /* Size table */ + + for (i = 0; i < 256; i++) + sizetab[i] = size_lose; + + for (i = 0; i < 32; i++) { + sizetab[type_EvenFixnum | (i << 3)] = size_immediate; + sizetab[type_FunctionPointer | (i << 3)] = size_pointer; + /* OtherImmediate0 */ + sizetab[type_ListPointer | (i << 3)] = size_pointer; + sizetab[type_OddFixnum | (i << 3)] = size_immediate; + sizetab[type_InstancePointer | (i << 3)] = size_pointer; + /* OtherImmediate1 */ + sizetab[type_OtherPointer | (i << 3)] = size_pointer; + } - sizetab[type_Bignum] = size_unboxed; - sizetab[type_Ratio] = size_boxed; - sizetab[type_SingleFloat] = size_unboxed; - sizetab[type_DoubleFloat] = size_unboxed; + sizetab[type_Bignum] = size_unboxed; + sizetab[type_Ratio] = size_boxed; + sizetab[type_SingleFloat] = size_unboxed; + sizetab[type_DoubleFloat] = size_unboxed; #ifdef type_LongFloat - sizetab[type_LongFloat] = size_unboxed; + sizetab[type_LongFloat] = size_unboxed; #endif - sizetab[type_Complex] = size_boxed; + sizetab[type_Complex] = size_boxed; #ifdef type_ComplexSingleFloat - sizetab[type_ComplexSingleFloat] = size_unboxed; + sizetab[type_ComplexSingleFloat] = size_unboxed; #endif #ifdef type_ComplexDoubleFloat - sizetab[type_ComplexDoubleFloat] = size_unboxed; + sizetab[type_ComplexDoubleFloat] = size_unboxed; #endif #ifdef type_ComplexLongFloat - sizetab[type_ComplexLongFloat] = size_unboxed; -#endif - sizetab[type_SimpleArray] = size_boxed; - sizetab[type_SimpleString] = size_string; - sizetab[type_SimpleBitVector] = size_vector_bit; - sizetab[type_SimpleVector] = size_vector; - sizetab[type_SimpleArrayUnsignedByte2] = size_vector_unsigned_byte_2; - sizetab[type_SimpleArrayUnsignedByte4] = size_vector_unsigned_byte_4; - sizetab[type_SimpleArrayUnsignedByte8] = size_vector_unsigned_byte_8; - sizetab[type_SimpleArrayUnsignedByte16] = size_vector_unsigned_byte_16; - sizetab[type_SimpleArrayUnsignedByte32] = size_vector_unsigned_byte_32; + sizetab[type_ComplexLongFloat] = size_unboxed; +#endif + sizetab[type_SimpleArray] = size_boxed; + sizetab[type_SimpleString] = size_string; + sizetab[type_SimpleBitVector] = size_vector_bit; + sizetab[type_SimpleVector] = size_vector; + sizetab[type_SimpleArrayUnsignedByte2] = size_vector_unsigned_byte_2; + sizetab[type_SimpleArrayUnsignedByte4] = size_vector_unsigned_byte_4; + sizetab[type_SimpleArrayUnsignedByte8] = size_vector_unsigned_byte_8; + sizetab[type_SimpleArrayUnsignedByte16] = size_vector_unsigned_byte_16; + sizetab[type_SimpleArrayUnsignedByte32] = size_vector_unsigned_byte_32; #ifdef type_SimpleArraySignedByte8 - sizetab[type_SimpleArraySignedByte8] = size_vector_unsigned_byte_8; + sizetab[type_SimpleArraySignedByte8] = size_vector_unsigned_byte_8; #endif #ifdef type_SimpleArraySignedByte16 - sizetab[type_SimpleArraySignedByte16] = size_vector_unsigned_byte_16; + sizetab[type_SimpleArraySignedByte16] = size_vector_unsigned_byte_16; #endif #ifdef type_SimpleArraySignedByte30 - sizetab[type_SimpleArraySignedByte30] = size_vector_unsigned_byte_32; + sizetab[type_SimpleArraySignedByte30] = size_vector_unsigned_byte_32; #endif #ifdef type_SimpleArraySignedByte32 - sizetab[type_SimpleArraySignedByte32] = size_vector_unsigned_byte_32; + sizetab[type_SimpleArraySignedByte32] = size_vector_unsigned_byte_32; #endif - sizetab[type_SimpleArraySingleFloat] = size_vector_single_float; - sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float; + sizetab[type_SimpleArraySingleFloat] = size_vector_single_float; + sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float; #ifdef type_SimpleArrayLongFloat - sizetab[type_SimpleArrayLongFloat] = size_vector_long_float; + sizetab[type_SimpleArrayLongFloat] = size_vector_long_float; #endif #ifdef type_SimpleArrayComplexSingleFloat - sizetab[type_SimpleArrayComplexSingleFloat] = size_vector_complex_single_float; + sizetab[type_SimpleArrayComplexSingleFloat] = + size_vector_complex_single_float; #endif #ifdef type_SimpleArrayComplexDoubleFloat - sizetab[type_SimpleArrayComplexDoubleFloat] = size_vector_complex_double_float; + sizetab[type_SimpleArrayComplexDoubleFloat] = + size_vector_complex_double_float; #endif #ifdef type_SimpleArrayComplexLongFloat - sizetab[type_SimpleArrayComplexLongFloat] = size_vector_complex_long_float; + sizetab[type_SimpleArrayComplexLongFloat] = size_vector_complex_long_float; #endif - sizetab[type_ComplexString] = size_boxed; - sizetab[type_ComplexBitVector] = size_boxed; - sizetab[type_ComplexVector] = size_boxed; - sizetab[type_ComplexArray] = size_boxed; - sizetab[type_CodeHeader] = size_code_header; + sizetab[type_ComplexString] = size_boxed; + sizetab[type_ComplexBitVector] = size_boxed; + sizetab[type_ComplexVector] = size_boxed; + sizetab[type_ComplexArray] = size_boxed; + sizetab[type_CodeHeader] = size_code_header; #if 0 - /* Shouldn't see these so just lose if it happens */ - sizetab[type_FunctionHeader] = size_function_header; - sizetab[type_ClosureFunctionHeader] = size_function_header; - sizetab[type_ReturnPcHeader] = size_return_pc_header; -#endif - sizetab[type_ClosureHeader] = size_boxed; - sizetab[type_FuncallableInstanceHeader] = size_boxed; - sizetab[type_ValueCellHeader] = size_boxed; - sizetab[type_SymbolHeader] = size_boxed; - sizetab[type_BaseChar] = size_immediate; - sizetab[type_Sap] = size_unboxed; - sizetab[type_UnboundMarker] = size_immediate; - sizetab[type_WeakPointer] = size_weak_pointer; - sizetab[type_InstanceHeader] = size_boxed; - sizetab[type_Fdefn] = size_boxed; - sizetab[type_ScavengerHook] = size_scavenger_hook; + /* Shouldn't see these so just lose if it happens */ + sizetab[type_FunctionHeader] = size_function_header; + sizetab[type_ClosureFunctionHeader] = size_function_header; + sizetab[type_ReturnPcHeader] = size_return_pc_header; +#endif + sizetab[type_ClosureHeader] = size_boxed; + sizetab[type_FuncallableInstanceHeader] = size_boxed; + sizetab[type_ValueCellHeader] = size_boxed; + sizetab[type_SymbolHeader] = size_boxed; + sizetab[type_BaseChar] = size_immediate; + sizetab[type_Sap] = size_unboxed; + sizetab[type_UnboundMarker] = size_immediate; + sizetab[type_WeakPointer] = size_weak_pointer; + sizetab[type_InstanceHeader] = size_boxed; + sizetab[type_Fdefn] = size_boxed; + sizetab[type_ScavengerHook] = size_scavenger_hook; } - + /* * Scan an area looking for an object which encloses the given * pointer. Returns the object start on success or NULL on failure. */ -static lispobj* search_space(lispobj *start, size_t words, lispobj *pointer) -{ - while(words > 0) { - size_t count = 1; - lispobj thing = *start; - - /* If thing is an immediate then this is a cons */ - if (Pointerp(thing) - || (thing & 3) == 0 /* fixnum */ - || TypeOf(thing) == type_BaseChar - || TypeOf(thing) == type_UnboundMarker) - count = 2; - else - count = (sizetab[TypeOf(thing)])(start); +static lispobj * +search_space(lispobj * start, size_t words, lispobj * pointer) +{ + while (words > 0) { + size_t count = 1; + lispobj thing = *start; + + /* If thing is an immediate then this is a cons */ + if (Pointerp(thing) + || (thing & 3) == 0 /* fixnum */ + || TypeOf(thing) == type_BaseChar + || TypeOf(thing) == type_UnboundMarker) count = 2; + else + count = (sizetab[TypeOf(thing)]) (start); - /* Check if the pointer is within this object? */ - if (pointer >= start && pointer < start + count) { - /* Found it. */ + /* Check if the pointer is within this object? */ + if (pointer >= start && pointer < start + count) { + /* Found it. */ #if 0 - fprintf(stderr, "* Found %x in %x %x\n", pointer, start, thing); + fprintf(stderr, "* Found %x in %x %x\n", pointer, start, thing); #endif - return start; - } + return start; + } - /* Round up the count */ - count = CEILING(count, 2); + /* Round up the count */ + count = CEILING(count, 2); - start += count; - words -= count; - } - return NULL; + start += count; + words -= count; + } + return NULL; } -static lispobj* search_read_only_space(lispobj *pointer) +static lispobj * +search_read_only_space(lispobj * pointer) { - lispobj* start = (lispobj*) READ_ONLY_SPACE_START; - lispobj* end = (lispobj*) SymbolValue(READ_ONLY_SPACE_FREE_POINTER); - if (pointer < start || pointer >= end) - return NULL; - return search_space(start, pointer + 2 - start, pointer); + lispobj *start = (lispobj *) READ_ONLY_SPACE_START; + lispobj *end = (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER); + + if (pointer < start || pointer >= end) + return NULL; + return search_space(start, pointer + 2 - start, pointer); } -static lispobj* search_static_space(lispobj *pointer) +static lispobj * +search_static_space(lispobj * pointer) { - lispobj* start = (lispobj*) static_space; - lispobj* end = (lispobj*) SymbolValue(STATIC_SPACE_FREE_POINTER); - if (pointer < start || pointer >= end) - return NULL; - return search_space(start, pointer + 2 - start, pointer); + lispobj *start = (lispobj *) static_space; + lispobj *end = (lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER); + + if (pointer < start || pointer >= end) + return NULL; + return search_space(start, pointer + 2 - start, pointer); } /* * Faster version for searching the dynamic space. This will work even * if the object is in a current allocation region. */ -lispobj *search_dynamic_space(lispobj *pointer) +lispobj * +search_dynamic_space(lispobj * pointer) { - int page_index = find_page_index(pointer); - lispobj *start; + int page_index = find_page_index(pointer); + lispobj *start; - /* Address may be invalid - do some checks. */ - if (page_index == -1 || !PAGE_ALLOCATED(page_index)) - return NULL; - start = (lispobj *) (page_address(page_index) - + page_table[page_index].first_object_offset); - return search_space(start, pointer + 2 - start, pointer); + /* Address may be invalid - do some checks. */ + if (page_index == -1 || !PAGE_ALLOCATED(page_index)) + return NULL; + start = (lispobj *) (page_address(page_index) + + page_table[page_index].first_object_offset); + return search_space(start, pointer + 2 - start, pointer); } #if defined(i386) || defined(__x86_64) -static int valid_dynamic_space_pointer(lispobj *pointer) +static int +valid_dynamic_space_pointer(lispobj * pointer) { - lispobj *start_addr; + lispobj *start_addr; - /* Find the object start address */ - if ((start_addr = search_dynamic_space(pointer)) == NULL) - return FALSE; + /* Find the object start address */ + if ((start_addr = search_dynamic_space(pointer)) == NULL) + return FALSE; - /* - * Need to allow raw pointers into Code objects for return - * addresses. This will also pickup pointers to functions in code - * objects. - */ - if (TypeOf(*start_addr) == type_CodeHeader) - /* X Could do some further checks here. */ - return TRUE; + /* + * Need to allow raw pointers into Code objects for return + * addresses. This will also pickup pointers to functions in code + * objects. + */ + if (TypeOf(*start_addr) == type_CodeHeader) + /* X Could do some further checks here. */ + return TRUE; - /* - * If it's not a return address then it needs to be a valid lisp pointer. - */ - if (!Pointerp((lispobj)pointer)) - return FALSE; - - /* - * Check that the object pointed to is consistent with the pointer - * low tag. - */ - switch (LowtagOf((lispobj)pointer)) { - case type_FunctionPointer: /* - * Start_addr should be the enclosing code object, or a closure - * header. + * If it's not a return address then it needs to be a valid lisp pointer. */ - switch (TypeOf(*start_addr)) { - case type_CodeHeader: - /* This case is probably caught above. */ - break; - case type_ClosureHeader: - case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: - case type_DylanFunctionHeader: - if ((size_t) pointer != (size_t) start_addr + type_FunctionPointer) { + if (!Pointerp((lispobj) pointer)) return FALSE; - } - break; - default: - return FALSE; - } - break; - case type_ListPointer: - if ((size_t) pointer != (size_t) start_addr + type_ListPointer) { - return FALSE; - } - /* Is it plausible cons? */ - if((Pointerp(start_addr[0]) - || (start_addr[0] & 3) == 0 /* fixnum */ - || TypeOf(start_addr[0]) == type_BaseChar - || TypeOf(start_addr[0]) == type_UnboundMarker) - && (Pointerp(start_addr[1]) - || (start_addr[1] & 3) == 0 /* fixnum */ - || TypeOf(start_addr[1]) == type_BaseChar - || TypeOf(start_addr[1]) == type_UnboundMarker)) - break; - else { - return FALSE; - } - case type_InstancePointer: - if ((size_t) pointer != (size_t) start_addr + type_InstancePointer) { - return FALSE; - } - if (TypeOf(start_addr[0]) != type_InstanceHeader) { - return FALSE; - } - break; - case type_OtherPointer: - if ((size_t) pointer != (size_t) start_addr + type_OtherPointer) { - return FALSE; - } - /* Is it plausible? Not a cons. X should check the headers. */ - if(Pointerp(start_addr[0]) || (start_addr[0] & 3) == 0) { - return FALSE; - } - switch (TypeOf(start_addr[0])) { - case type_UnboundMarker: - case type_BaseChar: - return FALSE; - - /* Only pointed to by function pointers? */ - case type_ClosureHeader: - case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: - case type_DylanFunctionHeader: - return FALSE; - - case type_InstanceHeader: - return FALSE; - - /* The valid other immediate pointer objects */ - case type_SimpleVector: - case type_Ratio: - case type_Complex: + + /* + * Check that the object pointed to is consistent with the pointer + * low tag. + */ + switch (LowtagOf((lispobj) pointer)) { + case type_FunctionPointer: + /* + * Start_addr should be the enclosing code object, or a closure + * header. + */ + switch (TypeOf(*start_addr)) { + case type_CodeHeader: + /* This case is probably caught above. */ + break; + case type_ClosureHeader: + case type_FuncallableInstanceHeader: + case type_ByteCodeFunction: + case type_ByteCodeClosure: + case type_DylanFunctionHeader: + if ((size_t) pointer != + (size_t) start_addr + type_FunctionPointer) { + return FALSE; + } + break; + default: + return FALSE; + } + break; + case type_ListPointer: + if ((size_t) pointer != (size_t) start_addr + type_ListPointer) { + return FALSE; + } + /* Is it plausible cons? */ + if ((Pointerp(start_addr[0]) + || (start_addr[0] & 3) == 0 /* fixnum */ + || TypeOf(start_addr[0]) == type_BaseChar + || TypeOf(start_addr[0]) == type_UnboundMarker) + && (Pointerp(start_addr[1]) + || (start_addr[1] & 3) == 0 /* fixnum */ + || TypeOf(start_addr[1]) == type_BaseChar + || TypeOf(start_addr[1]) == type_UnboundMarker)) + break; + else { + return FALSE; + } + case type_InstancePointer: + if ((size_t) pointer != (size_t) start_addr + type_InstancePointer) { + return FALSE; + } + if (TypeOf(start_addr[0]) != type_InstanceHeader) { + return FALSE; + } + break; + case type_OtherPointer: + if ((size_t) pointer != (size_t) start_addr + type_OtherPointer) { + return FALSE; + } + /* Is it plausible? Not a cons. X should check the headers. */ + if (Pointerp(start_addr[0]) || (start_addr[0] & 3) == 0) { + return FALSE; + } + switch (TypeOf(start_addr[0])) { + case type_UnboundMarker: + case type_BaseChar: + return FALSE; + + /* Only pointed to by function pointers? */ + case type_ClosureHeader: + case type_FuncallableInstanceHeader: + case type_ByteCodeFunction: + case type_ByteCodeClosure: + case type_DylanFunctionHeader: + return FALSE; + + case type_InstanceHeader: + return FALSE; + + /* The valid other immediate pointer objects */ + case type_SimpleVector: + case type_Ratio: + case type_Complex: #ifdef type_ComplexSingleFloat - case type_ComplexSingleFloat: + case type_ComplexSingleFloat: #endif #ifdef type_ComplexDoubleFloat - case type_ComplexDoubleFloat: + case type_ComplexDoubleFloat: #endif #ifdef type_ComplexLongFloat - case type_ComplexLongFloat: -#endif - case type_SimpleArray: - case type_ComplexString: - case type_ComplexBitVector: - case type_ComplexVector: - case type_ComplexArray: - case type_ValueCellHeader: - case type_SymbolHeader: - case type_Fdefn: - case type_CodeHeader: - case type_Bignum: - case type_SingleFloat: - case type_DoubleFloat: + case type_ComplexLongFloat: +#endif + case type_SimpleArray: + case type_ComplexString: + case type_ComplexBitVector: + case type_ComplexVector: + case type_ComplexArray: + case type_ValueCellHeader: + case type_SymbolHeader: + case type_Fdefn: + case type_CodeHeader: + case type_Bignum: + case type_SingleFloat: + case type_DoubleFloat: #ifdef type_LongFloat - case type_LongFloat: -#endif - case type_SimpleString: - case type_SimpleBitVector: - case type_SimpleArrayUnsignedByte2: - case type_SimpleArrayUnsignedByte4: - case type_SimpleArrayUnsignedByte8: - case type_SimpleArrayUnsignedByte16: - case type_SimpleArrayUnsignedByte32: + case type_LongFloat: +#endif + case type_SimpleString: + case type_SimpleBitVector: + case type_SimpleArrayUnsignedByte2: + case type_SimpleArrayUnsignedByte4: + case type_SimpleArrayUnsignedByte8: + case type_SimpleArrayUnsignedByte16: + case type_SimpleArrayUnsignedByte32: #ifdef type_SimpleArraySignedByte8 - case type_SimpleArraySignedByte8: + case type_SimpleArraySignedByte8: #endif #ifdef type_SimpleArraySignedByte16 - case type_SimpleArraySignedByte16: + case type_SimpleArraySignedByte16: #endif #ifdef type_SimpleArraySignedByte30 - case type_SimpleArraySignedByte30: + case type_SimpleArraySignedByte30: #endif #ifdef type_SimpleArraySignedByte32 - case type_SimpleArraySignedByte32: + case type_SimpleArraySignedByte32: #endif - case type_SimpleArraySingleFloat: - case type_SimpleArrayDoubleFloat: + case type_SimpleArraySingleFloat: + case type_SimpleArrayDoubleFloat: #ifdef type_SimpleArrayLongFloat - case type_SimpleArrayLongFloat: + case type_SimpleArrayLongFloat: #endif #ifdef type_SimpleArrayComplexSingleFloat - case type_SimpleArrayComplexSingleFloat: + case type_SimpleArrayComplexSingleFloat: #endif #ifdef type_SimpleArrayComplexDoubleFloat - case type_SimpleArrayComplexDoubleFloat: + case type_SimpleArrayComplexDoubleFloat: #endif #ifdef type_SimpleArrayComplexLongFloat - case type_SimpleArrayComplexLongFloat: + case type_SimpleArrayComplexLongFloat: #endif - case type_Sap: - case type_WeakPointer: - case type_ScavengerHook: - break; + case type_Sap: + case type_WeakPointer: + case type_ScavengerHook: + break; - default: - return FALSE; + default: + return FALSE; + } + break; + default: + return FALSE; } - break; - default: - return FALSE; - } - /* Looks good */ - return TRUE; + /* Looks good */ + return TRUE; } #endif @@ -4773,149 +4974,152 @@ static int valid_dynamic_space_pointer(lispobj *pointer) * pages, and the freeing of pages. */ #if (defined(i386) || defined(__x86_64)) -static void maybe_adjust_large_object(lispobj *where) -{ - int first_page; - int nwords; - int remaining_bytes; - int next_page; - int bytes_freed; - int old_bytes_used; - int unboxed; - int mmask, mflags; - - /* Check if it's a vector or bignum object. */ - switch (TypeOf(where[0])) { - case type_SimpleVector: - unboxed = FALSE; - break; - case type_Bignum: - case type_SimpleString: - case type_SimpleBitVector: - case type_SimpleArrayUnsignedByte2: - case type_SimpleArrayUnsignedByte4: - case type_SimpleArrayUnsignedByte8: - case type_SimpleArrayUnsignedByte16: - case type_SimpleArrayUnsignedByte32: +static void +maybe_adjust_large_object(lispobj * where) +{ + int first_page; + int nwords; + int remaining_bytes; + int next_page; + int bytes_freed; + int old_bytes_used; + int unboxed; + int mmask, mflags; + + /* Check if it's a vector or bignum object. */ + switch (TypeOf(where[0])) { + case type_SimpleVector: + unboxed = FALSE; + break; + case type_Bignum: + case type_SimpleString: + case type_SimpleBitVector: + case type_SimpleArrayUnsignedByte2: + case type_SimpleArrayUnsignedByte4: + case type_SimpleArrayUnsignedByte8: + case type_SimpleArrayUnsignedByte16: + case type_SimpleArrayUnsignedByte32: #ifdef type_SimpleArraySignedByte8 - case type_SimpleArraySignedByte8: + case type_SimpleArraySignedByte8: #endif #ifdef type_SimpleArraySignedByte16 - case type_SimpleArraySignedByte16: + case type_SimpleArraySignedByte16: #endif #ifdef type_SimpleArraySignedByte30 - case type_SimpleArraySignedByte30: + case type_SimpleArraySignedByte30: #endif #ifdef type_SimpleArraySignedByte32 - case type_SimpleArraySignedByte32: + case type_SimpleArraySignedByte32: #endif - case type_SimpleArraySingleFloat: - case type_SimpleArrayDoubleFloat: + case type_SimpleArraySingleFloat: + case type_SimpleArrayDoubleFloat: #ifdef type_SimpleArrayLongFloat - case type_SimpleArrayLongFloat: + case type_SimpleArrayLongFloat: #endif #ifdef type_SimpleArrayComplexSingleFloat - case type_SimpleArrayComplexSingleFloat: + case type_SimpleArrayComplexSingleFloat: #endif #ifdef type_SimpleArrayComplexDoubleFloat - case type_SimpleArrayComplexDoubleFloat: + case type_SimpleArrayComplexDoubleFloat: #endif #ifdef type_SimpleArrayComplexLongFloat - case type_SimpleArrayComplexLongFloat: + case type_SimpleArrayComplexLongFloat: #endif - unboxed = TRUE; - break; - default: - return; - } + unboxed = TRUE; + break; + default: + return; + } - /* Find its current size. */ - nwords = (sizetab[TypeOf(where[0])])(where); + /* Find its current size. */ + nwords = (sizetab[TypeOf(where[0])]) (where); - first_page = find_page_index((void *) where); - gc_assert(first_page >= 0); + first_page = find_page_index((void *) where); + gc_assert(first_page >= 0); + + /* + * Note: Any page write protection must be removed, else a later + * scavenge_newspace may incorrectly not scavenge these pages. This + * would not be necessary if they are added to the new areas, but + * lets do it for them all (they'll probably be written anyway?). + */ - /* - * Note: Any page write protection must be removed, else a later - * scavenge_newspace may incorrectly not scavenge these pages. This - * would not be necessary if they are added to the new areas, but - * lets do it for them all (they'll probably be written anyway?). - */ + gc_assert(page_table[first_page].first_object_offset == 0); - gc_assert(page_table[first_page].first_object_offset == 0); + next_page = first_page; + remaining_bytes = nwords * sizeof(lispobj); + while (remaining_bytes > PAGE_SIZE) { + gc_assert(PAGE_GENERATION(next_page) == from_space); + gc_assert(PAGE_ALLOCATED(next_page)); + gc_assert(PAGE_LARGE_OBJECT(next_page)); + gc_assert(page_table[next_page].first_object_offset == + PAGE_SIZE * (first_page - next_page)); + gc_assert(page_table[next_page].bytes_used == PAGE_SIZE); - next_page = first_page; - remaining_bytes = nwords * sizeof(lispobj); - while (remaining_bytes > PAGE_SIZE) { - gc_assert(PAGE_GENERATION(next_page) == from_space); - gc_assert(PAGE_ALLOCATED(next_page)); - gc_assert(PAGE_LARGE_OBJECT(next_page)); - gc_assert(page_table[next_page].first_object_offset == - PAGE_SIZE * (first_page - next_page)); - gc_assert(page_table[next_page].bytes_used == PAGE_SIZE); + PAGE_FLAGS_UPDATE(next_page, PAGE_UNBOXED_MASK, + unboxed << PAGE_UNBOXED_SHIFT); - PAGE_FLAGS_UPDATE(next_page, PAGE_UNBOXED_MASK, - unboxed << PAGE_UNBOXED_SHIFT); + /* + * Shouldn't be write protected at this stage. Essential that the + * pages aren't. + */ + gc_assert(!PAGE_WRITE_PROTECTED(next_page)); + remaining_bytes -= PAGE_SIZE; + next_page++; + } /* - * Shouldn't be write protected at this stage. Essential that the - * pages aren't. + * Now only one page remains, but the object may have shrunk so + * there may be more unused pages which will be freed. */ - gc_assert(!PAGE_WRITE_PROTECTED(next_page)); - remaining_bytes -= PAGE_SIZE; - next_page++; - } - - /* - * Now only one page remains, but the object may have shrunk so - * there may be more unused pages which will be freed. - */ - - /* Object may have shrunk but shouldn't have grown - check. */ - gc_assert(page_table[next_page].bytes_used >= remaining_bytes); - page_table[next_page].flags |= PAGE_ALLOCATED_MASK; - PAGE_FLAGS_UPDATE(next_page, PAGE_UNBOXED_MASK, - unboxed << PAGE_UNBOXED_SHIFT); - gc_assert(PAGE_UNBOXED(next_page) == PAGE_UNBOXED(first_page)); + /* Object may have shrunk but shouldn't have grown - check. */ + gc_assert(page_table[next_page].bytes_used >= remaining_bytes); - /* Adjust the bytes_used. */ - old_bytes_used = page_table[next_page].bytes_used; - page_table[next_page].bytes_used = remaining_bytes; + page_table[next_page].flags |= PAGE_ALLOCATED_MASK; + PAGE_FLAGS_UPDATE(next_page, PAGE_UNBOXED_MASK, + unboxed << PAGE_UNBOXED_SHIFT); + gc_assert(PAGE_UNBOXED(next_page) == PAGE_UNBOXED(first_page)); - bytes_freed = old_bytes_used - remaining_bytes; + /* Adjust the bytes_used. */ + old_bytes_used = page_table[next_page].bytes_used; + page_table[next_page].bytes_used = remaining_bytes; - mmask = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK | PAGE_GENERATION_MASK; - mflags = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK | from_space; + bytes_freed = old_bytes_used - remaining_bytes; - /* Free any remaining pages; needs care. */ - next_page++; - while (old_bytes_used == PAGE_SIZE && - PAGE_FLAGS(next_page, mmask) == mflags && - page_table[next_page].first_object_offset == PAGE_SIZE * (first_page - - next_page)) { - /* - * Checks out OK, free the page. Don't need to bother zeroing - * pages as this should have been done before shrinking the - * object. These pages shouldn't be write protected as they should - * be zero filled. - */ - gc_assert(!PAGE_WRITE_PROTECTED(next_page)); + mmask = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK | PAGE_GENERATION_MASK; + mflags = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK | from_space; - old_bytes_used = page_table[next_page].bytes_used; - page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK; - page_table[next_page].bytes_used = 0; - bytes_freed += old_bytes_used; + /* Free any remaining pages; needs care. */ next_page++; - } + while (old_bytes_used == PAGE_SIZE && + PAGE_FLAGS(next_page, mmask) == mflags && + page_table[next_page].first_object_offset == PAGE_SIZE * (first_page + - + next_page)) + { + /* + * Checks out OK, free the page. Don't need to bother zeroing + * pages as this should have been done before shrinking the + * object. These pages shouldn't be write protected as they should + * be zero filled. + */ + gc_assert(!PAGE_WRITE_PROTECTED(next_page)); + + old_bytes_used = page_table[next_page].bytes_used; + page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK; + page_table[next_page].bytes_used = 0; + bytes_freed += old_bytes_used; + next_page++; + } - if (gencgc_verbose && bytes_freed > 0) - fprintf(stderr, "* adjust_large_object freed %d\n", bytes_freed); + if (gencgc_verbose && bytes_freed > 0) + fprintf(stderr, "* adjust_large_object freed %d\n", bytes_freed); - generations[from_space].bytes_allocated -= bytes_freed; - bytes_allocated -= bytes_freed; + generations[from_space].bytes_allocated -= bytes_freed; + bytes_allocated -= bytes_freed; - return; + return; } #endif @@ -4940,166 +5144,179 @@ static void maybe_adjust_large_object(lispobj *where) * sparc because GC is precise, not conservative. */ #if (defined(i386) || defined(__x86_64)) -static void preserve_pointer(void *addr) -{ - int addr_page_index = find_page_index(addr); - int first_page; - int i; - unsigned region_unboxed; - - /* Address is quite likely to have been invalid - do some checks. */ - if (addr_page_index == -1 - || !PAGE_ALLOCATED(addr_page_index) - || page_table[addr_page_index].bytes_used == 0 - || PAGE_GENERATION(addr_page_index) != from_space - /* Skip if already marked dont_move */ - || PAGE_DONT_MOVE(addr_page_index)) - return; +static void +preserve_pointer(void *addr) +{ + int addr_page_index = find_page_index(addr); + int first_page; + int i; + unsigned region_unboxed; - region_unboxed = PAGE_UNBOXED(addr_page_index); + /* Address is quite likely to have been invalid - do some checks. */ + if (addr_page_index == -1 || !PAGE_ALLOCATED(addr_page_index) + || page_table[addr_page_index].bytes_used == 0 + || PAGE_GENERATION(addr_page_index) != from_space + /* Skip if already marked dont_move */ + || PAGE_DONT_MOVE(addr_page_index)) + return; - /* Check the offset within the page */ - if (((size_t) addr & 0xfff) > page_table[addr_page_index].bytes_used) - return; + region_unboxed = PAGE_UNBOXED(addr_page_index); - if (enable_pointer_filter && !valid_dynamic_space_pointer(addr)) - return; + /* Check the offset within the page */ + if (((size_t) addr & 0xfff) > page_table[addr_page_index].bytes_used) + return; + + if (enable_pointer_filter && !valid_dynamic_space_pointer(addr)) + return; - /* - * Work backwards to find a page with a first_object_offset of 0. - * The pages should be contiguous with all bytes used in the same - * gen. Assumes the first_object_offset is negative or zero. - */ - first_page = addr_page_index; - while (page_table[first_page].first_object_offset != 0) { - first_page--; - /* Do some checks */ - gc_assert(page_table[first_page].bytes_used == PAGE_SIZE); - gc_assert(PAGE_GENERATION(first_page) == from_space); - gc_assert(PAGE_ALLOCATED(first_page)); - gc_assert(PAGE_UNBOXED(first_page) == region_unboxed); - } - - /* - * Adjust any large objects before promotion as they won't be copied - * after promotion. - */ - if (PAGE_LARGE_OBJECT(first_page)) { - maybe_adjust_large_object((lispobj*) page_address(first_page)); /* - * If a large object has shrunk then addr may now point to a free - * adea in which case it's ignored here. Note it gets through the - * valid pointer test above because the tail looks like conses. + * Work backwards to find a page with a first_object_offset of 0. + * The pages should be contiguous with all bytes used in the same + * gen. Assumes the first_object_offset is negative or zero. */ - if (!PAGE_ALLOCATED(addr_page_index) - || page_table[addr_page_index].bytes_used == 0 - /* Check the offset within the page */ - || ((size_t) addr & 0xfff) > page_table[addr_page_index].bytes_used) { - fprintf(stderr, "*W ignore pointer 0x%lx to freed area of large object\n", - (unsigned long) addr); - return; + first_page = addr_page_index; + while (page_table[first_page].first_object_offset != 0) { + first_page--; + /* Do some checks */ + gc_assert(page_table[first_page].bytes_used == PAGE_SIZE); + gc_assert(PAGE_GENERATION(first_page) == from_space); + gc_assert(PAGE_ALLOCATED(first_page)); + gc_assert(PAGE_UNBOXED(first_page) == region_unboxed); } - /* May have moved to unboxed pages. */ - region_unboxed = PAGE_UNBOXED(first_page); - } - - /* - * Now work forward until the end of this contiguous area is found, - * marking all pages as dont_move. - */ - for (i = first_page; ;i++) { - gc_assert(PAGE_ALLOCATED(i)); - gc_assert(PAGE_UNBOXED(i) == region_unboxed); - - /* Mark the page static */ - page_table[i].flags |= PAGE_DONT_MOVE_MASK; -#if 0 - fprintf(stderr, "#%d,", i); -#endif /* - * Move the page to the new_space. XX I'd rather not do this but - * the GC logic is not quite able to copy with the static pages - * remaining in the from space. This also requires the generation - * bytes_allocated counters be updated. + * Adjust any large objects before promotion as they won't be copied + * after promotion. */ - PAGE_FLAGS_UPDATE(i, PAGE_GENERATION_MASK, new_space); - generations[new_space].bytes_allocated += page_table[i].bytes_used; - generations[from_space].bytes_allocated -= page_table[i].bytes_used; + if (PAGE_LARGE_OBJECT(first_page)) { + maybe_adjust_large_object((lispobj *) page_address(first_page)); + /* + * If a large object has shrunk then addr may now point to a free + * adea in which case it's ignored here. Note it gets through the + * valid pointer test above because the tail looks like conses. + */ + if (!PAGE_ALLOCATED(addr_page_index) + || page_table[addr_page_index].bytes_used == 0 + /* Check the offset within the page */ + || ((size_t) addr & 0xfff) > page_table[addr_page_index].bytes_used) { + fprintf(stderr, + "*W ignore pointer 0x%lx to freed area of large object\n", + (unsigned long) addr); + return; + } + /* May have moved to unboxed pages. */ + region_unboxed = PAGE_UNBOXED(first_page); + } /* - * Essential that the pages are not write protected as they may - * have pointers into the old-space which need - * scavenging. Shouldn't be write protected at this stage. + * Now work forward until the end of this contiguous area is found, + * marking all pages as dont_move. */ - gc_assert(!PAGE_WRITE_PROTECTED(i)); + for (i = first_page;; i++) { + gc_assert(PAGE_ALLOCATED(i)); + gc_assert(PAGE_UNBOXED(i) == region_unboxed); + + /* Mark the page static */ + page_table[i].flags |= PAGE_DONT_MOVE_MASK; +#if 0 + fprintf(stderr, "#%d,", i); +#endif + + /* + * Move the page to the new_space. XX I'd rather not do this but + * the GC logic is not quite able to copy with the static pages + * remaining in the from space. This also requires the generation + * bytes_allocated counters be updated. + */ + PAGE_FLAGS_UPDATE(i, PAGE_GENERATION_MASK, new_space); + generations[new_space].bytes_allocated += page_table[i].bytes_used; + generations[from_space].bytes_allocated -= page_table[i].bytes_used; + + /* + * Essential that the pages are not write protected as they may + * have pointers into the old-space which need + * scavenging. Shouldn't be write protected at this stage. + */ + gc_assert(!PAGE_WRITE_PROTECTED(i)); - /* Check if this is the last page in this contiguous block */ - if (page_table[i].bytes_used < PAGE_SIZE - /* Or it is PAGE_SIZE and is the last in the block */ - || !PAGE_ALLOCATED(i + 1) - || page_table[i + 1].bytes_used == 0 /* Next page free */ - || PAGE_GENERATION(i + 1) != from_space /* Diff. gen */ - || page_table[i + 1].first_object_offset == 0) - break; - } + /* Check if this is the last page in this contiguous block */ + if (page_table[i].bytes_used < PAGE_SIZE + /* Or it is PAGE_SIZE and is the last in the block */ + || !PAGE_ALLOCATED(i + 1) + || page_table[i + 1].bytes_used == 0 /* Next page free */ + || PAGE_GENERATION(i + 1) != from_space /* Diff. gen */ + || page_table[i + 1].first_object_offset == 0) + break; + } - /* Check that the page is now static */ - gc_assert(PAGE_DONT_MOVE(addr_page_index)); + /* Check that the page is now static */ + gc_assert(PAGE_DONT_MOVE(addr_page_index)); - return; + return; } #endif #ifdef CONTROL_STACKS /* Scavenge the thread stack conservative roots. */ -static void scavenge_thread_stacks(void) -{ - lispobj thread_stacks = SymbolValue(CONTROL_STACKS); - - if (LowtagOf(thread_stacks) == type_OtherPointer) { - struct vector *vector = (struct vector *) PTR(thread_stacks); - int length, i; - if (TypeOf(vector->header) != type_SimpleVector) - return; - length = fixnum_value(vector->length); - for (i = 0; i < length; i++) { - lispobj stack_obj = vector->data[i]; - if (LowtagOf(stack_obj) == type_OtherPointer) { - struct vector *stack = (struct vector *) PTR(stack_obj); - int vector_length; - if (TypeOf(stack->header) != type_SimpleArrayUnsignedByte32) - return; - vector_length = fixnum_value(stack->length); - if (gencgc_verbose > 1 && vector_length <= 0) - fprintf(stderr, "*W control stack vector length %d\n", - vector_length); - if (vector_length > 0) { - unsigned long stack_pointer = stack->data[0]; - if ((char *) stack_pointer < (char *) control_stack || - (char *) stack_pointer > (char *) control_stack_end) - fprintf(stderr, "*E Invalid stack pointer %lx\n", stack_pointer); - if ((char *) stack_pointer > (char *) control_stack && - (char *) stack_pointer < (char *) control_stack_end) { - unsigned int length = ((int) control_stack_end - stack_pointer) / sizeof(lispobj); - int j; - if (length >= vector_length) - fprintf(stderr, "*E Invalid stack size %d >= vector length %d\n", - length, vector_length); - if (gencgc_verbose > 1) - fprintf(stderr, "Scavenging %d words of control stack %d of length %d words.\n", - length,i, vector_length); - for (j = 0; j < length; j++) - preserve_pointer((void *) stack->data[1 + j]); - } +static void +scavenge_thread_stacks(void) +{ + lispobj thread_stacks = SymbolValue(CONTROL_STACKS); + + if (LowtagOf(thread_stacks) == type_OtherPointer) { + struct vector *vector = (struct vector *) PTR(thread_stacks); + int length, i; + + if (TypeOf(vector->header) != type_SimpleVector) + return; + length = fixnum_value(vector->length); + for (i = 0; i < length; i++) { + lispobj stack_obj = vector->data[i]; + + if (LowtagOf(stack_obj) == type_OtherPointer) { + struct vector *stack = (struct vector *) PTR(stack_obj); + int vector_length; + + if (TypeOf(stack->header) != type_SimpleArrayUnsignedByte32) + return; + vector_length = fixnum_value(stack->length); + if (gencgc_verbose > 1 && vector_length <= 0) + fprintf(stderr, "*W control stack vector length %d\n", + vector_length); + if (vector_length > 0) { + unsigned long stack_pointer = stack->data[0]; + + if ((char *) stack_pointer < (char *) control_stack || + (char *) stack_pointer > (char *) control_stack_end) + fprintf(stderr, "*E Invalid stack pointer %lx\n", + stack_pointer); + if ((char *) stack_pointer > (char *) control_stack + && (char *) stack_pointer < (char *) control_stack_end) { + unsigned int length = + ((int) control_stack_end - + + stack_pointer) / sizeof(lispobj); + int j; + + if (length >= vector_length) + fprintf(stderr, + "*E Invalid stack size %d >= vector length %d\n", + length, vector_length); + if (gencgc_verbose > 1) + fprintf(stderr, + "Scavenging %d words of control stack %d of length %d words.\n", + length, i, vector_length); + for (j = 0; j < length; j++) + preserve_pointer((void *) stack->data[1 + j]); + } + } + } } - } } - } } #endif - + /* * If the given page is not write protected, then scan it for pointers * to younger generations or the top temp. generation, if no @@ -5115,63 +5332,64 @@ static void scavenge_thread_stacks(void) * * It returns 1 if the page was write protected, else 0. */ -static int update_page_write_prot(unsigned page) +static int +update_page_write_prot(unsigned page) { - int gen = PAGE_GENERATION(page); - int j; - int wp_it = 1; - void **page_addr = (void **) page_address(page); - int num_words = page_table[page].bytes_used / sizeof(lispobj); + int gen = PAGE_GENERATION(page); + int j; + int wp_it = 1; + void **page_addr = (void **) page_address(page); + int num_words = page_table[page].bytes_used / sizeof(lispobj); - /* Shouldn't be a free page. */ - gc_assert(PAGE_ALLOCATED(page)); - gc_assert(page_table[page].bytes_used != 0); + /* Shouldn't be a free page. */ + gc_assert(PAGE_ALLOCATED(page)); + gc_assert(page_table[page].bytes_used != 0); - /* Skip if it's already write protected or an unboxed page. */ - if (PAGE_WRITE_PROTECTED(page) || PAGE_UNBOXED(page)) - return 0; + /* Skip if it's already write protected or an unboxed page. */ + if (PAGE_WRITE_PROTECTED(page) || PAGE_UNBOXED(page)) + return 0; + + /* + * Scan the page for pointers to younger generations or the top + * temp. generation. + */ + + for (j = 0; j < num_words; j++) { + char *ptr = *(page_addr + j); + int index = find_page_index(ptr); + + /* Check that it's in the dynamic space */ + if (index != -1) + if ( /* Does it point to a younger or the temp. generation? */ + (PAGE_ALLOCATED(index) + && page_table[index].bytes_used != 0 + && (PAGE_GENERATION(index) < gen + || PAGE_GENERATION(index) == NUM_GENERATIONS)) + + /* Or does it point within a current gc_alloc region? */ + || (boxed_region.start_addr <= ptr + && ptr <= boxed_region.free_pointer) + || (unboxed_region.start_addr <= ptr + && ptr <= unboxed_region.free_pointer)) { + wp_it = 0; + break; + } + } - /* - * Scan the page for pointers to younger generations or the top - * temp. generation. - */ - - for (j = 0; j < num_words; j++) { - char *ptr = *(page_addr + j); - int index = find_page_index(ptr); - - /* Check that it's in the dynamic space */ - if (index != -1) - if (/* Does it point to a younger or the temp. generation? */ - (PAGE_ALLOCATED(index) - && page_table[index].bytes_used != 0 - && (PAGE_GENERATION(index) < gen - || PAGE_GENERATION(index) == NUM_GENERATIONS)) - - /* Or does it point within a current gc_alloc region? */ - || (boxed_region.start_addr <= ptr - && ptr <= boxed_region.free_pointer) - || (unboxed_region.start_addr <= ptr - && ptr <= unboxed_region.free_pointer)) { - wp_it = 0; - break; - } - } - - if (wp_it == 1) { - /* Write protect the page */ + if (wp_it == 1) { + /* Write protect the page */ #if 0 - fprintf(stderr, "* WP page %d of gen %d\n", page, gen); + fprintf(stderr, "* WP page %d of gen %d\n", page, gen); #endif - os_protect((os_vm_address_t) page_addr, PAGE_SIZE, - OS_VM_PROT_READ | OS_VM_PROT_EXECUTE); + os_protect((os_vm_address_t) page_addr, PAGE_SIZE, + OS_VM_PROT_READ | OS_VM_PROT_EXECUTE); - /* Note the page as protected in the page tables */ - page_table[page].flags |= PAGE_WRITE_PROTECTED_MASK; - } + /* Note the page as protected in the page tables */ + page_table[page].flags |= PAGE_WRITE_PROTECTED_MASK; + } - return wp_it; + return wp_it; } /* @@ -5208,104 +5426,110 @@ static int update_page_write_prot(unsigned page) * if a weak pointer is scavenged. Still it's a useful check. */ -static void scavenge_generation(int generation) +static void +scavenge_generation(int generation) { - int i; - int num_wp = 0; + int i; + int num_wp = 0; #define SC_GEN_CK 0 #if SC_GEN_CK - /* Clear the write_protected_cleared flags on all pages */ - for (i = 0; i < dynamic_space_pages; i++) - page_table[i].flags &= ~PAGE_WRITE_PROTECTED_CLEADED_MASK; -#endif - - for (i = 0; i < last_free_page; i++) { - if (PAGE_ALLOCATED(i) && !PAGE_UNBOXED(i) - && page_table[i].bytes_used != 0 - && PAGE_GENERATION(i) == generation) { - int last_page; - - /* This should be the start of a contiguous block */ - gc_assert(page_table[i].first_object_offset == 0); - - /* - * Need to find the full extent of this contiguous block in case - * objects span pages. - */ - - /* - * Now work forward until the end of this contiguous area is - * found. Small areas are preferred as there is a better chance - * of its pages being write protected. - */ - for (last_page = i; ;last_page++) - /* Check if this is the last page in this contiguous block */ - if (page_table[last_page].bytes_used < PAGE_SIZE - /* Or it is PAGE_SIZE and is the last in the block */ - || !PAGE_ALLOCATED(last_page + 1) - || PAGE_UNBOXED(last_page + 1) - || page_table[last_page + 1].bytes_used == 0 - || PAGE_GENERATION(last_page + 1) != generation - || page_table[last_page + 1].first_object_offset == 0) - break; - - /* - * Do a limited check for write_protected pages. If all pages - * are write_protected then no need to scavenge. - */ - { - int j, all_wp = 1; - for (j = i; j <= last_page; j++) - if (!PAGE_WRITE_PROTECTED(j)) { - all_wp = 0; - break; - } -#if !SC_GEN_CK - if (all_wp == 0) + /* Clear the write_protected_cleared flags on all pages */ + for (i = 0; i < dynamic_space_pages; i++) + page_table[i].flags &= ~PAGE_WRITE_PROTECTED_CLEADED_MASK; #endif - { - scavenge(page_address(i), (page_table[last_page].bytes_used - + PAGE_SIZE * (last_page - i)) / sizeof(lispobj)); + + for (i = 0; i < last_free_page; i++) { + if (PAGE_ALLOCATED(i) && !PAGE_UNBOXED(i) + && page_table[i].bytes_used != 0 + && PAGE_GENERATION(i) == generation) { + int last_page; + + /* This should be the start of a contiguous block */ + gc_assert(page_table[i].first_object_offset == 0); /* - * Now scan the pages and write protect those that don't - * have pointers to younger generations. + * Need to find the full extent of this contiguous block in case + * objects span pages. */ - if (enable_page_protection) - for (j = i; j <= last_page; j++) - num_wp += update_page_write_prot(j); - } - } - i = last_page; + + /* + * Now work forward until the end of this contiguous area is + * found. Small areas are preferred as there is a better chance + * of its pages being write protected. + */ + for (last_page = i;; last_page++) + /* Check if this is the last page in this contiguous block */ + if (page_table[last_page].bytes_used < PAGE_SIZE + /* Or it is PAGE_SIZE and is the last in the block */ + || !PAGE_ALLOCATED(last_page + 1) + || PAGE_UNBOXED(last_page + 1) + || page_table[last_page + 1].bytes_used == 0 + || PAGE_GENERATION(last_page + 1) != generation + || page_table[last_page + 1].first_object_offset == 0) + break; + + /* + * Do a limited check for write_protected pages. If all pages + * are write_protected then no need to scavenge. + */ + { + int j, all_wp = 1; + + for (j = i; j <= last_page; j++) + if (!PAGE_WRITE_PROTECTED(j)) { + all_wp = 0; + break; + } +#if !SC_GEN_CK + if (all_wp == 0) +#endif + { + scavenge(page_address(i), (page_table[last_page].bytes_used + + PAGE_SIZE * (last_page - + i)) / + sizeof(lispobj)); + + /* + * Now scan the pages and write protect those that don't + * have pointers to younger generations. + */ + if (enable_page_protection) + for (j = i; j <= last_page; j++) + num_wp += update_page_write_prot(j); + } + } + i = last_page; + } } - } - if (gencgc_verbose > 1 && num_wp != 0) - fprintf(stderr, "Write protected %d pages within generation %d\n", - num_wp, generation); + if (gencgc_verbose > 1 && num_wp != 0) + fprintf(stderr, "Write protected %d pages within generation %d\n", + num_wp, generation); #if SC_GEN_CK - /* - * Check that none of the write_protected pages in this generation - * have been written to. - */ - for (i = 0; i < dynamic_space_pages; i++) - if (PAGE_ALLOCATED(i) - && page_table[i].bytes_used != 0 - && PAGE_GENERATION(i) == generation - && PAGE_WRITE_PROTECTED_CLEARED(i)) { - fprintf(stderr, "*** scavenge_generation %d: write protected page %d written to?\n", generation, i); - fprintf(stderr, "*** page: bytes_used=%d first_object_offset=%d dont_move=%d\n", - page_table[i].bytes_used, - page_table[i].first_object_offset, - PAGE_DONT_MOVE(i)); - } + /* + * Check that none of the write_protected pages in this generation + * have been written to. + */ + for (i = 0; i < dynamic_space_pages; i++) + if (PAGE_ALLOCATED(i) + && page_table[i].bytes_used != 0 + && PAGE_GENERATION(i) == generation + && PAGE_WRITE_PROTECTED_CLEARED(i)) { + fprintf(stderr, + "*** scavenge_generation %d: write protected page %d written to?\n", + generation, i); + fprintf(stderr, + "*** page: bytes_used=%d first_object_offset=%d dont_move=%d\n", + page_table[i].bytes_used, page_table[i].first_object_offset, + PAGE_DONT_MOVE(i)); + } #endif } - + /* * Scavenge a newspace generation. As it is scavenged new objects may * be allocated to it; these will also need to be scavenged. This @@ -5337,262 +5561,272 @@ static struct new_area new_areas_2[NUM_NEW_AREAS]; * complete the job as new objects may be added to the generation in * the process which are not scavenged. */ -static void scavenge_newspace_generation_one_scan(int generation) +static void +scavenge_newspace_generation_one_scan(int generation) { - int i; + int i; #if 0 - fprintf(stderr, "Starting one full scan of newspace generation %d\n", - generation); -#endif - - for (i = 0; i < last_free_page; i++) { - if (PAGE_ALLOCATED(i) && !PAGE_UNBOXED(i) - && page_table[i].bytes_used != 0 - && PAGE_GENERATION(i) == generation - && (!PAGE_WRITE_PROTECTED(i) - /* This may be redundant as WP is now cleared before promotion. */ - || PAGE_DONT_MOVE(i))) { - int last_page; - - /* The scavenge will start at the first_object_offset of page i */ - - /* - * Need to find the full extent of this contiguous block in case - * objects span pages. - */ - - /* - * Now work forward until the end of this contiguous area is - * found. Small areas are preferred as there is a better chance - * of its pages being write protected. - */ - for (last_page = i; ; last_page++) - /* Check if this is the last page in this contiguous block */ - if (page_table[last_page].bytes_used < PAGE_SIZE - /* Or it is PAGE_SIZE and is the last in the block */ - || !PAGE_ALLOCATED(last_page + 1) - || PAGE_UNBOXED(last_page + 1) - || page_table[last_page + 1].bytes_used == 0 - || PAGE_GENERATION(last_page + 1) != generation - || page_table[last_page + 1].first_object_offset == 0) - break; - - /* - * Do a limited check for write_protected pages. If all pages - * are write_protected then no need to scavenge. Except if the - * pages are marked dont_move. - */ - { - int j, all_wp = 1; - for (j = i; j <= last_page; j++) - if (!PAGE_WRITE_PROTECTED(j) || PAGE_DONT_MOVE(j)) { - all_wp = 0; - break; - } -#if !SC_NS_GEN_CK - if (all_wp == 0) + fprintf(stderr, "Starting one full scan of newspace generation %d\n", + generation); #endif - { - int size; - /* Calc. the size */ - if (last_page == i) - size = (page_table[last_page].bytes_used - - page_table[i].first_object_offset) / sizeof(lispobj); - else - size = (page_table[last_page].bytes_used + - PAGE_SIZE * (last_page - i) - - page_table[i].first_object_offset) / sizeof(lispobj); + for (i = 0; i < last_free_page; i++) { + if (PAGE_ALLOCATED(i) && !PAGE_UNBOXED(i) + && page_table[i].bytes_used != 0 + && PAGE_GENERATION(i) == generation && (!PAGE_WRITE_PROTECTED(i) + /* This may be redundant as WP is now cleared before promotion. */ + || PAGE_DONT_MOVE(i))) { + int last_page; + + /* The scavenge will start at the first_object_offset of page i */ + + /* + * Need to find the full extent of this contiguous block in case + * objects span pages. + */ + + /* + * Now work forward until the end of this contiguous area is + * found. Small areas are preferred as there is a better chance + * of its pages being write protected. + */ + for (last_page = i;; last_page++) + /* Check if this is the last page in this contiguous block */ + if (page_table[last_page].bytes_used < PAGE_SIZE + /* Or it is PAGE_SIZE and is the last in the block */ + || !PAGE_ALLOCATED(last_page + 1) + || PAGE_UNBOXED(last_page + 1) + || page_table[last_page + 1].bytes_used == 0 + || PAGE_GENERATION(last_page + 1) != generation + || page_table[last_page + 1].first_object_offset == 0) + break; + /* + * Do a limited check for write_protected pages. If all pages + * are write_protected then no need to scavenge. Except if the + * pages are marked dont_move. + */ { + int j, all_wp = 1; + + for (j = i; j <= last_page; j++) + if (!PAGE_WRITE_PROTECTED(j) || PAGE_DONT_MOVE(j)) { + all_wp = 0; + break; + } +#if !SC_NS_GEN_CK + if (all_wp == 0) +#endif + { + int size; + + /* Calc. the size */ + if (last_page == i) + size = (page_table[last_page].bytes_used + - + page_table[i].first_object_offset) / + sizeof(lispobj); + else + size = + (page_table[last_page].bytes_used + + PAGE_SIZE * (last_page - i) - + page_table[i].first_object_offset) / + sizeof(lispobj); + + { #if SC_NS_GEN_CK - int a1 = bytes_allocated; -#endif + int a1 = bytes_allocated; +#endif #if 0 - fprintf(stderr, "scavenge(%x,%d)\n", - page_address(i) + page_table[i].first_object_offset, - size); + fprintf(stderr, "scavenge(%x,%d)\n", + page_address(i) + + page_table[i].first_object_offset, size); #endif - new_areas_ignore_page = last_page; + new_areas_ignore_page = last_page; - scavenge((page_address(i) + page_table[i].first_object_offset), - size); + scavenge( + (page_address(i) + + page_table[i].first_object_offset), size); #if SC_NS_GEN_CK - /* Flush the alloc regions updating the tables. */ - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); - - if (all_wp != 0 && a1 != bytes_allocated) { - fprintf(stderr, "*** scav.new.gen. alloc'ed over %d to %d\n", - i, last_page); - fprintf(stderr, "*** page: bytes_used=%d first_object_offset=%d dont_move=%d wp=%d wpc=%d\n", - page_table[i].bytes_used, - page_table[i].first_object_offset, - PAGE_DONT_MOVE(i), - PAGE_WRITE_PROTECTED(i), - PAGE_PROTECTED_CLEARED(i)); - } -#endif + /* Flush the alloc regions updating the tables. */ + gc_alloc_update_page_tables(0, &boxed_region); + gc_alloc_update_page_tables(1, &unboxed_region); + + if (all_wp != 0 && a1 != bytes_allocated) { + fprintf(stderr, + "*** scav.new.gen. alloc'ed over %d to %d\n", + i, last_page); + fprintf(stderr, + "*** page: bytes_used=%d first_object_offset=%d dont_move=%d wp=%d wpc=%d\n", + page_table[i].bytes_used, + page_table[i].first_object_offset, + PAGE_DONT_MOVE(i), PAGE_WRITE_PROTECTED(i), + PAGE_PROTECTED_CLEARED(i)); + } +#endif + } + } } - } - } - i = last_page; + i = last_page; + } } - } } /* Do a complete scavenge of the newspace generation */ -static void scavenge_newspace_generation(int generation) +static void +scavenge_newspace_generation(int generation) { - int i; + int i; - /* The new_areas array currently being written to by gc_alloc */ - struct new_area (*current_new_areas)[] = &new_areas_1; - int current_new_areas_index; + /* The new_areas array currently being written to by gc_alloc */ + struct new_area (*current_new_areas)[] = &new_areas_1; + int current_new_areas_index; - /* The new_areas created but the previous scavenge cycle */ - struct new_area (*previous_new_areas)[] = NULL; - int previous_new_areas_index; + /* The new_areas created but the previous scavenge cycle */ + struct new_area (*previous_new_areas)[] = NULL; + int previous_new_areas_index; #define SC_NS_GEN_CK 0 #if SC_NS_GEN_CK - /* Clear the write_protected_cleared flags on all pages */ - for (i = 0; i < dynamic_space_pages; i++) - page_table[i].flags &= ~PAGE_WRITE_PROTECTED_CLEARED; + /* Clear the write_protected_cleared flags on all pages */ + for (i = 0; i < dynamic_space_pages; i++) + page_table[i].flags &= ~PAGE_WRITE_PROTECTED_CLEARED; #endif - /* Flush the current regions updating the tables. */ - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); + /* Flush the current regions updating the tables. */ + gc_alloc_update_page_tables(0, &boxed_region); + gc_alloc_update_page_tables(1, &unboxed_region); - /* Turn on the recording of new areas by gc_alloc. */ - new_areas = current_new_areas; - new_areas_index = 0; + /* Turn on the recording of new areas by gc_alloc. */ + new_areas = current_new_areas; + new_areas_index = 0; - /* - * Don't need to record new areas that get scavenged anyway during - * scavenge_newspace_generation_one_scan. - */ - record_new_objects = 1; + /* + * Don't need to record new areas that get scavenged anyway during + * scavenge_newspace_generation_one_scan. + */ + record_new_objects = 1; - /* Start with a full scavenge */ - scavenge_newspace_generation_one_scan(generation); + /* Start with a full scavenge */ + scavenge_newspace_generation_one_scan(generation); - /* Record all new areas now. */ - record_new_objects = 2; + /* Record all new areas now. */ + record_new_objects = 2; - /* Flush the current regions updating the tables. */ - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); + /* Flush the current regions updating the tables. */ + gc_alloc_update_page_tables(0, &boxed_region); + gc_alloc_update_page_tables(1, &unboxed_region); - /* Grab new_areas_index */ - current_new_areas_index = new_areas_index; + /* Grab new_areas_index */ + current_new_areas_index = new_areas_index; #if 0 - fprintf(stderr, "First scan finished; current_new_areas_index=%d\n", - current_new_areas_index); + fprintf(stderr, "First scan finished; current_new_areas_index=%d\n", + current_new_areas_index); #endif - while (current_new_areas_index > 0) { - /* Move the current to the previous new areas */ - previous_new_areas = current_new_areas; - previous_new_areas_index = current_new_areas_index; + while (current_new_areas_index > 0) { + /* Move the current to the previous new areas */ + previous_new_areas = current_new_areas; + previous_new_areas_index = current_new_areas_index; - /* - * Scavenge all the areas in previous new areas. Any new areas - * allocated are saved in current_new_areas. - */ + /* + * Scavenge all the areas in previous new areas. Any new areas + * allocated are saved in current_new_areas. + */ - /* - * Allocate an array for current_new_areas; alternating between - * new_areas_1 and 2. - */ - if (previous_new_areas == &new_areas_1) - current_new_areas = &new_areas_2; - else - current_new_areas = &new_areas_1; + /* + * Allocate an array for current_new_areas; alternating between + * new_areas_1 and 2. + */ + if (previous_new_areas == &new_areas_1) + current_new_areas = &new_areas_2; + else + current_new_areas = &new_areas_1; - /* Setup for gc_alloc */ - new_areas = current_new_areas; - new_areas_index = 0; + /* Setup for gc_alloc */ + new_areas = current_new_areas; + new_areas_index = 0; - /* Check if previous_new_areas had overflowed */ - if (previous_new_areas_index >= NUM_NEW_AREAS) { - /* - * New areas of objects allocated have been lost so need to do a - * full scan to be sure! If this becomes a problem try - * increasing NUM_NEW_AREAS. - */ - if (gencgc_verbose) - fprintf(stderr, "** new_areas overflow, doing full scavenge\n"); - - /* - * Don't need to record new areas that get scavenge anyway - * during scavenge_newspace_generation_one_scan. - */ - record_new_objects = 1; - - scavenge_newspace_generation_one_scan(generation); - - /* Record all new areas now. */ - record_new_objects = 2; - - /* Flush the current regions updating the tables. */ - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); - } else { - /* Work through previous_new_areas */ - for (i = 0; i < previous_new_areas_index; i++) { - int page = (*previous_new_areas)[i].page; - int offset = (*previous_new_areas)[i].offset; - int size = (*previous_new_areas)[i].size / sizeof(lispobj); - gc_assert((*previous_new_areas)[i].size % 4 == 0); - -#if 0 - fprintf(stderr, "*S page %d offset %d size %d\n",page,offset,size*sizeof(lispobj)); -#endif - scavenge(page_address(page)+offset, size); - } - - /* Flush the current regions updating the tables. */ - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); - } + /* Check if previous_new_areas had overflowed */ + if (previous_new_areas_index >= NUM_NEW_AREAS) { + /* + * New areas of objects allocated have been lost so need to do a + * full scan to be sure! If this becomes a problem try + * increasing NUM_NEW_AREAS. + */ + if (gencgc_verbose) + fprintf(stderr, "** new_areas overflow, doing full scavenge\n"); - /* Grab new_areas_index */ - current_new_areas_index = new_areas_index; + /* + * Don't need to record new areas that get scavenge anyway + * during scavenge_newspace_generation_one_scan. + */ + record_new_objects = 1; + + scavenge_newspace_generation_one_scan(generation); + + /* Record all new areas now. */ + record_new_objects = 2; + + /* Flush the current regions updating the tables. */ + gc_alloc_update_page_tables(0, &boxed_region); + gc_alloc_update_page_tables(1, &unboxed_region); + } else { + /* Work through previous_new_areas */ + for (i = 0; i < previous_new_areas_index; i++) { + int page = (*previous_new_areas)[i].page; + int offset = (*previous_new_areas)[i].offset; + int size = (*previous_new_areas)[i].size / sizeof(lispobj); + + gc_assert((*previous_new_areas)[i].size % 4 == 0); #if 0 - fprintf(stderr, "Re-scan finished; current_new_areas_index=%d\n", - current_new_areas_index); + fprintf(stderr, "*S page %d offset %d size %d\n", page, offset, + size * sizeof(lispobj)); +#endif + scavenge(page_address(page) + offset, size); + } + + /* Flush the current regions updating the tables. */ + gc_alloc_update_page_tables(0, &boxed_region); + gc_alloc_update_page_tables(1, &unboxed_region); + } + + /* Grab new_areas_index */ + current_new_areas_index = new_areas_index; + +#if 0 + fprintf(stderr, "Re-scan finished; current_new_areas_index=%d\n", + current_new_areas_index); #endif - } + } - /* Turn off recording of areas allocated by gc_alloc */ - record_new_objects = 0; + /* Turn off recording of areas allocated by gc_alloc */ + record_new_objects = 0; #if SC_NS_GEN_CK - /* - * Check that none of the write_protected pages in this generation - * have been written to. - */ - for (i = 0; i < dynamic_space_pages; i++) - if (PAGE_ALLOCATED(i) - && page_table[i].bytes_used != 0 - && PAGE_GENERATION(i) == generation - && PAGE_WRITE_PROTECTED_CLEARED(i) - && !PAGE_DONT_MOVE(i)) - fprintf(stderr, "*** scav.new.gen. %d: write protected page %d written to? dont_move=%d\n", - generation, i, PAGE_DONT_MOVE(i)); + /* + * Check that none of the write_protected pages in this generation + * have been written to. + */ + for (i = 0; i < dynamic_space_pages; i++) + if (PAGE_ALLOCATED(i) + && page_table[i].bytes_used != 0 + && PAGE_GENERATION(i) == generation + && PAGE_WRITE_PROTECTED_CLEARED(i) && !PAGE_DONT_MOVE(i)) + fprintf(stderr, + "*** scav.new.gen. %d: write protected page %d written to? dont_move=%d\n", + generation, i, PAGE_DONT_MOVE(i)); #endif } - + /* * Un-write-protect all the pages in from_space. This is done at the * start of a GC else there may be many page faults while scavenging @@ -5600,27 +5834,29 @@ static void scavenge_newspace_generation(int generation) * would need to be unprotected anyway before unmapping in * free_oldspace; not sure what effect this has on paging?. */ -static void unprotect_oldspace(void) +static void +unprotect_oldspace(void) { - int i; + int i; - for (i = 0; i < last_free_page; i++) - if (PAGE_ALLOCATED(i) - && page_table[i].bytes_used != 0 - && PAGE_GENERATION(i) == from_space) { - void *page_start; + for (i = 0; i < last_free_page; i++) + if (PAGE_ALLOCATED(i) + && page_table[i].bytes_used != 0 + && PAGE_GENERATION(i) == from_space) { + void *page_start; - page_start = (void *) page_address(i); + page_start = (void *) page_address(i); - /* - * Remove any write protection. Should be able to rely on the - * WP flag to avoid redundant calls. - */ - if (PAGE_WRITE_PROTECTED(i)) { - os_protect((os_vm_address_t) page_start, PAGE_SIZE, OS_VM_PROT_ALL); - page_table[i].flags &= ~PAGE_WRITE_PROTECTED_MASK; - } - } + /* + * Remove any write protection. Should be able to rely on the + * WP flag to avoid redundant calls. + */ + if (PAGE_WRITE_PROTECTED(i)) { + os_protect((os_vm_address_t) page_start, PAGE_SIZE, + OS_VM_PROT_ALL); + page_table[i].flags &= ~PAGE_WRITE_PROTECTED_MASK; + } + } } /* @@ -5629,487 +5865,509 @@ static void unprotect_oldspace(void) * generation. Bytes_allocated and the generation bytes_allocated * counter are updated. The number of bytes freed is returned. */ -static int free_oldspace(void) +static int +free_oldspace(void) { - int bytes_freed = 0; - int first_page, last_page; + int bytes_freed = 0; + int first_page, last_page; - first_page = 0; + first_page = 0; - do { - /* Find a first page for the next region of pages. */ - while (first_page < last_free_page - && (!PAGE_ALLOCATED(first_page) - || page_table[first_page].bytes_used == 0 - || PAGE_GENERATION(first_page) != from_space)) - first_page++; + do { + /* Find a first page for the next region of pages. */ + while (first_page < last_free_page && (!PAGE_ALLOCATED(first_page) + || page_table[first_page]. + bytes_used == 0 + || PAGE_GENERATION(first_page) != + from_space)) first_page++; + + if (first_page >= last_free_page) + break; - if (first_page >= last_free_page) - break; + /* Find the last page of this region. */ + last_page = first_page; - /* Find the last page of this region. */ - last_page = first_page; + do { + /* Free the page */ + bytes_freed += page_table[last_page].bytes_used; + generations[PAGE_GENERATION(last_page)].bytes_allocated -= + page_table[last_page].bytes_used; + page_table[last_page].flags &= ~PAGE_ALLOCATED_MASK; + page_table[last_page].bytes_used = 0; - do { - /* Free the page */ - bytes_freed += page_table[last_page].bytes_used; - generations[PAGE_GENERATION(last_page)].bytes_allocated -= page_table[last_page].bytes_used; - page_table[last_page].flags &= ~PAGE_ALLOCATED_MASK; - page_table[last_page].bytes_used = 0; - - /* - * Remove any write protection. Should be able to rely on the - * WP flag to avoid redundant calls. - */ - { - void *page_start = (void *)page_address(last_page); - - if (PAGE_WRITE_PROTECTED(last_page)) { - os_protect((os_vm_address_t) page_start, PAGE_SIZE, OS_VM_PROT_ALL); - page_table[last_page].flags &= ~PAGE_WRITE_PROTECTED_MASK; + /* + * Remove any write protection. Should be able to rely on the + * WP flag to avoid redundant calls. + */ + { + void *page_start = (void *) page_address(last_page); + + if (PAGE_WRITE_PROTECTED(last_page)) { + os_protect((os_vm_address_t) page_start, PAGE_SIZE, + OS_VM_PROT_ALL); + page_table[last_page].flags &= ~PAGE_WRITE_PROTECTED_MASK; + } + } + last_page++; + } + while (last_page < last_free_page && PAGE_ALLOCATED(last_page) + && page_table[last_page].bytes_used != 0 + && PAGE_GENERATION(last_page) == from_space); + + /* Zero pages from first_page to (last_page - 1) */ + if (gencgc_unmap_zero) { + char *page_start, *addr; + + page_start = page_address(first_page); + + os_invalidate((os_vm_address_t) page_start, + PAGE_SIZE * (last_page - first_page)); + addr = + (char *) os_validate((os_vm_address_t) page_start, + PAGE_SIZE * (last_page - first_page)); + if (addr == NULL || addr != page_start) + fprintf(stderr, "gc_zero: page moved, 0x%08lx ==> 0x%08lx!\n", + (unsigned long) page_start, (unsigned long) addr); + } else { + int *page_start; + + page_start = (int *) page_address(first_page); + memset(page_start, 0, PAGE_SIZE * (last_page - first_page)); } - } - last_page++; - } - while (last_page < last_free_page - && PAGE_ALLOCATED(last_page) - && page_table[last_page].bytes_used != 0 - && PAGE_GENERATION(last_page) == from_space); - - /* Zero pages from first_page to (last_page - 1) */ - if (gencgc_unmap_zero) { - char *page_start, *addr; - - page_start = page_address(first_page); - - os_invalidate((os_vm_address_t) page_start, PAGE_SIZE * (last_page - first_page)); - addr = (char *) os_validate((os_vm_address_t) page_start, PAGE_SIZE * (last_page - first_page)); - if(addr == NULL || addr != page_start) - fprintf(stderr, "gc_zero: page moved, 0x%08lx ==> 0x%08lx!\n", - (unsigned long) page_start, (unsigned long) addr); - } else { - int *page_start; - page_start = (int *) page_address(first_page); - memset(page_start, 0, PAGE_SIZE * (last_page - first_page)); + first_page = last_page; } + while (first_page < last_free_page); - first_page = last_page; - } - while(first_page < last_free_page); - - bytes_allocated -= bytes_freed; - return bytes_freed; + bytes_allocated -= bytes_freed; + return bytes_freed; } /* Print out some information about a pointer at the given address. */ -static void print_ptr(lispobj *addr) +static void +print_ptr(lispobj * addr) { - /* If addr is in the dynamic space then print out the page information. */ - int pi1 = find_page_index((void*) addr); + /* If addr is in the dynamic space then print out the page information. */ + int pi1 = find_page_index((void *) addr); - if(pi1 != -1) - fprintf(stderr, " %lx: page %d alloc %d unboxed %d gen %d bytes_used %d offset %d dont_move %d\n", - (unsigned long) addr, pi1, - PAGE_ALLOCATED(pi1), - PAGE_UNBOXED(pi1), - PAGE_GENERATION(pi1), - page_table[pi1].bytes_used, - page_table[pi1].first_object_offset, - PAGE_DONT_MOVE(pi1)); - fprintf(stderr, " %lx %lx %lx %lx (%lx) %lx %lx %lx %lx\n", - *(addr - 4), *(addr - 3), *(addr - 2), *(addr - 1), *(addr - 0), - *(addr + 1), *(addr + 2), *(addr + 3), *(addr + 4)); + if (pi1 != -1) + fprintf(stderr, + " %lx: page %d alloc %d unboxed %d gen %d bytes_used %d offset %d dont_move %d\n", + (unsigned long) addr, pi1, PAGE_ALLOCATED(pi1), + PAGE_UNBOXED(pi1), PAGE_GENERATION(pi1), + page_table[pi1].bytes_used, page_table[pi1].first_object_offset, + PAGE_DONT_MOVE(pi1)); + fprintf(stderr, " %lx %lx %lx %lx (%lx) %lx %lx %lx %lx\n", *(addr - 4), + *(addr - 3), *(addr - 2), *(addr - 1), *(addr - 0), *(addr + 1), + *(addr + 2), *(addr + 3), *(addr + 4)); } #ifdef sparc -extern char closure_tramp; +extern char closure_tramp; #else -extern int undefined_tramp; +extern int undefined_tramp; #endif -static void verify_space(lispobj*start, size_t words) +static void +verify_space(lispobj * start, size_t words) { - int dynamic_space = (find_page_index((void*) start) != -1); - unsigned long readonly_space = (READ_ONLY_SPACE_START <= (unsigned long) start && - (unsigned long) start < SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); + int dynamic_space = (find_page_index((void *) start) != -1); + unsigned long readonly_space = + (READ_ONLY_SPACE_START <= (unsigned long) start + && (unsigned long) start < SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); - while(words > 0) { - size_t count = 1; - lispobj thing = *(lispobj*) start; + while (words > 0) { + size_t count = 1; + lispobj thing = *(lispobj *) start; - if(Pointerp(thing)) { - int page_index = find_page_index((void*)thing); - int to_readonly_space = (READ_ONLY_SPACE_START <= thing && - thing < SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); - unsigned long to_static_space = ((unsigned long) static_space <= thing && - thing < SymbolValue(STATIC_SPACE_FREE_POINTER)); + if (Pointerp(thing)) { + int page_index = find_page_index((void *) thing); + int to_readonly_space = (READ_ONLY_SPACE_START <= thing && + thing < - /* Does it point to the dynamic space? */ - if(page_index != -1) { - /* - * If it's within the dynamic space it should point to a used - * page. X Could check the offset too. - */ - if (PAGE_ALLOCATED(page_index) - && page_table[page_index].bytes_used == 0) { - fprintf(stderr, "*** Ptr %lx @ %lx sees free page.\n", - (unsigned long) thing, (unsigned long) start); - print_ptr(start); - } + SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); + unsigned long to_static_space = + ((unsigned long) static_space <= thing - /* Check that it doesn't point to a forwarding pointer! */ - if (*((lispobj *) PTR(thing)) == 0x01) { - fprintf(stderr, "*** Ptr %lx @ %lx sees forwarding ptr.\n", - (unsigned long) thing, (unsigned long) start); - print_ptr(start); - } + && thing < SymbolValue(STATIC_SPACE_FREE_POINTER)); - /* - * Check that its not in the RO space as it would then be a - * pointer from the RO to the dynamic space. - */ - if (readonly_space) { - fprintf(stderr, "*** Ptr to dynamic space %lx, from RO space %lx\n", - (unsigned long) thing, (unsigned long) start); - print_ptr(start); - } + /* Does it point to the dynamic space? */ + if (page_index != -1) { + /* + * If it's within the dynamic space it should point to a used + * page. X Could check the offset too. + */ + if (PAGE_ALLOCATED(page_index) + && page_table[page_index].bytes_used == 0) { + fprintf(stderr, "*** Ptr %lx @ %lx sees free page.\n", + (unsigned long) thing, (unsigned long) start); + print_ptr(start); + } + + /* Check that it doesn't point to a forwarding pointer! */ + if (*((lispobj *) PTR(thing)) == 0x01) { + fprintf(stderr, "*** Ptr %lx @ %lx sees forwarding ptr.\n", + (unsigned long) thing, (unsigned long) start); + print_ptr(start); + } - /* - * Does it point to a plausible object? This check slows it - * down a lot. - */ + /* + * Check that its not in the RO space as it would then be a + * pointer from the RO to the dynamic space. + */ + if (readonly_space) { + fprintf(stderr, + "*** Ptr to dynamic space %lx, from RO space %lx\n", + (unsigned long) thing, (unsigned long) start); + print_ptr(start); + } + + /* + * Does it point to a plausible object? This check slows it + * down a lot. + */ #if 0 - if (!valid_dynamic_space_pointer((lispobj *) thing)) { - fprintf(stderr, "*** Ptr %x to invalid object %x\n", thing, start); - print_ptr(start); - } + if (!valid_dynamic_space_pointer((lispobj *) thing)) { + fprintf(stderr, "*** Ptr %x to invalid object %x\n", thing, + start); + print_ptr(start); + } #endif - } else { - /* Verify that it points to another valid space */ - if (!to_readonly_space && !to_static_space && + } else { + /* Verify that it points to another valid space */ + if (!to_readonly_space && !to_static_space && #if defined(sparc) - thing != (int) &closure_tramp + thing != (int) &closure_tramp #else - thing != (int) &undefined_tramp + thing != (int) &undefined_tramp #endif - ) - { - fprintf(stderr, "*** Ptr %lx @ %lx sees Junk (undefined_tramp = %lx)\n", - (unsigned long) thing, (unsigned long) start, + ) { + fprintf(stderr, + "*** Ptr %lx @ %lx sees Junk (undefined_tramp = %lx)\n", + (unsigned long) thing, (unsigned long) start, #if defined(sparc) - (unsigned long) &closure_tramp + (unsigned long) &closure_tramp #else - (unsigned long) &undefined_tramp + (unsigned long) &undefined_tramp #endif - ); - print_ptr(start); - } - } - - } else - if (thing & 0x3) /* Skip fixnums */ - switch(TypeOf(*start)) { - /* Boxed objects. */ - case type_SimpleVector: - case type_Ratio: - case type_Complex: - case type_SimpleArray: - case type_ComplexString: - case type_ComplexBitVector: - case type_ComplexVector: - case type_ComplexArray: - case type_ClosureHeader: - case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: - case type_DylanFunctionHeader: - case type_ValueCellHeader: - case type_SymbolHeader: - case type_BaseChar: - case type_UnboundMarker: - case type_InstanceHeader: - case type_Fdefn: - case type_ScavengerHook: - count = 1; - break; - - case type_CodeHeader: - { - lispobj object = *start; - struct code *code; - int nheader_words, ncode_words, nwords; - lispobj fheaderl; - struct function *fheaderp; - - code = (struct code *) start; - - /* Check that it's not in the dynamic space. */ - if (dynamic_space - /* - * It's ok if it's byte compiled code. The trace table - * offset will be a fixnum if it's x86 compiled code - check. - */ - && !(code->trace_table_offset & 0x3) - /* Only when enabled */ - && verify_dynamic_code_check) - fprintf(stderr, "*** Code object at %lx in the dynamic space\n", - (unsigned long) start); - - ncode_words = fixnum_value(code->code_size); - nheader_words = HeaderValue(object); - nwords = ncode_words + nheader_words; - nwords = CEILING(nwords, 2); - /* Scavenge the boxed section of the code data block */ - verify_space(start + 1, nheader_words - 1); - - /* - * Scavenge the boxed section of each function object in - * the code data block. - */ - fheaderl = code->entry_points; - while (fheaderl != NIL) { - fheaderp = (struct function *) PTR(fheaderl); - gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); - verify_space(&fheaderp->name, 1); - verify_space(&fheaderp->arglist, 1); - verify_space(&fheaderp->type, 1); - fheaderl = fheaderp->next; + ); + print_ptr(start); + } } - count = nwords; - break; - } - /* Unboxed objects */ - case type_Bignum: - case type_SingleFloat: - case type_DoubleFloat: + } else if (thing & 0x3) /* Skip fixnums */ + switch (TypeOf(*start)) { + /* Boxed objects. */ + case type_SimpleVector: + case type_Ratio: + case type_Complex: + case type_SimpleArray: + case type_ComplexString: + case type_ComplexBitVector: + case type_ComplexVector: + case type_ComplexArray: + case type_ClosureHeader: + case type_FuncallableInstanceHeader: + case type_ByteCodeFunction: + case type_ByteCodeClosure: + case type_DylanFunctionHeader: + case type_ValueCellHeader: + case type_SymbolHeader: + case type_BaseChar: + case type_UnboundMarker: + case type_InstanceHeader: + case type_Fdefn: + case type_ScavengerHook: + count = 1; + break; + + case type_CodeHeader: + { + lispobj object = *start; + struct code *code; + int nheader_words, ncode_words, nwords; + lispobj fheaderl; + struct function *fheaderp; + + code = (struct code *) start; + + /* Check that it's not in the dynamic space. */ + if (dynamic_space + /* + * It's ok if it's byte compiled code. The trace table + * offset will be a fixnum if it's x86 compiled code - check. + */ + && !(code->trace_table_offset & 0x3) + /* Only when enabled */ + && verify_dynamic_code_check) + fprintf(stderr, + "*** Code object at %lx in the dynamic space\n", + (unsigned long) start); + + ncode_words = fixnum_value(code->code_size); + nheader_words = HeaderValue(object); + nwords = ncode_words + nheader_words; + nwords = CEILING(nwords, 2); + /* Scavenge the boxed section of the code data block */ + verify_space(start + 1, nheader_words - 1); + + /* + * Scavenge the boxed section of each function object in + * the code data block. + */ + fheaderl = code->entry_points; + while (fheaderl != NIL) { + fheaderp = (struct function *) PTR(fheaderl); + gc_assert(TypeOf(fheaderp->header) == + type_FunctionHeader); + verify_space(&fheaderp->name, 1); + verify_space(&fheaderp->arglist, 1); + verify_space(&fheaderp->type, 1); + fheaderl = fheaderp->next; + } + count = nwords; + break; + } + + /* Unboxed objects */ + case type_Bignum: + case type_SingleFloat: + case type_DoubleFloat: #ifdef type_ComplexLongFloat - case type_LongFloat: + case type_LongFloat: #endif #ifdef type_ComplexSingleFloat - case type_ComplexSingleFloat: + case type_ComplexSingleFloat: #endif #ifdef type_ComplexDoubleFloat - case type_ComplexDoubleFloat: + case type_ComplexDoubleFloat: #endif #ifdef type_ComplexLongFloat - case type_ComplexLongFloat: -#endif - case type_SimpleString: - case type_SimpleBitVector: - case type_SimpleArrayUnsignedByte2: - case type_SimpleArrayUnsignedByte4: - case type_SimpleArrayUnsignedByte8: - case type_SimpleArrayUnsignedByte16: - case type_SimpleArrayUnsignedByte32: + case type_ComplexLongFloat: +#endif + case type_SimpleString: + case type_SimpleBitVector: + case type_SimpleArrayUnsignedByte2: + case type_SimpleArrayUnsignedByte4: + case type_SimpleArrayUnsignedByte8: + case type_SimpleArrayUnsignedByte16: + case type_SimpleArrayUnsignedByte32: #ifdef type_SimpleArraySignedByte8 - case type_SimpleArraySignedByte8: + case type_SimpleArraySignedByte8: #endif #ifdef type_SimpleArraySignedByte16 - case type_SimpleArraySignedByte16: + case type_SimpleArraySignedByte16: #endif #ifdef type_SimpleArraySignedByte30 - case type_SimpleArraySignedByte30: + case type_SimpleArraySignedByte30: #endif #ifdef type_SimpleArraySignedByte32 - case type_SimpleArraySignedByte32: + case type_SimpleArraySignedByte32: #endif - case type_SimpleArraySingleFloat: - case type_SimpleArrayDoubleFloat: + case type_SimpleArraySingleFloat: + case type_SimpleArrayDoubleFloat: #ifdef type_SimpleArrayComplexLongFloat - case type_SimpleArrayLongFloat: + case type_SimpleArrayLongFloat: #endif #ifdef type_SimpleArrayComplexSingleFloat - case type_SimpleArrayComplexSingleFloat: + case type_SimpleArrayComplexSingleFloat: #endif #ifdef type_SimpleArrayComplexDoubleFloat - case type_SimpleArrayComplexDoubleFloat: + case type_SimpleArrayComplexDoubleFloat: #endif #ifdef type_SimpleArrayComplexLongFloat - case type_SimpleArrayComplexLongFloat: + case type_SimpleArrayComplexLongFloat: #endif - case type_Sap: - case type_WeakPointer: - count = (sizetab[TypeOf(*start)])(start); - break; + case type_Sap: + case type_WeakPointer: + count = (sizetab[TypeOf(*start)]) (start); + break; - default: - gc_abort(); - } - start += count; - words -= count; - } + default: + gc_abort(); + } + start += count; + words -= count; + } } -static void verify_gc(void) +static void +verify_gc(void) { - int read_only_space_size = - (lispobj*) SymbolValue(READ_ONLY_SPACE_FREE_POINTER) - - (lispobj*) READ_ONLY_SPACE_START; - int static_space_size = - (lispobj*) SymbolValue(STATIC_SPACE_FREE_POINTER) - - (lispobj*) static_space; - int binding_stack_size = - (lispobj*) get_binding_stack_pointer() - - (lispobj*) BINDING_STACK_START; + int read_only_space_size = + (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER) - verify_space((lispobj*) READ_ONLY_SPACE_START, read_only_space_size); - verify_space((lispobj*) static_space, static_space_size); - verify_space((lispobj*) BINDING_STACK_START, binding_stack_size); - verify_space((lispobj*) &scavenger_hooks, 1); + - (lispobj *) READ_ONLY_SPACE_START; + int static_space_size = (lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER) + - (lispobj *) static_space; + int binding_stack_size = (lispobj *) get_binding_stack_pointer() + - (lispobj *) BINDING_STACK_START; + + verify_space((lispobj *) READ_ONLY_SPACE_START, read_only_space_size); + verify_space((lispobj *) static_space, static_space_size); + verify_space((lispobj *) BINDING_STACK_START, binding_stack_size); + verify_space((lispobj *) & scavenger_hooks, 1); } -static void verify_generation(int generation) +static void +verify_generation(int generation) { - int i; - - for (i = 0; i < last_free_page; i++) { - if (PAGE_ALLOCATED(i) - && page_table[i].bytes_used != 0 - && PAGE_GENERATION(i) == generation) { - int last_page; - int region_unboxed = PAGE_UNBOXED(i); + int i; - /* This should be the start of a contiguous block */ - gc_assert(page_table[i].first_object_offset == 0); + for (i = 0; i < last_free_page; i++) { + if (PAGE_ALLOCATED(i) + && page_table[i].bytes_used != 0 + && PAGE_GENERATION(i) == generation) { + int last_page; + int region_unboxed = PAGE_UNBOXED(i); - /* - * Need to find the full extent of this contiguous block in case - * objects span pages. - */ + /* This should be the start of a contiguous block */ + gc_assert(page_table[i].first_object_offset == 0); - /* - * Now work forward until the end of this contiguous area is - * found. - */ - for (last_page = i; ; last_page++) - /* Check if this is the last page in this contiguous block */ - if (page_table[last_page].bytes_used < PAGE_SIZE - /* Or it is PAGE_SIZE and is the last in the block */ - || !PAGE_ALLOCATED(last_page + 1) - || PAGE_UNBOXED(last_page + 1) != region_unboxed - || page_table[last_page + 1].bytes_used == 0 - || PAGE_GENERATION(last_page + 1) != generation - || page_table[last_page + 1].first_object_offset == 0) - break; + /* + * Need to find the full extent of this contiguous block in case + * objects span pages. + */ - verify_space((lispobj*) page_address(i), - (page_table[last_page].bytes_used + - PAGE_SIZE * (last_page - i)) / sizeof(lispobj)); - i = last_page; + /* + * Now work forward until the end of this contiguous area is + * found. + */ + for (last_page = i;; last_page++) + /* Check if this is the last page in this contiguous block */ + if (page_table[last_page].bytes_used < PAGE_SIZE + /* Or it is PAGE_SIZE and is the last in the block */ + || !PAGE_ALLOCATED(last_page + 1) + || PAGE_UNBOXED(last_page + 1) != region_unboxed + || page_table[last_page + 1].bytes_used == 0 + || PAGE_GENERATION(last_page + 1) != generation + || page_table[last_page + 1].first_object_offset == 0) + break; + + verify_space((lispobj *) page_address(i), + (page_table[last_page].bytes_used + + PAGE_SIZE * (last_page - i)) / sizeof(lispobj)); + i = last_page; + } } - } } /* Check the all the free space is zero filled. */ -static void verify_zero_fill(void) -{ - int page; - - for (page = 0; page < last_free_page; page++) { - if (!PAGE_ALLOCATED(page)) { - /* The whole page should be zero filled. */ - int *start_addr = (int *) page_address(page); - int size = 1024; - int i; - for(i = 0; i < size; i++) - if (start_addr[i] != 0) - fprintf(stderr, "** free page not zero @ %lx\n", - (unsigned long) (start_addr + i)); - } else { - int free_bytes = PAGE_SIZE - page_table[page].bytes_used; - if (free_bytes > 0) { - unsigned long *start_addr = (unsigned long *) ((unsigned long) page_address(page) - + page_table[page].bytes_used); - int size = free_bytes / sizeof(lispobj); - int i; - for(i = 0; i < size; i++) - if (start_addr[i] != 0) - fprintf(stderr, "** free region not zero @ %lx\n", - (unsigned long) (start_addr + i)); - } +static void +verify_zero_fill(void) +{ + int page; + + for (page = 0; page < last_free_page; page++) { + if (!PAGE_ALLOCATED(page)) { + /* The whole page should be zero filled. */ + int *start_addr = (int *) page_address(page); + int size = 1024; + int i; + + for (i = 0; i < size; i++) + if (start_addr[i] != 0) + fprintf(stderr, "** free page not zero @ %lx\n", + (unsigned long) (start_addr + i)); + } else { + int free_bytes = PAGE_SIZE - page_table[page].bytes_used; + + if (free_bytes > 0) { + unsigned long *start_addr = + (unsigned long *) ((unsigned long) page_address(page) + + page_table[page].bytes_used); + int size = free_bytes / sizeof(lispobj); + int i; + + for (i = 0; i < size; i++) + if (start_addr[i] != 0) + fprintf(stderr, "** free region not zero @ %lx\n", + (unsigned long) (start_addr + i)); + } + } } - } } /* External entry point for verify_zero_fill */ -void gencgc_verify_zero_fill(void) +void +gencgc_verify_zero_fill(void) { - /* Flush the alloc regions updating the tables. */ - - boxed_region.free_pointer = (void *) get_current_region_free(); - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); - fprintf(stderr, "* Verifying zero fill\n"); - verify_zero_fill(); - set_current_region_free((lispobj)boxed_region.free_pointer); - set_current_region_end((lispobj)boxed_region.end_addr); + /* Flush the alloc regions updating the tables. */ + + boxed_region.free_pointer = (void *) get_current_region_free(); + gc_alloc_update_page_tables(0, &boxed_region); + gc_alloc_update_page_tables(1, &unboxed_region); + fprintf(stderr, "* Verifying zero fill\n"); + verify_zero_fill(); + set_current_region_free((lispobj) boxed_region.free_pointer); + set_current_region_end((lispobj) boxed_region.end_addr); } -static void verify_dynamic_space(void) +static void +verify_dynamic_space(void) { - int i; + int i; - for (i = 0; i < NUM_GENERATIONS; i++) - verify_generation(i); + for (i = 0; i < NUM_GENERATIONS; i++) + verify_generation(i); - if (gencgc_enable_verify_zero_fill) - verify_zero_fill(); + if (gencgc_enable_verify_zero_fill) + verify_zero_fill(); } - + /* * Write protect all the dynamic boxed pages in the given * generation. */ -static void write_protect_generation_pages(int generation) +static void +write_protect_generation_pages(int generation) { - int i; + int i; - gc_assert(generation < NUM_GENERATIONS); + gc_assert(generation < NUM_GENERATIONS); - for (i = 0; i < last_free_page; i++) - if (PAGE_ALLOCATED(i) && !PAGE_UNBOXED(i) - && page_table[i].bytes_used != 0 - && PAGE_GENERATION(i) == generation) { - void *page_start; + for (i = 0; i < last_free_page; i++) + if (PAGE_ALLOCATED(i) && !PAGE_UNBOXED(i) + && page_table[i].bytes_used != 0 + && PAGE_GENERATION(i) == generation) { + void *page_start; - page_start = (void *) page_address(i); + page_start = (void *) page_address(i); - os_protect((os_vm_address_t) page_start, PAGE_SIZE, OS_VM_PROT_READ | OS_VM_PROT_EXECUTE); + os_protect((os_vm_address_t) page_start, PAGE_SIZE, + OS_VM_PROT_READ | OS_VM_PROT_EXECUTE); - /* Note the page as protected in the page tables */ - page_table[i].flags |= PAGE_WRITE_PROTECTED_MASK; - } + /* Note the page as protected in the page tables */ + page_table[i].flags |= PAGE_WRITE_PROTECTED_MASK; + } - if (gencgc_verbose > 1) - fprintf(stderr, "Write protected %d of %d pages in generation %d.\n", - count_write_protect_generation_pages(generation), - count_generation_pages(generation), - generation); + if (gencgc_verbose > 1) + fprintf(stderr, "Write protected %d of %d pages in generation %d.\n", + count_write_protect_generation_pages(generation), + count_generation_pages(generation), generation); } static void scavenge_interrupt_handlers(void) { - int i; - + int i; + #ifdef PRINTNOISE - printf("Scavenging interrupt handlers (%d bytes) ...\n", - sizeof(interrupt_handlers)); + printf("Scavenging interrupt handlers (%d bytes) ...\n", + sizeof(interrupt_handlers)); #endif - for (i = 0; i < NSIG; i++) - { - union interrupt_handler handler = interrupt_handlers[i]; - if (handler.c != (void (*) (HANDLER_ARGS)) SIG_IGN - && handler.c != (void (*) (HANDLER_ARGS)) SIG_DFL) - scavenge((interrupt_handlers + i), 1); + for (i = 0; i < NSIG; i++) { + union interrupt_handler handler = interrupt_handlers[i]; + + if (handler.c != (void (*)(HANDLER_ARGS)) SIG_IGN + && handler.c != (void (*)(HANDLER_ARGS)) SIG_DFL) + scavenge((interrupt_handlers + i), 1); } } @@ -6118,12 +6376,12 @@ static void scavenge_control_stack() { unsigned long control_stack_size; - + control_stack_size = current_control_stack_pointer - control_stack; #ifdef PRINTNOISE printf("Scavenging the control stack (%d bytes) ...\n", - control_stack_size * sizeof(lispobj)); + control_stack_size * sizeof(lispobj)); #endif scavenge(control_stack, control_stack_size); @@ -6139,262 +6397,273 @@ scavenge_control_stack() * generation are not raised to the next generation. */ static void -garbage_collect_generation (int generation, int raise) +garbage_collect_generation(int generation, int raise) { - unsigned long i; - unsigned long read_only_space_size, static_space_size; + unsigned long i; + unsigned long read_only_space_size, static_space_size; #ifdef GC_ASSERTIONS #if defined(i386) || defined(__x86_64) - invalid_stack_start = (void *) CONTROL_STACK_START; - invalid_stack_end = (void *) &raise; + invalid_stack_start = (void *) CONTROL_STACK_START; + invalid_stack_end = (void *) &raise; #else /* not i386 */ - invalid_stack_start = (void *) &raise; - invalid_stack_end = (void *) CONTROL_STACK_END; + invalid_stack_start = (void *) &raise; + invalid_stack_end = (void *) CONTROL_STACK_END; #endif /* not i386 */ #endif /* GC_ASSERTIONS */ - gc_assert(generation <= NUM_GENERATIONS - 1); - - /* The oldest generation can't be raised. */ - gc_assert(generation != NUM_GENERATIONS - 1 || raise == 0); - - /* Initialise the weak pointer list. */ - weak_pointers = NULL; - weak_hash_tables = NIL; - - /* - * When a generation is not being raised it is transported to a - * temporary generation (NUM_GENERATIONS), and lowered when - * done. Setup this new generation. There should be no pages - * allocated to it yet. - */ - if (!raise) - gc_assert(generations[NUM_GENERATIONS].bytes_allocated == 0); - - /* Set the global src and dest. generations */ - from_space = generation; - if (raise) - new_space = generation + 1; - else - new_space = NUM_GENERATIONS; - - /* - * Change to a new space for allocation, reseting the alloc_start_page. - */ - - gc_alloc_generation = new_space; - generations[new_space].alloc_start_page = 0; - generations[new_space].alloc_unboxed_start_page = 0; - generations[new_space].alloc_large_start_page = 0; - generations[new_space].alloc_large_unboxed_start_page = 0; - - /* - * Before any pointers are preserved, the dont_move flags on the - * pages need to be cleared. - */ - for (i = 0; i < last_free_page; i++) - page_table[i].flags &= ~PAGE_DONT_MOVE_MASK; - - /* - * Un-write-protect the old-space pages. This is essential for the - * promoted pages as they may contain pointers into the old-space - * which need to be scavenged. It also helps avoid unnecessary page - * faults as forwarding pointer are written into them. They need to - * be un-protected anyway before unmapping later. - */ - unprotect_oldspace(); + gc_assert(generation <= NUM_GENERATIONS - 1); + + /* The oldest generation can't be raised. */ + gc_assert(generation != NUM_GENERATIONS - 1 || raise == 0); + + /* Initialise the weak pointer list. */ + weak_pointers = NULL; + weak_hash_tables = NIL; + + /* + * When a generation is not being raised it is transported to a + * temporary generation (NUM_GENERATIONS), and lowered when + * done. Setup this new generation. There should be no pages + * allocated to it yet. + */ + if (!raise) + gc_assert(generations[NUM_GENERATIONS].bytes_allocated == 0); + + /* Set the global src and dest. generations */ + from_space = generation; + if (raise) + new_space = generation + 1; + else + new_space = NUM_GENERATIONS; + + /* + * Change to a new space for allocation, reseting the alloc_start_page. + */ + + gc_alloc_generation = new_space; + generations[new_space].alloc_start_page = 0; + generations[new_space].alloc_unboxed_start_page = 0; + generations[new_space].alloc_large_start_page = 0; + generations[new_space].alloc_large_unboxed_start_page = 0; + + /* + * Before any pointers are preserved, the dont_move flags on the + * pages need to be cleared. + */ + for (i = 0; i < last_free_page; i++) + page_table[i].flags &= ~PAGE_DONT_MOVE_MASK; + + /* + * Un-write-protect the old-space pages. This is essential for the + * promoted pages as they may contain pointers into the old-space + * which need to be scavenged. It also helps avoid unnecessary page + * faults as forwarding pointer are written into them. They need to + * be un-protected anyway before unmapping later. + */ + unprotect_oldspace(); #if defined(i386) || defined(__x86_64) - /* Scavenge the stacks conservative roots. */ - { - lispobj **ptr; - for (ptr = (lispobj **) CONTROL_STACK_END - 1; - ptr > (lispobj **) &raise; ptr--) - preserve_pointer(*ptr); - } -#endif - + /* Scavenge the stacks conservative roots. */ + { + lispobj **ptr; + + for (ptr = (lispobj **) CONTROL_STACK_END - 1; + ptr > (lispobj **) & raise; ptr--) + preserve_pointer(*ptr); + } +#endif + #ifdef CONTROL_STACKS - scavenge_thread_stacks(); + scavenge_thread_stacks(); #endif - if (gencgc_verbose > 1) { - int num_dont_move_pages = count_dont_move_pages(); - fprintf(stderr, "Non-movable pages due to conservative pointers = %d, %d bytes\n", - num_dont_move_pages, PAGE_SIZE * num_dont_move_pages); + if (gencgc_verbose > 1) { + int num_dont_move_pages = count_dont_move_pages(); + + fprintf(stderr, + "Non-movable pages due to conservative pointers = %d, %d bytes\n", + num_dont_move_pages, PAGE_SIZE * num_dont_move_pages); #if !(defined(i386) || defined(__x86_64)) - /* - * There shouldn't be any non-movable pages because we don't have - * any conservative pointers! - */ - gc_assert(num_dont_move_pages == 0); -#endif - } + /* + * There shouldn't be any non-movable pages because we don't have + * any conservative pointers! + */ + gc_assert(num_dont_move_pages == 0); +#endif + } - /* Scavenge all the rest of the roots. */ + /* Scavenge all the rest of the roots. */ - /* - * Scavenge the Lisp functions of the interrupt handlers, taking - * care to avoid SIG_DFL, SIG_IGN. - */ + /* + * Scavenge the Lisp functions of the interrupt handlers, taking + * care to avoid SIG_DFL, SIG_IGN. + */ #if !(defined(i386) || defined(__x86_64)) - /* - * If not x86, we need to scavenge the interrupt context(s) and the - * control stack. - */ - scavenge_interrupt_contexts(); - scavenge_control_stack(); + /* + * If not x86, we need to scavenge the interrupt context(s) and the + * control stack. + */ + scavenge_interrupt_contexts(); + scavenge_control_stack(); #endif - scavenge_interrupt_handlers(); - + scavenge_interrupt_handlers(); + #ifdef PRINTNOISE - printf("Scavenging the binding stack (%d bytes) ...\n", - ((lispobj *) get_binding_stack_pointer() - binding_stack) * sizeof(lispobj)); + printf("Scavenging the binding stack (%d bytes) ...\n", + ((lispobj *) get_binding_stack_pointer() - + binding_stack) * sizeof(lispobj)); #endif - /* Scavenge the binding stack. */ - scavenge(binding_stack, - (lispobj *) get_binding_stack_pointer() - binding_stack); + /* Scavenge the binding stack. */ + scavenge(binding_stack, + (lispobj *) get_binding_stack_pointer() - binding_stack); #ifdef PRINTNOISE - printf("Done scavenging the binding stack.\n"); + printf("Done scavenging the binding stack.\n"); #endif - /* - * Scavenge the scavenge_hooks in case this refers to a hook added - * in a prior generation GC. From here on the scavenger_hook will - * only be updated with hooks already scavenged so this only needs - * doing here. - */ + /* + * Scavenge the scavenge_hooks in case this refers to a hook added + * in a prior generation GC. From here on the scavenger_hook will + * only be updated with hooks already scavenged so this only needs + * doing here. + */ #ifdef PRINTNOISE - printf("Scavenging the scavenger hooks ...\n"); + printf("Scavenging the scavenger hooks ...\n"); #endif - scavenge(&scavenger_hooks, 1); + scavenge(&scavenger_hooks, 1); #ifdef PRINTNOISE - printf("Done scavenging the scavenger hooks.\n"); -#endif - - if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) { - read_only_space_size = (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER) - - read_only_space; - fprintf(stderr, "Scavenge read only space: %ld bytes\n", - read_only_space_size * sizeof(lispobj)); - scavenge(read_only_space, read_only_space_size); - } - - static_space_size = (lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER) - - static_space; - if (gencgc_verbose > 1) - fprintf(stderr, "Scavenge static space: %ld bytes\n", - static_space_size * sizeof(lispobj)); - scavenge(static_space, static_space_size); - - /* - * All generations but the generation being GCed need to be - * scavenged. The new_space generation needs special handling as - * objects may be moved in - it is handle separately below. - */ - for (i = 0; i < NUM_GENERATIONS; i++) - if (i != generation && i != new_space) - scavenge_generation(i); - - /* - * Finally scavenge the new_space generation. Keep going until no - * more objects are moved into the new generation. - */ - scavenge_newspace_generation(new_space); + printf("Done scavenging the scavenger hooks.\n"); +#endif + + if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) { + read_only_space_size = + (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER) - + read_only_space; + fprintf(stderr, "Scavenge read only space: %ld bytes\n", + read_only_space_size * sizeof(lispobj)); + scavenge(read_only_space, read_only_space_size); + } + + static_space_size = (lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER) + - static_space; + if (gencgc_verbose > 1) + fprintf(stderr, "Scavenge static space: %ld bytes\n", + static_space_size * sizeof(lispobj)); + scavenge(static_space, static_space_size); + + /* + * All generations but the generation being GCed need to be + * scavenged. The new_space generation needs special handling as + * objects may be moved in - it is handle separately below. + */ + for (i = 0; i < NUM_GENERATIONS; i++) + if (i != generation && i != new_space) + scavenge_generation(i); + + /* + * Finally scavenge the new_space generation. Keep going until no + * more objects are moved into the new generation. + */ + scavenge_newspace_generation(new_space); #define RESCAN_CHECK 0 -#if RESCAN_CHECK - /* - * As a check re-scavenge the newspace once; no new objects should - * be found. - */ - { - int old_bytes_allocated = bytes_allocated; - int bytes_allocated_diff; +#if RESCAN_CHECK + /* + * As a check re-scavenge the newspace once; no new objects should + * be found. + */ + { + int old_bytes_allocated = bytes_allocated; + int bytes_allocated_diff; - /* Start with a full scavenge */ - scavenge_newspace_generation_one_scan(new_space); + /* Start with a full scavenge */ + scavenge_newspace_generation_one_scan(new_space); - scavenge(&scavenger_hooks, 1); + scavenge(&scavenger_hooks, 1); + + /* Flush the current regions, updating the tables. */ + gc_alloc_update_page_tables(0, &boxed_region); + gc_alloc_update_page_tables(1, &unboxed_region); + + bytes_allocated_diff = bytes_allocated - old_bytes_allocated; + + if (bytes_allocated_diff != 0) + fprintf(stderr, + "*** rescan of new_space allocated %d more bytes? (%ld vs %ld)\n", + bytes_allocated_diff, old_bytes_allocated, bytes_allocated); + } +#endif + + scan_weak_pointers(); + scan_weak_tables(); /* Flush the current regions, updating the tables. */ gc_alloc_update_page_tables(0, &boxed_region); gc_alloc_update_page_tables(1, &unboxed_region); - bytes_allocated_diff = bytes_allocated - old_bytes_allocated; + /* Free the pages in oldspace, but not those marked dont_move. */ + free_oldspace(); - if (bytes_allocated_diff != 0) - fprintf(stderr, "*** rescan of new_space allocated %d more bytes? (%ld vs %ld)\n", - bytes_allocated_diff, old_bytes_allocated, bytes_allocated); - } -#endif + /* + * If the GC is not raising the age then lower the generation back + * to its normal generation number. + */ + if (!raise) { + for (i = 0; i < last_free_page; i++) + if (page_table[i].bytes_used != 0 + && PAGE_GENERATION(i) == NUM_GENERATIONS) + PAGE_FLAGS_UPDATE(i, PAGE_GENERATION_MASK, generation); + gc_assert(generations[generation].bytes_allocated == 0); + generations[generation].bytes_allocated = + generations[NUM_GENERATIONS].bytes_allocated; + generations[NUM_GENERATIONS].bytes_allocated = 0; + } - scan_weak_pointers(); - scan_weak_tables(); + /* Reset the alloc_start_page for generation. */ + generations[generation].alloc_start_page = 0; + generations[generation].alloc_unboxed_start_page = 0; + generations[generation].alloc_large_start_page = 0; + generations[generation].alloc_large_unboxed_start_page = 0; + + if (generation >= verify_gens) { + if (gencgc_verbose) + fprintf(stderr, "Checking\n"); + verify_gc(); + verify_dynamic_space(); + } - /* Flush the current regions, updating the tables. */ - gc_alloc_update_page_tables(0, &boxed_region); - gc_alloc_update_page_tables(1, &unboxed_region); + /* Set the new gc trigger for the GCed generation */ + generations[generation].gc_trigger = + generations[generation].bytes_allocated + + generations[generation].bytes_consed_between_gc; - /* Free the pages in oldspace, but not those marked dont_move. */ - free_oldspace(); - /* - * If the GC is not raising the age then lower the generation back - * to its normal generation number. - */ - if (!raise) { - for (i = 0; i < last_free_page; i++) - if (page_table[i].bytes_used != 0 - && PAGE_GENERATION(i) == NUM_GENERATIONS) - PAGE_FLAGS_UPDATE(i, PAGE_GENERATION_MASK, generation); - gc_assert(generations[generation].bytes_allocated == 0); - generations[generation].bytes_allocated = generations[NUM_GENERATIONS].bytes_allocated; - generations[NUM_GENERATIONS].bytes_allocated = 0; - } - - /* Reset the alloc_start_page for generation. */ - generations[generation].alloc_start_page = 0; - generations[generation].alloc_unboxed_start_page = 0; - generations[generation].alloc_large_start_page = 0; - generations[generation].alloc_large_unboxed_start_page = 0; - - if(generation >= verify_gens) { - if (gencgc_verbose) - fprintf(stderr, "Checking\n"); - verify_gc(); - verify_dynamic_space(); - } - - /* Set the new gc trigger for the GCed generation */ - generations[generation].gc_trigger = generations[generation].bytes_allocated + generations[generation].bytes_consed_between_gc; - - - /* If the generation was raised clear num_gc */ - if (raise) - generations[generation].num_gc = 0; - else - /* Else increase it. */ - generations[generation].num_gc++; + /* If the generation was raised clear num_gc */ + if (raise) + generations[generation].num_gc = 0; + else + /* Else increase it. */ + generations[generation].num_gc++; } /* Update last_free_page then ALLOCATION_POINTER */ -void update_dynamic_space_free_pointer(void) +void +update_dynamic_space_free_pointer(void) { - int last_page = -1; - int i; + int last_page = -1; + int i; - for (i = 0; i < dynamic_space_pages; i++) - if (PAGE_ALLOCATED(i) && page_table[i].bytes_used != 0) - last_page = i; + for (i = 0; i < dynamic_space_pages; i++) + if (PAGE_ALLOCATED(i) && page_table[i].bytes_used != 0) + last_page = i; - last_free_page = last_page + 1; + last_free_page = last_page + 1; - set_alloc_pointer((lispobj) ((char *) heap_base + PAGE_SIZE * last_free_page)); + set_alloc_pointer((lispobj) + ((char *) heap_base + PAGE_SIZE * last_free_page)); } @@ -6408,147 +6677,154 @@ void update_dynamic_space_free_pointer(void) * The oldest generation to be GCed will always be * gencgc_oldest_gen_to_gc, partly ignoring last_gen if necessary. */ -void collect_garbage(unsigned last_gen) -{ - int gen = 0; - int raise; - int gen_to_wp; - int i; - - boxed_region.free_pointer = (void *) get_current_region_free(); - - /* Check last_gen */ - if (last_gen > NUM_GENERATIONS) { - fprintf(stderr, "** collect_garbage: last_gen = %d. Doing a level 0 GC.\n", - last_gen); - last_gen = 0; - } - - /* Flush the alloc regions updating the tables. */ - gc_alloc_update_page_tables(0,&boxed_region); - gc_alloc_update_page_tables(1,&unboxed_region); - - /* Verify the new objects created by lisp code. */ - if (pre_verify_gen_0) { - fprintf(stderr, "Pre-Checking generation 0\n"); - verify_generation(0); - } - - if (gencgc_verbose > 1) - print_generation_stats(0); - - scavenger_hooks = (struct scavenger_hook *) NIL; - - do { - /* Collect the generation */ - - /* Never raise the oldest generation. */ - if (gen >= gencgc_oldest_gen_to_gc) - raise = 0; - else - /* Raise if: gen < last_gen */ - if (gen < last_gen) - raise = 1; - else - /* Only raise if the age is >= the trigger age. */ +void +collect_garbage(unsigned last_gen) +{ + int gen = 0; + int raise; + int gen_to_wp; + int i; + + boxed_region.free_pointer = (void *) get_current_region_free(); + + /* Check last_gen */ + if (last_gen > NUM_GENERATIONS) { + fprintf(stderr, + "** collect_garbage: last_gen = %d. Doing a level 0 GC.\n", + last_gen); + last_gen = 0; + } + + /* Flush the alloc regions updating the tables. */ + gc_alloc_update_page_tables(0, &boxed_region); + gc_alloc_update_page_tables(1, &unboxed_region); + + /* Verify the new objects created by lisp code. */ + if (pre_verify_gen_0) { + fprintf(stderr, "Pre-Checking generation 0\n"); + verify_generation(0); + } + + if (gencgc_verbose > 1) + print_generation_stats(0); + + scavenger_hooks = (struct scavenger_hook *) NIL; + + do { + /* Collect the generation */ + + /* Never raise the oldest generation. */ + if (gen >= gencgc_oldest_gen_to_gc) + raise = 0; + else + /* Raise if: gen < last_gen */ + if (gen < last_gen) + raise = 1; + else + /* Only raise if the age is >= the trigger age. */ if (generations[gen].num_gc >= generations[gen].trigger_age) - raise = 1; + raise = 1; else - raise = 0; + raise = 0; - if (gencgc_verbose > 1) - fprintf(stderr, "Starting GC of generation %d with raise=%d alloc=%d trig=%d GCs=%d\n", - gen, - raise, - generations[gen].bytes_allocated, - generations[gen].gc_trigger, - generations[gen].num_gc); + if (gencgc_verbose > 1) + fprintf(stderr, + "Starting GC of generation %d with raise=%d alloc=%d trig=%d GCs=%d\n", + gen, raise, generations[gen].bytes_allocated, + generations[gen].gc_trigger, generations[gen].num_gc); - /* - * If an older generation is being filled then update its memory age. - */ - if (raise == 1) - generations[gen + 1].cum_sum_bytes_allocated += generations[gen + 1].bytes_allocated; + /* + * If an older generation is being filled then update its memory age. + */ + if (raise == 1) + generations[gen + 1].cum_sum_bytes_allocated += + generations[gen + 1].bytes_allocated; - garbage_collect_generation(gen,raise); + garbage_collect_generation(gen, raise); - /* Reset the memory age cum_sum */ - generations[gen].cum_sum_bytes_allocated = 0; + /* Reset the memory age cum_sum */ + generations[gen].cum_sum_bytes_allocated = 0; - if (gencgc_verbose > 1) { - fprintf(stderr, "GC of generation %d finished:\n", gen); - print_generation_stats(0); + if (gencgc_verbose > 1) { + fprintf(stderr, "GC of generation %d finished:\n", gen); + print_generation_stats(0); + } + + gen++; + } + while (gen <= gencgc_oldest_gen_to_gc + && (gen < last_gen + || (gen <= gencgc_oldest_gen_to_gc && raise + && generations[gen].bytes_allocated > + generations[gen].gc_trigger + && gen_av_mem_age(gen) > generations[gen].min_av_mem_age))); + + /* + * Now if gen-1 was raised all generations before gen are empty.If + * it wasn't raised then all generations before gen-1 are empty. + * + * Now objects within this gen's pages cannot pointer to younger + * generations unless they are written to. This can be exploited by + * write protecting the pages of gen; then when younger generations + * are GCed only the page written need scanning. + */ + if (raise) + gen_to_wp = gen; + else + gen_to_wp = gen - 1; + + /* + * Not much point in WPing pages in generation 0 as it is never + * scavenged (except promoted pages). + */ + if (gen_to_wp > 0 && enable_page_protection) { + /* Check that they are all empty */ + for (i = 0; i < gen_to_wp; i++) + if (generations[i].bytes_allocated != 0) + fprintf(stderr, + "*** trying to write prot. gen. %d when gen. %d is not empty\n", + gen_to_wp, i); + + write_protect_generation_pages(gen_to_wp); } - gen++; - } - while (gen <= gencgc_oldest_gen_to_gc - && (gen < last_gen - || (gen <= gencgc_oldest_gen_to_gc && raise - && generations[gen].bytes_allocated > generations[gen].gc_trigger - && gen_av_mem_age(gen) > generations[gen].min_av_mem_age))); - - /* - * Now if gen-1 was raised all generations before gen are empty.If - * it wasn't raised then all generations before gen-1 are empty. - * - * Now objects within this gen's pages cannot pointer to younger - * generations unless they are written to. This can be exploited by - * write protecting the pages of gen; then when younger generations - * are GCed only the page written need scanning. - */ - if (raise) - gen_to_wp = gen; - else - gen_to_wp = gen - 1; - - /* - * Not much point in WPing pages in generation 0 as it is never - * scavenged (except promoted pages). - */ - if (gen_to_wp > 0 && enable_page_protection) { - /* Check that they are all empty */ - for (i = 0; i < gen_to_wp; i++) - if (generations[i].bytes_allocated != 0) - fprintf(stderr, "*** trying to write prot. gen. %d when gen. %d is not empty\n", - gen_to_wp, i); - - write_protect_generation_pages(gen_to_wp); - } - - /* - * Set gc_alloc back to generation 0. The current regions should be - * flushed after the above GCs. - */ - gc_assert(boxed_region.free_pointer - boxed_region.start_addr == 0); - gc_alloc_generation = 0; - - /* Sparc doesn't need this because the dynamic space free pointer is - the same as the current region free pointer, which is updated by - the allocation routines appropriately. */ + /* + * Set gc_alloc back to generation 0. The current regions should be + * flushed after the above GCs. + */ + gc_assert(boxed_region.free_pointer - boxed_region.start_addr == 0); + gc_alloc_generation = 0; + + /* Sparc doesn't need this because the dynamic space free pointer is + the same as the current region free pointer, which is updated by + the allocation routines appropriately. */ #if !defined(sparc) - update_dynamic_space_free_pointer(); -#endif - - set_current_region_free((lispobj) boxed_region.free_pointer); - set_current_region_end((lispobj) boxed_region.end_addr); - - /* Call the scavenger hook functions */ - { - struct scavenger_hook *sh; - for (sh = (struct scavenger_hook *) PTR((unsigned long) scavenger_hooks); - sh != (struct scavenger_hook *) PTR(NIL);) { - struct scavenger_hook *sh_next = (struct scavenger_hook *) PTR((size_t) sh->next); + update_dynamic_space_free_pointer(); +#endif + + set_current_region_free((lispobj) boxed_region.free_pointer); + set_current_region_end((lispobj) boxed_region.end_addr); + + /* Call the scavenger hook functions */ + { + struct scavenger_hook *sh; + + for (sh = + (struct scavenger_hook *) PTR((unsigned long) scavenger_hooks); + sh != (struct scavenger_hook *) PTR(NIL);) { + struct scavenger_hook *sh_next = + (struct scavenger_hook *) PTR((size_t) sh->next); + #if 0 - fprintf(stderr, "Scav hook %x; next %x; calling scav hook fn %x\n", - sh, sh_next, sh->function); + fprintf(stderr, "Scav hook %x; next %x; calling scav hook fn %x\n", + sh, sh_next, sh->function); #endif - funcall0(sh->function); - sh->next = NULL; - sh = sh_next; + funcall0(sh->function); + sh->next = NULL; + sh = sh_next; + } + scavenger_hooks = (struct scavenger_hook *) NIL; } - scavenger_hooks = (struct scavenger_hook *) NIL; - } } @@ -6560,168 +6836,172 @@ void collect_garbage(unsigned last_gen) * and every page is zeroed to be sure. */ -void gc_free_heap(void) -{ - int page; - - if (gencgc_verbose > 1) - fprintf(stderr, "Free heap\n"); - - for (page = 0; page < dynamic_space_pages; page++) - /* Skip Free pages which should already be zero filled. */ - if (PAGE_ALLOCATED(page)) { - char *page_start, *addr; - - /* - * Mark the page free. The other slots are assumed invalid when - * it is unallocated and bytes_used is 0 and it should not be - * write protected - except that the generation is used for the - * current region but it sets that up. - */ - page_table[page].flags &= ~PAGE_ALLOCATED_MASK; - page_table[page].bytes_used = 0; - - /* Zero the page. */ - page_start = (void *) page_address(page); - - /* First remove any write protection */ - os_protect((os_vm_address_t) page_start, PAGE_SIZE, OS_VM_PROT_ALL); - page_table[page].flags &= ~PAGE_WRITE_PROTECTED_MASK; - - os_invalidate((os_vm_address_t) page_start, PAGE_SIZE); - addr = (char *) os_validate((os_vm_address_t) page_start, PAGE_SIZE); - if(addr == NULL || addr != page_start) - fprintf(stderr, "gc_zero: page moved, 0x%08lx ==> 0x%08lx!\n", - (unsigned long) page_start, (unsigned long) addr); - } else if (gencgc_zero_check_during_free_heap && page < 16384) { - int *page_start; - unsigned i; - - /* Double check that the page is zero filled. */ - gc_assert(!PAGE_ALLOCATED(page)); - gc_assert(page_table[page].bytes_used == 0); - - page_start = (int *) page_address(page); - - for(i = 0; i < 1024; i++) - if (page_start[i] != 0) - fprintf(stderr, "** Free region not zero @ %lx\n", - (unsigned long) (page_start + i)); +void +gc_free_heap(void) +{ + int page; + + if (gencgc_verbose > 1) + fprintf(stderr, "Free heap\n"); + + for (page = 0; page < dynamic_space_pages; page++) + /* Skip Free pages which should already be zero filled. */ + if (PAGE_ALLOCATED(page)) { + char *page_start, *addr; + + /* + * Mark the page free. The other slots are assumed invalid when + * it is unallocated and bytes_used is 0 and it should not be + * write protected - except that the generation is used for the + * current region but it sets that up. + */ + page_table[page].flags &= ~PAGE_ALLOCATED_MASK; + page_table[page].bytes_used = 0; + + /* Zero the page. */ + page_start = (void *) page_address(page); + + /* First remove any write protection */ + os_protect((os_vm_address_t) page_start, PAGE_SIZE, OS_VM_PROT_ALL); + page_table[page].flags &= ~PAGE_WRITE_PROTECTED_MASK; + + os_invalidate((os_vm_address_t) page_start, PAGE_SIZE); + addr = + (char *) os_validate((os_vm_address_t) page_start, PAGE_SIZE); + if (addr == NULL || addr != page_start) + fprintf(stderr, "gc_zero: page moved, 0x%08lx ==> 0x%08lx!\n", + (unsigned long) page_start, (unsigned long) addr); + } else if (gencgc_zero_check_during_free_heap && page < 16384) { + int *page_start; + unsigned i; + + /* Double check that the page is zero filled. */ + gc_assert(!PAGE_ALLOCATED(page)); + gc_assert(page_table[page].bytes_used == 0); + + page_start = (int *) page_address(page); + + for (i = 0; i < 1024; i++) + if (page_start[i] != 0) + fprintf(stderr, "** Free region not zero @ %lx\n", + (unsigned long) (page_start + i)); + } + + bytes_allocated = 0; + + /* Initialise the generations. */ + for (page = 0; page < NUM_GENERATIONS; page++) { + generations[page].alloc_start_page = 0; + generations[page].alloc_unboxed_start_page = 0; + generations[page].alloc_large_start_page = 0; + generations[page].alloc_large_unboxed_start_page = 0; + generations[page].bytes_allocated = 0; + generations[page].gc_trigger = 2000000; + generations[page].num_gc = 0; + generations[page].cum_sum_bytes_allocated = 0; } - bytes_allocated = 0; - - /* Initialise the generations. */ - for (page = 0; page < NUM_GENERATIONS; page++) { - generations[page].alloc_start_page = 0; - generations[page].alloc_unboxed_start_page = 0; - generations[page].alloc_large_start_page = 0; - generations[page].alloc_large_unboxed_start_page = 0; - generations[page].bytes_allocated = 0; - generations[page].gc_trigger = 2000000; - generations[page].num_gc = 0; - generations[page].cum_sum_bytes_allocated = 0; - } - - if (gencgc_verbose > 1) - print_generation_stats(0); - - /* Initialise gc_alloc */ - gc_alloc_generation = 0; - boxed_region.first_page = 0; - boxed_region.last_page = -1; - boxed_region.start_addr = page_address(0); - boxed_region.free_pointer = page_address(0); - boxed_region.end_addr = page_address(0); - - unboxed_region.first_page = 0; - unboxed_region.last_page = -1; - unboxed_region.start_addr = page_address(0); - unboxed_region.free_pointer = page_address(0); - unboxed_region.end_addr = page_address(0); - - last_free_page = 0; - - set_alloc_pointer((lispobj) heap_base); - - set_current_region_free((lispobj) boxed_region.free_pointer); - set_current_region_end((lispobj) boxed_region.end_addr); - - if (verify_after_free_heap) { - /* Check if purify has left any bad pointers. */ - if (gencgc_verbose) - fprintf(stderr, "Checking after free_heap.\n"); - verify_gc(); - } + if (gencgc_verbose > 1) + print_generation_stats(0); + + /* Initialise gc_alloc */ + gc_alloc_generation = 0; + boxed_region.first_page = 0; + boxed_region.last_page = -1; + boxed_region.start_addr = page_address(0); + boxed_region.free_pointer = page_address(0); + boxed_region.end_addr = page_address(0); + + unboxed_region.first_page = 0; + unboxed_region.last_page = -1; + unboxed_region.start_addr = page_address(0); + unboxed_region.free_pointer = page_address(0); + unboxed_region.end_addr = page_address(0); + + last_free_page = 0; + + set_alloc_pointer((lispobj) heap_base); + + set_current_region_free((lispobj) boxed_region.free_pointer); + set_current_region_end((lispobj) boxed_region.end_addr); + + if (verify_after_free_heap) { + /* Check if purify has left any bad pointers. */ + if (gencgc_verbose) + fprintf(stderr, "Checking after free_heap.\n"); + verify_gc(); + } } - -void gc_init(void) + +void +gc_init(void) { - int i; + int i; - gc_init_tables(); + gc_init_tables(); - heap_base = (void*) DYNAMIC_0_SPACE_START; + heap_base = (void *) DYNAMIC_0_SPACE_START; - /* The number of pages needed for the dynamic space - rounding up. */ - dynamic_space_pages = (dynamic_space_size + (PAGE_SIZE - 1)) / PAGE_SIZE; + /* The number of pages needed for the dynamic space - rounding up. */ + dynamic_space_pages = (dynamic_space_size + (PAGE_SIZE - 1)) / PAGE_SIZE; - page_table = (struct page *)malloc(dynamic_space_pages*sizeof(struct page)); - if (page_table == NULL) - { - fprintf(stderr, "Unable to allocate page table.\n"); - exit(1); + page_table = + + (struct page *) malloc(dynamic_space_pages * sizeof(struct page)); + if (page_table == NULL) { + fprintf(stderr, "Unable to allocate page table.\n"); + exit(1); + } + + /* Initialise each page structure. */ + + for (i = 0; i < dynamic_space_pages; i++) { + /* Initial all pages as free. */ + page_table[i].flags &= ~PAGE_ALLOCATED_MASK; + page_table[i].bytes_used = 0; + + /* Pages are not write protected at startup. */ + page_table[i].flags &= ~PAGE_WRITE_PROTECTED_MASK; + } + + bytes_allocated = 0; + + /* Initialise the generations. */ + for (i = 0; i < NUM_GENERATIONS; i++) { + generations[i].alloc_start_page = 0; + generations[i].alloc_unboxed_start_page = 0; + generations[i].alloc_large_start_page = 0; + generations[i].alloc_large_unboxed_start_page = 0; + generations[i].bytes_allocated = 0; + generations[i].gc_trigger = 2000000; + generations[i].num_gc = 0; + generations[i].cum_sum_bytes_allocated = 0; + /* The tune-able parameters */ + generations[i].bytes_consed_between_gc = 2000000; + generations[i].trigger_age = 1; + generations[i].min_av_mem_age = 0.75; } - /* Initialise each page structure. */ - - for (i = 0; i < dynamic_space_pages; i++) { - /* Initial all pages as free. */ - page_table[i].flags &= ~PAGE_ALLOCATED_MASK; - page_table[i].bytes_used = 0; - - /* Pages are not write protected at startup. */ - page_table[i].flags &= ~PAGE_WRITE_PROTECTED_MASK; - } - - bytes_allocated = 0; - - /* Initialise the generations. */ - for (i = 0; i < NUM_GENERATIONS; i++) { - generations[i].alloc_start_page = 0; - generations[i].alloc_unboxed_start_page = 0; - generations[i].alloc_large_start_page = 0; - generations[i].alloc_large_unboxed_start_page = 0; - generations[i].bytes_allocated = 0; - generations[i].gc_trigger = 2000000; - generations[i].num_gc = 0; - generations[i].cum_sum_bytes_allocated = 0; - /* The tune-able parameters */ - generations[i].bytes_consed_between_gc = 2000000; - generations[i].trigger_age = 1; - generations[i].min_av_mem_age = 0.75; - } - - /* Initialise gc_alloc */ - gc_alloc_generation = 0; - boxed_region.first_page = 0; - boxed_region.last_page = -1; - boxed_region.start_addr = page_address(0); - boxed_region.free_pointer = page_address(0); - boxed_region.end_addr = page_address(0); - - unboxed_region.first_page = 0; - unboxed_region.last_page = -1; - unboxed_region.start_addr = page_address(0); - unboxed_region.free_pointer = page_address(0); - unboxed_region.end_addr = page_address(0); - - last_free_page = 0; - - set_current_region_free((lispobj) boxed_region.free_pointer); - set_current_region_end((lispobj) boxed_region.end_addr); + /* Initialise gc_alloc */ + gc_alloc_generation = 0; + boxed_region.first_page = 0; + boxed_region.last_page = -1; + boxed_region.start_addr = page_address(0); + boxed_region.free_pointer = page_address(0); + boxed_region.end_addr = page_address(0); + + unboxed_region.first_page = 0; + unboxed_region.last_page = -1; + unboxed_region.start_addr = page_address(0); + unboxed_region.free_pointer = page_address(0); + unboxed_region.end_addr = page_address(0); + + last_free_page = 0; + + set_current_region_free((lispobj) boxed_region.free_pointer); + set_current_region_end((lispobj) boxed_region.end_addr); } /* @@ -6732,34 +7012,35 @@ void gc_init(void) * XX A scan is needed to identify the closest first objects for pages. */ -void gencgc_pickup_dynamic(void) +void +gencgc_pickup_dynamic(void) { - int page = 0; - unsigned long addr = DYNAMIC_0_SPACE_START; - unsigned long alloc_ptr = (unsigned long) get_alloc_pointer(); + int page = 0; + unsigned long addr = DYNAMIC_0_SPACE_START; + unsigned long alloc_ptr = (unsigned long) get_alloc_pointer(); - /* Initialise the first region. */ - do { - page_table[page].flags |= PAGE_ALLOCATED_MASK; - page_table[page].flags &= ~(PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK - | PAGE_LARGE_OBJECT_MASK); - page_table[page].bytes_used = PAGE_SIZE; - page_table[page].first_object_offset = - (char *) DYNAMIC_0_SPACE_START - page_address(page); - addr += PAGE_SIZE; - page++; - } - while (addr < alloc_ptr); + /* Initialise the first region. */ + do { + page_table[page].flags |= PAGE_ALLOCATED_MASK; + page_table[page].flags &= ~(PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK + | PAGE_LARGE_OBJECT_MASK); + page_table[page].bytes_used = PAGE_SIZE; + page_table[page].first_object_offset = + (char *) DYNAMIC_0_SPACE_START - page_address(page); + addr += PAGE_SIZE; + page++; + } + while (addr < alloc_ptr); - generations[0].bytes_allocated = PAGE_SIZE * page; - bytes_allocated = PAGE_SIZE * page; + generations[0].bytes_allocated = PAGE_SIZE * page; + bytes_allocated = PAGE_SIZE * page; - set_current_region_free((lispobj) boxed_region.free_pointer); - set_current_region_end((lispobj) boxed_region.end_addr); + set_current_region_free((lispobj) boxed_region.free_pointer); + set_current_region_end((lispobj) boxed_region.end_addr); } + - /* * Alloc is the external interface for memory allocation. It allocates * to generations0. It is not called from within the garbage @@ -6779,205 +7060,212 @@ void gencgc_pickup_dynamic(void) * while within a pseudo atomic context. */ -void do_pending_interrupt (void); +void do_pending_interrupt(void); char * -alloc (int nbytes) +alloc(int nbytes) { #ifndef sparc - /* - * *current-region-free-pointer* is the same as alloc-tn (= - * current_dynamic_space_free_pointer) and therefore contains the - * pseudo-atomic bits. - */ - gc_assert (((unsigned) get_current_region_free() & lowtag_Mask) == 0); -#endif - gc_assert ((nbytes & lowtag_Mask) == 0); - gc_assert (get_pseudo_atomic_atomic ()); - - bytes_allocated_sum += nbytes; - - for (;;) - { - void *new_obj; - char *new_free_pointer - = (void *) (get_current_region_free() + nbytes); - - if (new_free_pointer <= boxed_region.end_addr) - { - /* Allocate from the current region. */ - new_obj = (void *) get_current_region_free(); - set_current_region_free((lispobj) new_free_pointer); - return new_obj; - } - else if (bytes_allocated <= auto_gc_trigger) - { - /* Call gc_alloc. */ - boxed_region.free_pointer = (void *) get_current_region_free(); - boxed_region.end_addr = (void *) SymbolValue(CURRENT_REGION_END_ADDR); - - new_obj = gc_alloc (nbytes); - set_current_region_free((lispobj) boxed_region.free_pointer); - set_current_region_end((lispobj) boxed_region.end_addr); - return new_obj; - } - else - { - /* Run GC and try again. */ - auto_gc_trigger *= 2; - clr_pseudo_atomic_atomic (); - if (get_pseudo_atomic_interrupted ()) - do_pending_interrupt (); - funcall0 (SymbolFunction (MAYBE_GC)); - clr_pseudo_atomic_interrupted (); - set_pseudo_atomic_atomic (); + /* + * *current-region-free-pointer* is the same as alloc-tn (= + * current_dynamic_space_free_pointer) and therefore contains the + * pseudo-atomic bits. + */ + gc_assert(((unsigned) get_current_region_free() & lowtag_Mask) == 0); +#endif + gc_assert((nbytes & lowtag_Mask) == 0); + gc_assert(get_pseudo_atomic_atomic()); + + bytes_allocated_sum += nbytes; + + for (;;) { + void *new_obj; + char *new_free_pointer = (void *) (get_current_region_free() + nbytes); + + if (new_free_pointer <= boxed_region.end_addr) { + /* Allocate from the current region. */ + new_obj = (void *) get_current_region_free(); + set_current_region_free((lispobj) new_free_pointer); + return new_obj; + } else if (bytes_allocated <= auto_gc_trigger) { + /* Call gc_alloc. */ + boxed_region.free_pointer = (void *) get_current_region_free(); + boxed_region.end_addr = + (void *) SymbolValue(CURRENT_REGION_END_ADDR); + + new_obj = gc_alloc(nbytes); + set_current_region_free((lispobj) boxed_region.free_pointer); + set_current_region_end((lispobj) boxed_region.end_addr); + return new_obj; + } else { + /* Run GC and try again. */ + auto_gc_trigger *= 2; + clr_pseudo_atomic_atomic(); + if (get_pseudo_atomic_interrupted()) + do_pending_interrupt(); + funcall0(SymbolFunction(MAYBE_GC)); + clr_pseudo_atomic_interrupted(); + set_pseudo_atomic_atomic(); } } } char * -alloc_pseudo_atomic (int nbytes) +alloc_pseudo_atomic(int nbytes) { - char *result; - int in_pseudo_atomic; - - in_pseudo_atomic = get_pseudo_atomic_atomic (); - if (!in_pseudo_atomic) - { - clr_pseudo_atomic_interrupted (); - set_pseudo_atomic_atomic (); + char *result; + int in_pseudo_atomic; + + in_pseudo_atomic = get_pseudo_atomic_atomic(); + if (!in_pseudo_atomic) { + clr_pseudo_atomic_interrupted(); + set_pseudo_atomic_atomic(); } - - result = alloc (nbytes); - if (!in_pseudo_atomic) - { - clr_pseudo_atomic_atomic (); - if (get_pseudo_atomic_interrupted ()) - do_pending_interrupt (); + result = alloc(nbytes); + + if (!in_pseudo_atomic) { + clr_pseudo_atomic_atomic(); + if (get_pseudo_atomic_interrupted()) + do_pending_interrupt(); } - - return result; -} + return result; +} + /* Noise to manipulate the gc trigger stuff. */ -void set_auto_gc_trigger(unsigned long dynamic_usage) +void +set_auto_gc_trigger(unsigned long dynamic_usage) { - auto_gc_trigger += dynamic_usage; + auto_gc_trigger += dynamic_usage; } -void clear_auto_gc_trigger(void) +void +clear_auto_gc_trigger(void) { - auto_gc_trigger = 0xffffffff; + auto_gc_trigger = 0xffffffff; } /* Find the code object for the given pc. Return NULL on failure */ -lispobj * component_ptr_from_pc(lispobj *pc) +lispobj * +component_ptr_from_pc(lispobj * pc) { - lispobj *ptr; + lispobj *ptr; - ptr = search_read_only_space(pc); + ptr = search_read_only_space(pc); - if (!ptr) - ptr = search_static_space(pc); + if (!ptr) + ptr = search_static_space(pc); - if (!ptr) - ptr = search_dynamic_space(pc); + if (!ptr) + ptr = search_dynamic_space(pc); - /* Found anything? Check if it is a code object. */ - if (ptr && TypeOf(*ptr) == type_CodeHeader) - return ptr; + /* Found anything? Check if it is a code object. */ + if (ptr && TypeOf(*ptr) == type_CodeHeader) + return ptr; - return NULL; + return NULL; } /* * Get lower and upper(middle) 28 bits of total allocation */ -int get_bytes_consed_lower(void) +int +get_bytes_consed_lower(void) { - return (int)bytes_allocated_sum & 0xFFFFFFF; + return (int) bytes_allocated_sum & 0xFFFFFFF; } -int get_bytes_consed_upper(void) +int +get_bytes_consed_upper(void) { - return ((int)bytes_allocated_sum / 0x10000000) & 0xFFFFFFF; + return ((int) bytes_allocated_sum / 0x10000000) & 0xFFFFFFF; } #define current_region_free_pointer get_current_region_free() #define current_region_end_addr ((void *) SymbolValue(CURRENT_REGION_END_ADDR)) -int get_bytes_allocated_lower(void) +int +get_bytes_allocated_lower(void) { - int size = bytes_allocated; - static int previous = -1; + int size = bytes_allocated; + static int previous = -1; - if (current_region_end_addr != boxed_region.end_addr) { - fprintf(stderr, "NOT BOXED: %lx %lx %lx\n", - (unsigned long) current_region_end_addr, - (unsigned long) boxed_region.end_addr, - (unsigned long) unboxed_region.end_addr); - } + if (current_region_end_addr != boxed_region.end_addr) { + fprintf(stderr, "NOT BOXED: %lx %lx %lx\n", + (unsigned long) current_region_end_addr, + (unsigned long) boxed_region.end_addr, + (unsigned long) unboxed_region.end_addr); + } - if (current_region_end_addr == boxed_region.end_addr) { - size += current_region_free_pointer - (size_t)boxed_region.start_addr; - } else { - size += current_region_free_pointer - (size_t)unboxed_region.start_addr; - } + if (current_region_end_addr == boxed_region.end_addr) { + size += current_region_free_pointer - (size_t) boxed_region.start_addr; + } else { + size += + current_region_free_pointer - (size_t) unboxed_region.start_addr; + } - if (counters_verbose) - fprintf(stderr, ">%10d%10d%10d%10d%10d (max%d @0x%lX)\n", size, - previous != -1 ? size - previous : -1, - (size_t)current_region_free_pointer - (size_t)boxed_region.start_addr, - (size_t)boxed_region.free_pointer - (size_t)boxed_region.start_addr, - (size_t)unboxed_region.free_pointer - (size_t)unboxed_region.start_addr, - (size_t)boxed_region.end_addr - (size_t)boxed_region.start_addr, - (unsigned long) boxed_region.start_addr); + if (counters_verbose) + fprintf(stderr, ">%10d%10d%10d%10d%10d (max%d @0x%lX)\n", size, + previous != -1 ? size - previous : -1, + (size_t) current_region_free_pointer - + (size_t) boxed_region.start_addr, + (size_t) boxed_region.free_pointer - + (size_t) boxed_region.start_addr, + (size_t) unboxed_region.free_pointer - + (size_t) unboxed_region.start_addr, + (size_t) boxed_region.end_addr - + (size_t) boxed_region.start_addr, + (unsigned long) boxed_region.start_addr); - previous = size; + previous = size; - return (int)size & 0xFFFFFFF; + return (int) size & 0xFFFFFFF; } -int get_bytes_allocated_upper(void) +int +get_bytes_allocated_upper(void) { - int size = bytes_allocated; + int size = bytes_allocated; - if ((void *) current_region_end_addr == boxed_region.end_addr) { - size += current_region_free_pointer - (size_t)boxed_region.start_addr; - } else { - size += current_region_free_pointer - (size_t)unboxed_region.start_addr; - } - return ((int)size / 0x10000000) & 0xFFFFFFF; + if ((void *) current_region_end_addr == boxed_region.end_addr) { + size += current_region_free_pointer - (size_t) boxed_region.start_addr; + } else { + size += + current_region_free_pointer - (size_t) unboxed_region.start_addr; + } + return ((int) size / 0x10000000) & 0xFFFFFFF; } -void print_bytes_allocated_sum(void) +void +print_bytes_allocated_sum(void) { #if 0 - int size; - /* - gc_alloc_update_page_tables(0, &); - gc_alloc_update_page_tables(1, &unboxed_region); - */ - - size = bytes_allocated; - - if (current_region_end_addr == boxed_region.end_addr) { - size += current_region_free_pointer - boxed_region.start_addr; - size += unboxed_region.free_pointer - unboxed_region.start_addr; - } else { - size += current_region_free_pointer - unboxed_region.start_addr; - size += boxed_region.free_pointer - boxed_region.start_addr; - } - fprintf(stdout, "manually counted: %10d %10d %10d\n" - , size, size - bytes_allocated, size - bytes_allocated_sum); - - /* - fprintf(stdout, "%llu -> %d / %d\n", bytes_allocated_sum - ,get_bytes_consed_upper(), get_bytes_consed_lower()); - fprintf(stdout, "0x%llX -> 0x%x / 0x%x\n", bytes_allocated_sum - ,get_bytes_consed_upper(), get_bytes_consed_lower()); - */ + int size; + + /* + gc_alloc_update_page_tables(0, &); + gc_alloc_update_page_tables(1, &unboxed_region); + */ + + size = bytes_allocated; + + if (current_region_end_addr == boxed_region.end_addr) { + size += current_region_free_pointer - boxed_region.start_addr; + size += unboxed_region.free_pointer - unboxed_region.start_addr; + } else { + size += current_region_free_pointer - unboxed_region.start_addr; + size += boxed_region.free_pointer - boxed_region.start_addr; + } + fprintf(stdout, "manually counted: %10d %10d %10d\n", size, + size - bytes_allocated, size - bytes_allocated_sum); + + /* + fprintf(stdout, "%llu -> %d / %d\n", bytes_allocated_sum + ,get_bytes_consed_upper(), get_bytes_consed_lower()); + fprintf(stdout, "0x%llX -> 0x%x / 0x%x\n", bytes_allocated_sum + ,get_bytes_consed_upper(), get_bytes_consed_lower()); + */ #endif } diff --git a/lisp/gencgc.h b/lisp/gencgc.h index 84dcaff1d..87028783e 100644 --- a/lisp/gencgc.h +++ b/lisp/gencgc.h @@ -7,19 +7,19 @@ * * Douglas Crosher, 1996, 1997. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.h,v 1.11 2004/07/07 18:07:53 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/gencgc.h,v 1.12 2005/09/15 18:26:51 rtoy Exp $ * */ #ifndef _GENCGC_H_ #define _GENCGC_H_ -void gc_free_heap(void); -inline int find_page_index(void *); -inline char *page_address(int); - +void gc_free_heap(void); +inline int find_page_index(void *); +inline char *page_address(int); + /* * Set when the page is write protected. If it is writen into it is * made writable and this flag is cleared. This should always reflect @@ -95,30 +95,30 @@ inline char *page_address(int); (page_table[page].flags = (page_table[page].flags & ~(mmask)) | (mflags)) struct page { - /* - * Page flags. - */ - - unsigned flags; - - /* - * It is important to know the offset to the first object in the - * page. Currently it's only important to know if an object starts - * at the begining of the page in which case the offset would be 0 - */ - int first_object_offset; - - /* - * The number of bytes of this page that are used. This may be less - * than the actual bytes used for pages within the current - * allocation regions. It should be 0 for all unallocated pages (not - * hard to achieve). - */ - int bytes_used; + /* + * Page flags. + */ + + unsigned flags; + + /* + * It is important to know the offset to the first object in the + * page. Currently it's only important to know if an object starts + * at the begining of the page in which case the offset would be 0 + */ + int first_object_offset; + + /* + * The number of bytes of this page that are used. This may be less + * than the actual bytes used for pages within the current + * allocation regions. It should be 0 for all unallocated pages (not + * hard to achieve). + */ + int bytes_used; }; - + /* * The smallest page size that can be independently allocated and * write protected. @@ -140,40 +140,41 @@ struct page { extern unsigned dynamic_space_pages; extern struct page *page_table; - + /* * Abstract out the data for an allocation region allowing a single * routine to be used for allocation and closing. */ struct alloc_region { - /* These two are needed for quick allocation */ - char *free_pointer; - char *end_addr; /* Pointer to the byte after the last usable byte */ - - /* Needed when closing the region. */ - int first_page; - int last_page; - char *start_addr; + /* These two are needed for quick allocation */ + char *free_pointer; + char *end_addr; /* Pointer to the byte after the last usable byte */ + + /* Needed when closing the region. */ + int first_page; + int last_page; + char *start_addr; }; -extern struct alloc_region boxed_region; -extern struct alloc_region unboxed_region; - +extern struct alloc_region boxed_region; +extern struct alloc_region unboxed_region; -void gencgc_pickup_dynamic(void); + +void gencgc_pickup_dynamic(void); #ifdef i386 void sniff_code_object(struct code *code, unsigned displacement); #endif -lispobj *search_dynamic_space(lispobj *pointer); +lispobj *search_dynamic_space(lispobj * pointer); void update_dynamic_space_free_pointer(void); -lispobj * component_ptr_from_pc(lispobj *pc); +lispobj *component_ptr_from_pc(lispobj * pc); void gc_alloc_update_page_tables(int unboxed, + struct alloc_region *alloc_region); -extern char* alloc(int); +extern char *alloc(int); #endif /* _GENCGC_H_ */ diff --git a/lisp/globals.c b/lisp/globals.c index 018b6d88c..a8f561d99 100644 --- a/lisp/globals.c +++ b/lisp/globals.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/globals.c,v 1.4 2004/05/19 22:24:49 cwang Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/globals.c,v 1.5 2005/09/15 18:26:51 rtoy Rel $ */ /* Variables everybody needs to look at or frob on. */ @@ -12,6 +12,7 @@ int foreign_function_call_active; lispobj *current_control_stack_pointer; lispobj *current_control_frame_pointer; + #ifndef BINDING_STACK_POINTER lispobj *current_binding_stack_pointer; #endif @@ -22,12 +23,14 @@ lispobj *dynamic_0_space; lispobj *dynamic_1_space; unsigned dynamic_space_size; lispobj *control_stack; + #if (defined(i386) || defined(__x86_64)) lispobj *control_stack_end; #endif lispobj *binding_stack; lispobj *current_dynamic_space; + #ifndef ALLOCATION_POINTER lispobj *current_dynamic_space_free_pointer; #endif @@ -35,7 +38,8 @@ lispobj *current_dynamic_space_free_pointer; lispobj *current_auto_gc_trigger; #endif -void globals_init(void) +void +globals_init(void) { /* Space, stack, and free pointer vars are initialized by validate() and coreparse(). */ @@ -55,7 +59,7 @@ void globals_init(void) current_control_stack_pointer = control_stack_end; #endif - current_control_frame_pointer = (lispobj *)0; + current_control_frame_pointer = (lispobj *) 0; #ifndef BINDING_STACK_POINTER current_binding_stack_pointer = binding_stack; #endif diff --git a/lisp/globals.h b/lisp/globals.h index e8fc33127..a7f4b3006 100644 --- a/lisp/globals.h +++ b/lisp/globals.h @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/globals.h,v 1.9 2005/01/13 19:55:00 fgilham Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/globals.h,v 1.10 2005/09/15 18:26:51 rtoy Exp $ */ #ifndef _GLOBALS_H_ #define _GLOBALS_H_ @@ -11,6 +11,7 @@ extern int foreign_function_call_active; extern lispobj *current_control_stack_pointer; extern lispobj *current_control_frame_pointer; + #if !defined(ibmrt) && !defined(i386) extern lispobj *current_binding_stack_pointer; #endif @@ -22,10 +23,12 @@ extern lispobj *dynamic_1_space; extern unsigned dynamic_space_size; extern lispobj *control_stack; extern lispobj *binding_stack; + #if (defined(i386) || defined(__x86_64)) extern lispobj *control_stack_end; #endif extern lispobj *current_dynamic_space; + #if !defined(ibmrt) && !defined(i386) extern lispobj *current_dynamic_space_free_pointer; extern lispobj *current_auto_gc_trigger; @@ -33,7 +36,7 @@ extern lispobj *current_auto_gc_trigger; extern void globals_init(void); -#else /* LANGUAGE_ASSEMBLY */ +#else /* LANGUAGE_ASSEMBLY */ /* These are needed by ./assem.s */ @@ -68,17 +71,14 @@ extern void globals_init(void); EXTERN(foreign_function_call_active, 4) -EXTERN(current_control_stack_pointer, 4) -EXTERN(current_control_frame_pointer, 4) + EXTERN(current_control_stack_pointer, 4) + EXTERN(current_control_frame_pointer, 4) #if !defined(ibmrt) && !defined(i386) -EXTERN(current_binding_stack_pointer, 4) -EXTERN(current_dynamic_space_free_pointer, 4) + EXTERN(current_binding_stack_pointer, 4) + EXTERN(current_dynamic_space_free_pointer, 4) #endif - #ifdef mips -EXTERN(current_flags_register, 4) + EXTERN(current_flags_register, 4) #endif - #endif /* LANGUAGE_ASSEMBLY */ - #endif /* _GLOBALS_H_ */ diff --git a/lisp/hppa-arch.c b/lisp/hppa-arch.c index 1663bf57d..5a87f4c35 100644 --- a/lisp/hppa-arch.c +++ b/lisp/hppa-arch.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/hppa-arch.c,v 1.9 1994/10/27 17:13:54 ram Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/hppa-arch.c,v 1.10 2005/09/15 18:26:51 rtoy Rel $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -20,36 +20,36 @@ #include "internals.h" #include "breakpoint.h" -char *arch_init(void) +char * +arch_init(void) { return NULL; } -os_vm_address_t arch_get_bad_addr(int signal, - int code, - struct sigcontext *scp) +os_vm_address_t +arch_get_bad_addr(int signal, int code, struct sigcontext * scp) { #ifdef hpux struct save_state *state; os_vm_address_t addr; - state = (struct save_state *)(&(scp->sc_sl.sl_ss)); + state = (struct save_state *) (&(scp->sc_sl.sl_ss)); if (state == NULL) return NULL; /* Check the instruction address first. */ - addr = (os_vm_address_t)((unsigned long)scp->sc_pcoq_head & ~3); - if (addr < (os_vm_address_t)0x1000) + addr = (os_vm_address_t) ((unsigned long) scp->sc_pcoq_head & ~3); + if (addr < (os_vm_address_t) 0x1000) return addr; /* Otherwise, it must have been a data fault. */ - return (os_vm_address_t)state->ss_cr21; + return (os_vm_address_t) state->ss_cr21; #else struct hp800_thread_state *state; os_vm_address_t addr; - state = (struct hp800_thread_state *)(scp->sc_ap); + state = (struct hp800_thread_state *) (scp->sc_ap); if (state == NULL) return NULL; @@ -64,16 +64,18 @@ os_vm_address_t arch_get_bad_addr(int signal, #endif } -unsigned char *arch_internal_error_arguments(struct sigcontext *scp) +unsigned char * +arch_internal_error_arguments(struct sigcontext *scp) { #ifdef hpux - return (unsigned char *)((scp->sc_pcoq_head&~0x3)+4); + return (unsigned char *) ((scp->sc_pcoq_head & ~0x3) + 4); #else - return (unsigned char *)((scp->sc_pcoqh&~0x3)+4); + return (unsigned char *) ((scp->sc_pcoqh & ~0x3) + 4); #endif } -boolean arch_pseudo_atomic_atomic(struct sigcontext *scp) +boolean +arch_pseudo_atomic_atomic(struct sigcontext *scp) { /* Pseudo-atomic-atomic is implemented by oring 0x4 into ALLOC. */ @@ -83,14 +85,16 @@ boolean arch_pseudo_atomic_atomic(struct sigcontext *scp) return FALSE; } -void arch_set_pseudo_atomic_interrupted(struct sigcontext *scp) +void +arch_set_pseudo_atomic_interrupted(struct sigcontext *scp) { /* Pseudo-atomic-atomic is implemented by oring 0x1 into ALLOC. */ SC_REG(scp, reg_ALLOC) |= 1; } -void arch_skip_instruction(struct sigcontext *scp) +void +arch_skip_instruction(struct sigcontext *scp) { /* Skip the offending instruction */ #ifdef hpux @@ -102,22 +106,24 @@ void arch_skip_instruction(struct sigcontext *scp) #endif } -unsigned long arch_install_breakpoint(void *pc) +unsigned long +arch_install_breakpoint(void *pc) { - unsigned long *ulpc = (unsigned long *)pc; + unsigned long *ulpc = (unsigned long *) pc; unsigned long orig_inst = *ulpc; *ulpc = trap_Breakpoint; - os_flush_icache((os_vm_address_t)pc, sizeof(*ulpc)); + os_flush_icache((os_vm_address_t) pc, sizeof(*ulpc)); return orig_inst; } -void arch_remove_breakpoint(void *pc, unsigned long orig_inst) +void +arch_remove_breakpoint(void *pc, unsigned long orig_inst) { - unsigned long *ulpc = (unsigned long *)pc; + unsigned long *ulpc = (unsigned long *) pc; *ulpc = orig_inst; - os_flush_icache((os_vm_address_t)pc, sizeof(*ulpc)); + os_flush_icache((os_vm_address_t) pc, sizeof(*ulpc)); } #ifdef hpux @@ -126,36 +132,38 @@ static unsigned long *BreakpointAddr = NULL; static unsigned long NextPc = NULL; #endif -void arch_do_displaced_inst(struct sigcontext *scp, unsigned long orig_inst) +void +arch_do_displaced_inst(struct sigcontext *scp, unsigned long orig_inst) { #ifdef hpux /* We change the next-pc to point to a breakpoint instruction, restore */ /* the original instruction, and exit. We would like to be able to */ /* sigreturn, but we can't, because this is hpux. */ - unsigned long *pc = (unsigned long *)(SC_PC(scp) & ~3); + unsigned long *pc = (unsigned long *) (SC_PC(scp) & ~3); NextPc = SC_NPC(scp); - SC_NPC(scp) = (unsigned)SingleStepTraps | (SC_NPC(scp)&3); + SC_NPC(scp) = (unsigned) SingleStepTraps | (SC_NPC(scp) & 3); BreakpointAddr = pc; *pc = orig_inst; - os_flush_icache((os_vm_address_t)pc, sizeof(unsigned long)); + os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long)); #else /* We set the recovery counter to cover one instruction, put the */ /* original instruction back in, and then resume. We will then trap */ /* after executing that one instruction, at which time we can put */ /* the breakpoint back in. */ - ((struct hp800_thread_state *)scp->sc_ap)->cr0 = 1; + ((struct hp800_thread_state *) scp->sc_ap)->cr0 = 1; scp->sc_ps |= 0x10; - *(unsigned long *)SC_PC(scp) = orig_inst; + *(unsigned long *) SC_PC(scp) = orig_inst; sigreturn(scp); #endif } #ifdef hpux -static void restore_breakpoint(struct sigcontext *scp) +static void +restore_breakpoint(struct sigcontext *scp) { /* We just single-stepped over an instruction that we want to replace */ /* with a breakpoint. So we put the breakpoint back in, and tweek the */ @@ -164,17 +172,16 @@ static void restore_breakpoint(struct sigcontext *scp) if (NextPc == NULL) lose("SingleStepBreakpoint trap at strange time."); - if ((SC_PC(scp)&~3) == (unsigned long)SingleStepTraps) { + if ((SC_PC(scp) & ~3) == (unsigned long) SingleStepTraps) { /* The next instruction was not nullified. */ SC_PC(scp) = NextPc; - if ((SC_NPC(scp)&~3) == (unsigned long)SingleStepTraps + 4) { + if ((SC_NPC(scp) & ~3) == (unsigned long) SingleStepTraps + 4) { /* The instruction we just stepped over was not a branch, so */ /* we need to fix it up. If it was a branch, it will point to */ /* the correct place. */ SC_NPC(scp) = NextPc + 4; } - } - else { + } else { /* The next instruction was nullified, so we want to skip it. */ SC_PC(scp) = NextPc + 4; SC_NPC(scp) = NextPc + 8; @@ -183,14 +190,16 @@ static void restore_breakpoint(struct sigcontext *scp) if (BreakpointAddr) { *BreakpointAddr = trap_Breakpoint; - os_flush_icache((os_vm_address_t)BreakpointAddr, + os_flush_icache((os_vm_address_t) BreakpointAddr, + sizeof(unsigned long)); BreakpointAddr = NULL; } } #endif -static void sigtrap_handler(int signal, int code, struct sigcontext *scp) +static void +sigtrap_handler(int signal, int code, struct sigcontext *scp) { unsigned long bad_inst; @@ -198,13 +207,13 @@ static void sigtrap_handler(int signal, int code, struct sigcontext *scp) #if 0 printf("sigtrap_handler, pc=0x%08x, alloc=0x%08x\n", scp->sc_pcoqh, - SC_REG(scp,reg_ALLOC)); + SC_REG(scp, reg_ALLOC)); #endif #ifdef hpux - bad_inst = *(unsigned long *)(scp->sc_pcoq_head & ~3); + bad_inst = *(unsigned long *) (scp->sc_pcoq_head & ~3); #else - bad_inst = *(unsigned long *)(scp->sc_pcoqh & ~3); + bad_inst = *(unsigned long *) (scp->sc_pcoqh & ~3); #endif if (bad_inst & 0xfc001fe0) @@ -214,52 +223,54 @@ static void sigtrap_handler(int signal, int code, struct sigcontext *scp) switch (im5) { case trap_Halt: - fake_foreign_function_call(scp); - lose("%%primitive halt called; the party is over.\n"); + fake_foreign_function_call(scp); + lose("%%primitive halt called; the party is over.\n"); case trap_PendingInterrupt: - arch_skip_instruction(scp); - interrupt_handle_pending(scp); - break; + arch_skip_instruction(scp); + interrupt_handle_pending(scp); + break; case trap_Error: case trap_Cerror: - interrupt_internal_error(signal, code, scp, im5==trap_Cerror); - break; + interrupt_internal_error(signal, code, scp, im5 == trap_Cerror); + break; case trap_Breakpoint: - sigsetmask(scp->sc_mask); - handle_breakpoint(signal, code, scp); - break; + sigsetmask(scp->sc_mask); + handle_breakpoint(signal, code, scp); + break; case trap_FunctionEndBreakpoint: - sigsetmask(scp->sc_mask); - { - unsigned long pc; - pc = (unsigned long) - handle_function_end_breakpoint(signal, code, scp); + sigsetmask(scp->sc_mask); + { + unsigned long pc; + + pc = (unsigned long) + handle_function_end_breakpoint(signal, code, scp); #ifdef hpux - scp->sc_pcoq_head = pc; - scp->sc_pcoq_tail = pc + 4; + scp->sc_pcoq_head = pc; + scp->sc_pcoq_tail = pc + 4; #else - scp->sc_pcoqh = pc; - scp->sc_pcoqt = pc + 4; + scp->sc_pcoqh = pc; + scp->sc_pcoqt = pc + 4; #endif - } - break; + } + break; case trap_SingleStepBreakpoint: - restore_breakpoint(scp); - break; + restore_breakpoint(scp); + break; default: - interrupt_handle_now(signal, code, scp); - break; + interrupt_handle_now(signal, code, scp); + break; } } } -static void sigfpe_handler(int signal, int code, struct sigcontext *scp) +static void +sigfpe_handler(int signal, int code, struct sigcontext *scp) { unsigned long badinst; int opcode, r1, r2, t; @@ -267,99 +278,103 @@ static void sigfpe_handler(int signal, int code, struct sigcontext *scp) #if 0 printf("sigfpe_handler, pc=0x%08x, alloc=0x%08x\n", scp->sc_pcoqh, - SC_REG(scp,reg_ALLOC)); + SC_REG(scp, reg_ALLOC)); #endif switch (code) { case I_OVFLO: - badinst = *(unsigned long *)(SC_PC(scp)&~3); - opcode = badinst >> 26; - - if (opcode == 2) { - /* reg/reg inst. */ - r1 = (badinst >> 16) & 0x1f; - op1 = fixnum_value(SC_REG(scp, r1)); - r2 = (badinst >> 21) & 0x1f; - op2 = fixnum_value(SC_REG(scp, r2)); - t = badinst & 0x1f; - - switch ((badinst >> 5) & 0x7f) { - case 0x70: - /* Add and trap on overflow. */ - res = op1 + op2; - break; - - case 0x60: - /* Subtract and trap on overflow. */ - res = op1 - op2; - break; - - default: - goto not_interesting; - } - } - else if ((opcode & 0x37) == 0x25 && (badinst & (1<<11))) { - /* Add or subtract immediate. */ - op1 = ((badinst >> 3) & 0xff) | ((-badinst&1)<<8); - r2 = (badinst >> 16) & 0x1f; - op2 = fixnum_value(SC_REG(scp, r1)); - t = (badinst >> 21) & 0x1f; - if (opcode == 0x2d) - res = op1 + op2; - else - res = op1 - op2; - } - else - goto not_interesting; - - current_dynamic_space_free_pointer = (lispobj *)SC_REG(scp, reg_ALLOC); - SC_REG(scp, t) = alloc_number(res); - SC_REG(scp, reg_ALLOC) - = (unsigned long)current_dynamic_space_free_pointer; - arch_skip_instruction(scp); - - break; + badinst = *(unsigned long *) (SC_PC(scp) & ~3); + opcode = badinst >> 26; + + if (opcode == 2) { + /* reg/reg inst. */ + r1 = (badinst >> 16) & 0x1f; + op1 = fixnum_value(SC_REG(scp, r1)); + r2 = (badinst >> 21) & 0x1f; + op2 = fixnum_value(SC_REG(scp, r2)); + t = badinst & 0x1f; + + switch ((badinst >> 5) & 0x7f) { + case 0x70: + /* Add and trap on overflow. */ + res = op1 + op2; + break; + + case 0x60: + /* Subtract and trap on overflow. */ + res = op1 - op2; + break; + + default: + goto not_interesting; + } + } else if ((opcode & 0x37) == 0x25 && (badinst & (1 << 11))) { + /* Add or subtract immediate. */ + op1 = ((badinst >> 3) & 0xff) | ((-badinst & 1) << 8); + r2 = (badinst >> 16) & 0x1f; + op2 = fixnum_value(SC_REG(scp, r1)); + t = (badinst >> 21) & 0x1f; + if (opcode == 0x2d) + res = op1 + op2; + else + res = op1 - op2; + } else + goto not_interesting; + + current_dynamic_space_free_pointer = + (lispobj *) SC_REG(scp, reg_ALLOC); + SC_REG(scp, t) = alloc_number(res); + SC_REG(scp, reg_ALLOC) + = (unsigned long) current_dynamic_space_free_pointer; + arch_skip_instruction(scp); + + break; case I_COND: - badinst = *(unsigned long *)(SC_PC(scp)&~3); - if ((badinst&0xfffff800) == (0xb000e000|reg_ALLOC<<21|reg_ALLOC<<16)) { - /* It is an ADDIT,OD i,ALLOC,ALLOC instruction that trapped. */ - /* That means that it is the end of a pseudo-atomic. So do the */ - /* add stripping off the pseudo-atomic-interrupted bit, and then */ - /* tell the machine-independent code to process the pseudo- */ - /* atomic. */ - int immed = (badinst>>1)&0x3ff; - if (badinst & 1) - immed |= -1<<10; - SC_REG(scp,reg_ALLOC) += (immed-1); - arch_skip_instruction(scp); - interrupt_handle_pending(scp); - break; - } - /* else drop-through. */ + badinst = *(unsigned long *) (SC_PC(scp) & ~3); + if ((badinst & 0xfffff800) == + (0xb000e000 | reg_ALLOC << 21 | reg_ALLOC << 16)) { + /* It is an ADDIT,OD i,ALLOC,ALLOC instruction that trapped. */ + /* That means that it is the end of a pseudo-atomic. So do the */ + /* add stripping off the pseudo-atomic-interrupted bit, and then */ + /* tell the machine-independent code to process the pseudo- */ + /* atomic. */ + int immed = (badinst >> 1) & 0x3ff; + + if (badinst & 1) + immed |= -1 << 10; + SC_REG(scp, reg_ALLOC) += (immed - 1); + arch_skip_instruction(scp); + interrupt_handle_pending(scp); + break; + } + /* else drop-through. */ default: - not_interesting: - interrupt_handle_now(signal, code, scp); + not_interesting: + interrupt_handle_now(signal, code, scp); } } -void arch_install_interrupt_handlers(void) +void +arch_install_interrupt_handlers(void) { #ifdef hpux - interrupt_install_low_level_handler(SIGILL,sigtrap_handler); + interrupt_install_low_level_handler(SIGILL, sigtrap_handler); #endif - interrupt_install_low_level_handler(SIGTRAP,sigtrap_handler); - interrupt_install_low_level_handler(SIGFPE,sigfpe_handler); + interrupt_install_low_level_handler(SIGTRAP, sigtrap_handler); + interrupt_install_low_level_handler(SIGFPE, sigfpe_handler); } -lispobj funcall0(lispobj function) +lispobj +funcall0(lispobj function) { lispobj *args = current_control_stack_pointer; return call_into_lisp(function, args, 0); } -lispobj funcall1(lispobj function, lispobj arg0) +lispobj +funcall1(lispobj function, lispobj arg0) { lispobj *args = current_control_stack_pointer; @@ -369,7 +384,8 @@ lispobj funcall1(lispobj function, lispobj arg0) return call_into_lisp(function, args, 1); } -lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1) +lispobj +funcall2(lispobj function, lispobj arg0, lispobj arg1) { lispobj *args = current_control_stack_pointer; @@ -380,7 +396,8 @@ lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1) return call_into_lisp(function, args, 2); } -lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) +lispobj +funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) { lispobj *args = current_control_stack_pointer; diff --git a/lisp/hpux-os.c b/lisp/hpux-os.c index 9241a813f..eda74366e 100644 --- a/lisp/hpux-os.c +++ b/lisp/hpux-os.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/hpux-os.c,v 1.6 2005/09/05 06:09:13 cshapiro Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/hpux-os.c,v 1.7 2005/09/15 18:26:51 rtoy Exp $ * * OS-dependent routines. This file (along with os.h) exports an * OS-independent interface to the operating system VM facilities. @@ -41,347 +41,354 @@ the particular section in. #include <sys/times.h> #include <errno.h> -os_vm_size_t os_vm_page_size=(-1); +os_vm_size_t os_vm_page_size = (-1); #define MAX_SEGMENTS 20 -#define ALLOC_SIZE 0x10000 +#define ALLOC_SIZE 0x10000 static struct segment { - os_vm_address_t base; - os_vm_size_t len; - os_vm_address_t valid; - os_vm_address_t protected; + os_vm_address_t base; + os_vm_size_t len; + os_vm_address_t valid; + os_vm_address_t protected; } segments[MAX_SEGMENTS]; void os_init() { - int i; - os_vm_page_size=sysconf(_SC_PAGE_SIZE); - for(i=0;i<MAX_SEGMENTS;i++) - segments[i].len=0; + int i; + + os_vm_page_size = sysconf(_SC_PAGE_SIZE); + for (i = 0; i < MAX_SEGMENTS; i++) + segments[i].len = 0; } -os_vm_address_t -os_validate(os_vm_address_t addr, os_vm_size_t len) +os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len) { - int fd,i; - caddr_t ret; + int fd, i; + caddr_t ret; - addr=os_trunc_to_page(addr); - len=os_round_up_size_to_page(len); + addr = os_trunc_to_page(addr); + len = os_round_up_size_to_page(len); #ifdef DEBUG - printf("os_validate: addr: 0x%X, len: 0x%X, end: 0x%X\n",addr,len,addr+len); -#endif - assert(addr!=NULL); - assert(len!=0); + printf("os_validate: addr: 0x%X, len: 0x%X, end: 0x%X\n", addr, len, + addr + len); +#endif + assert(addr != NULL); + assert(len != 0); - for(i=0;i<MAX_SEGMENTS;i++) - if(segments[i].len==0) break; + for (i = 0; i < MAX_SEGMENTS; i++) + if (segments[i].len == 0) + break; - assert(i!=MAX_SEGMENTS); + assert(i != MAX_SEGMENTS); - segments[i].base=addr; - segments[i].len=len; - segments[i].valid=addr; - segments[i].protected=addr+len; - return addr; + segments[i].base = addr; + segments[i].len = len; + segments[i].valid = addr; + segments[i].protected = addr + len; + return addr; } void os_invalidate(os_vm_address_t addr, os_vm_size_t len) { - assert(FALSE); + assert(FALSE); } os_vm_address_t os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len) { - int i; + int i; - addr=os_trunc_to_page(addr); - len=os_round_up_size_to_page(len); + addr = os_trunc_to_page(addr); + len = os_round_up_size_to_page(len); - if(mmap(addr,len,OS_VM_PROT_ALL,MAP_FILE|MAP_FIXED|MAP_PRIVATE,fd, - (off_t)offset) == (os_vm_address_t)-1) { - perror("mmap"); - return NULL; - } + if (mmap(addr, len, OS_VM_PROT_ALL, MAP_FILE | MAP_FIXED | MAP_PRIVATE, fd, + (off_t) offset) == (os_vm_address_t) - 1) { + perror("mmap"); + return NULL; + } - for(i=0;i<MAX_SEGMENTS;i++) - if(segments[i].len!=0 && segments[i].base==addr) break; + for (i = 0; i < MAX_SEGMENTS; i++) + if (segments[i].len != 0 && segments[i].base == addr) + break; - assert(i!=MAX_SEGMENTS); - assert(segments[i].valid==addr); + assert(i != MAX_SEGMENTS); + assert(segments[i].valid == addr); - segments[i].valid=addr+len; + segments[i].valid = addr + len; #ifdef DEBUG - printf("os_map: addr: 0x%X, len: 0x%X, end: 0x%X\n",addr,len,addr+len); + printf("os_map: addr: 0x%X, len: 0x%X, end: 0x%X\n", addr, len, addr + len); #endif - return addr; + return addr; } void os_flush_icache(os_vm_address_t address, os_vm_size_t length) { - sanctify_for_execution(address,length); + sanctify_for_execution(address, length); } void os_protect(os_vm_address_t addr, os_vm_size_t len, os_vm_prot_t prot) { - int i; - addr=os_trunc_to_page(addr); - len=os_round_up_size_to_page(len); - - for(i=0;i<MAX_SEGMENTS;i++) - if(segments[i].base<=addr && addr<segments[i].base+segments[i].len) - break; - - assert(i!=MAX_SEGMENTS); - - if(prot) { - assert(segments[i].base==addr && segments[i].len==len); - segments[i].protected=addr+len; - } else { - assert(segments[i].protected==addr+len); - segments[i].protected=addr; - } - - if(addr<segments[i].valid) - if(mprotect(addr,segments[i].valid-addr,prot) == -1) { - perror("mprotect"); - printf("segments[i].base: 0x%X\n",segments[i].base); - printf("segments[i].len: 0x%X\n",segments[i].len); - printf("segments[i].valid: 0x%X\n",segments[i].valid); - printf("addr: 0x%X, segments[i].valid-addr: 0x%X\n",addr, - segments[i].valid-addr); - printf("prot: 0x%X, len 0x%X\n",prot,len); - assert(FALSE); + int i; + + addr = os_trunc_to_page(addr); + len = os_round_up_size_to_page(len); + + for (i = 0; i < MAX_SEGMENTS; i++) + if (segments[i].base <= addr + && addr < segments[i].base + segments[i].len) break; + + assert(i != MAX_SEGMENTS); + + if (prot) { + assert(segments[i].base == addr && segments[i].len == len); + segments[i].protected = addr + len; + } else { + assert(segments[i].protected == addr + len); + segments[i].protected = addr; } + + if (addr < segments[i].valid) + if (mprotect(addr, segments[i].valid - addr, prot) == -1) { + perror("mprotect"); + printf("segments[i].base: 0x%X\n", segments[i].base); + printf("segments[i].len: 0x%X\n", segments[i].len); + printf("segments[i].valid: 0x%X\n", segments[i].valid); + printf("addr: 0x%X, segments[i].valid-addr: 0x%X\n", addr, + segments[i].valid - addr); + printf("prot: 0x%X, len 0x%X\n", prot, len); + assert(FALSE); + } #ifdef DEBUG - printf("os_protect: addr: 0x%X, len: 0x%X, end: 0x%X, prot 0x%X\n", - addr,len,addr+len,prot); + printf("os_protect: addr: 0x%X, len: 0x%X, end: 0x%X, prot 0x%X\n", + addr, len, addr + len, prot); #endif } -boolean -valid_addr(os_vm_address_t addr) +boolean valid_addr(os_vm_address_t addr) { - int i; + int i; - for(i=0;i<MAX_SEGMENTS;i++) - if(segments[i].base<=addr && addr<segments[i].base+segments[i].len) - return TRUE; - return FALSE; + for (i = 0; i < MAX_SEGMENTS; i++) + if (segments[i].base <= addr + && addr < segments[i].base + segments[i].len) return TRUE; + return FALSE; } void segv_handler(int signal, int code, struct sigcontext *context) { - int i; - os_vm_address_t addr,nvalid; - sigsetmask(BLOCKABLE); - - addr=(os_vm_address_t)context->sc_sl.sl_ss.ss_cr21; /* verify this!!! */ - for(i=0;i<MAX_SEGMENTS;i++) - if(segments[i].len!=0 && segments[i].base<=addr && - addr<segments[i].base+segments[i].len) - break; - if(i==MAX_SEGMENTS || addr<segments[i].valid) - interrupt_handle_now(signal,code,context); - else if(segments[i].protected<=addr) { - if(!interrupt_maybe_gc(signal,code,context)) - interrupt_handle_now(signal,code,context); - } else { - nvalid=((os_vm_address_t)(((long)(addr+ALLOC_SIZE))&~((long)(ALLOC_SIZE-1)))); - if(nvalid>segments[i].protected) nvalid=segments[i].protected; + int i; + os_vm_address_t addr, nvalid; + + sigsetmask(BLOCKABLE); + + addr = (os_vm_address_t) context->sc_sl.sl_ss.ss_cr21; /* verify this!!! */ + for (i = 0; i < MAX_SEGMENTS; i++) + if (segments[i].len != 0 && segments[i].base <= addr && + addr < segments[i].base + segments[i].len) + break; + if (i == MAX_SEGMENTS || addr < segments[i].valid) + interrupt_handle_now(signal, code, context); + else if (segments[i].protected <= addr) { + if (!interrupt_maybe_gc(signal, code, context)) + interrupt_handle_now(signal, code, context); + } else { + nvalid = + ((os_vm_address_t) + (((long) (addr + ALLOC_SIZE)) & ~((long) (ALLOC_SIZE - 1)))); + if (nvalid > segments[i].protected) + nvalid = segments[i].protected; #ifdef DEBUG - printf("Mapping: addr: 0x%08x, old: 0x%08x, new: 0x%08x\n", - addr,segments[i].valid,nvalid); + printf("Mapping: addr: 0x%08x, old: 0x%08x, new: 0x%08x\n", + addr, segments[i].valid, nvalid); #endif - if(mmap(segments[i].valid,nvalid-segments[i].valid, - OS_VM_PROT_ALL,MAP_ANONYMOUS|MAP_FIXED|MAP_PRIVATE,-1,0) == - (os_vm_address_t)-1) { - perror("mmap"); - printf("segments[i].base: 0x%X\n",segments[i].base); - printf("segments[i].len: 0x%X\n",segments[i].len); - printf("segments[i].valid: 0x%X\n",segments[i].valid); - printf("segments[i].protected: 0x%X\n",segments[i].protected); - printf("nvalid: 0x%X\n",nvalid); - printf("nvalid-segments[i].valid: 0x%X\n",nvalid-segments[i].valid); - assert(FALSE); + if (mmap(segments[i].valid, nvalid - segments[i].valid, + OS_VM_PROT_ALL, MAP_ANONYMOUS | MAP_FIXED | MAP_PRIVATE, -1, + 0) == (os_vm_address_t) - 1) { + perror("mmap"); + printf("segments[i].base: 0x%X\n", segments[i].base); + printf("segments[i].len: 0x%X\n", segments[i].len); + printf("segments[i].valid: 0x%X\n", segments[i].valid); + printf("segments[i].protected: 0x%X\n", segments[i].protected); + printf("nvalid: 0x%X\n", nvalid); + printf("nvalid-segments[i].valid: 0x%X\n", + nvalid - segments[i].valid); + assert(FALSE); + } + segments[i].valid = nvalid; } - segments[i].valid=nvalid; - } } void sigbus_handler(int signal, int code, struct sigcontext *context) { #ifdef DEBUG - printf("Bus Error at 0x%X\n",context->sc_sl.sl_ss.ss_cr21); + printf("Bus Error at 0x%X\n", context->sc_sl.sl_ss.ss_cr21); #endif - if(!interrupt_maybe_gc(signal, code, context)) - interrupt_handle_now(signal, code, context); + if (!interrupt_maybe_gc(signal, code, context)) + interrupt_handle_now(signal, code, context); } void os_install_interrupt_handlers() { - interrupt_install_low_level_handler(SIGSEGV,segv_handler); - interrupt_install_low_level_handler(SIGBUS,sigbus_handler); + interrupt_install_low_level_handler(SIGSEGV, segv_handler); + interrupt_install_low_level_handler(SIGBUS, sigbus_handler); } void -os_zero(os_vm_address_t addr,os_vm_size_t length) +os_zero(os_vm_address_t addr, os_vm_size_t length) { os_vm_address_t block_start; os_vm_size_t block_size; int i; #ifdef PRINTNOISE - fprintf(stderr,"os_zero: addr: 0x%08x, len: 0x%08x, end: 0x%X\n",addr, - length,addr+length); + fprintf(stderr, "os_zero: addr: 0x%08x, len: 0x%08x, end: 0x%X\n", addr, + length, addr + length); #endif - block_start=os_round_up_to_page(addr); + block_start = os_round_up_to_page(addr); + + length -= block_start - addr; + block_size = os_trunc_size_to_page(length); - length-=block_start-addr; - block_size=os_trunc_size_to_page(length); + if (block_start > addr) + memset((char *) addr, 0, block_start - addr); + if (block_size < length) + assert(FALSE); - if(block_start>addr) - memset((char *)addr,0,block_start-addr); - if(block_size<length) - assert(FALSE); - if (block_size != 0) { /* Now deallocate and allocate the block so that it */ /* faults in zero-filled. */ - for(i=0;i<MAX_SEGMENTS;i++) - if(segments[i].base<=block_start && - block_start<segments[i].base+segments[i].len) - break; - assert(i!=MAX_SEGMENTS); - assert(block_start+block_size==segments[i].base+segments[i].len); - - if(segments[i].valid>block_start) { - if(munmap(block_start,segments[i].valid-block_start)==-1) { - perror("munmap"); - return; - } - segments[i].valid=block_start; + for (i = 0; i < MAX_SEGMENTS; i++) + if (segments[i].base <= block_start && + block_start < segments[i].base + segments[i].len) + break; + assert(i != MAX_SEGMENTS); + assert(block_start + block_size == segments[i].base + segments[i].len); + + if (segments[i].valid > block_start) { + if (munmap(block_start, segments[i].valid - block_start) == -1) { + perror("munmap"); + return; + } + segments[i].valid = block_start; } } } -os_vm_address_t -os_allocate(os_vm_size_t len) +os_vm_address_t os_allocate(os_vm_size_t len) { - return (os_vm_address_t) malloc(len); + return (os_vm_address_t) malloc(len); } -os_vm_address_t -os_allocate_at(os_vm_address_t addr, os_vm_size_t len) +os_vm_address_t os_allocate_at(os_vm_address_t addr, os_vm_size_t len) { - return os_validate(addr, len); + return os_validate(addr, len); } void -os_deallocate(os_vm_address_t addr,os_vm_size_t len) +os_deallocate(os_vm_address_t addr, os_vm_size_t len) { - free(addr); + free(addr); } os_vm_address_t -os_reallocate(os_vm_address_t addr, os_vm_size_t old_len, - os_vm_size_t len) +os_reallocate(os_vm_address_t addr, os_vm_size_t old_len, os_vm_size_t len) { - addr=(os_vm_address_t) realloc(addr,len); - assert(addr!=NULL); - return addr; + addr = (os_vm_address_t) realloc(addr, len); + assert(addr != NULL); + return addr; } -int getrusage(int who,struct rusage *rusage) +int +getrusage(int who, struct rusage *rusage) { - static long ticks_per_sec = 0; - static long usec_per_tick = 0; - struct tms buf; - clock_t uticks, sticks; - - memset(rusage,0,sizeof(struct rusage)); - if (ticks_per_sec == 0) { - ticks_per_sec = sysconf(_SC_CLK_TCK); - usec_per_tick = 1000000 / ticks_per_sec; - } - - if(times(&buf) == -1) - return -1; - - if(who == RUSAGE_SELF) { - uticks = buf.tms_utime; - sticks = buf.tms_stime; - } - else if(who == RUSAGE_CHILDREN) { - uticks = buf.tms_utime; - sticks = buf.tms_stime; - } - else { - errno = EINVAL; - return -1; - } - - rusage->ru_utime.tv_sec = uticks / ticks_per_sec; - rusage->ru_utime.tv_usec = (uticks % ticks_per_sec) * usec_per_tick; - rusage->ru_stime.tv_sec = sticks / ticks_per_sec; - rusage->ru_stime.tv_usec = (sticks % ticks_per_sec) * usec_per_tick; - - return 0; + static long ticks_per_sec = 0; + static long usec_per_tick = 0; + struct tms buf; + clock_t uticks, sticks; + + memset(rusage, 0, sizeof(struct rusage)); + + if (ticks_per_sec == 0) { + ticks_per_sec = sysconf(_SC_CLK_TCK); + usec_per_tick = 1000000 / ticks_per_sec; + } + + if (times(&buf) == -1) + return -1; + + if (who == RUSAGE_SELF) { + uticks = buf.tms_utime; + sticks = buf.tms_stime; + } else if (who == RUSAGE_CHILDREN) { + uticks = buf.tms_utime; + sticks = buf.tms_stime; + } else { + errno = EINVAL; + return -1; + } + + rusage->ru_utime.tv_sec = uticks / ticks_per_sec; + rusage->ru_utime.tv_usec = (uticks % ticks_per_sec) * usec_per_tick; + rusage->ru_stime.tv_sec = sticks / ticks_per_sec; + rusage->ru_stime.tv_usec = (sticks % ticks_per_sec) * usec_per_tick; + + return 0; } int getdtablesize(void) { - struct rlimit rlp; - assert(getrlimit(RLIMIT_NOFILE,&rlp)==0); - return rlp.rlim_cur; + struct rlimit rlp; + + assert(getrlimit(RLIMIT_NOFILE, &rlp) == 0); + return rlp.rlim_cur; } unsigned long gethostid(void) { - char hostname[256]; - struct hostent *hostent; - static unsigned long addr=NULL; + char hostname[256]; + struct hostent *hostent; + static unsigned long addr = NULL; - if(addr) return addr; + if (addr) + return addr; - if(gethostname(hostname, sizeof(hostname)) == -1) { - perror("gethostname"); - return 0; - } + if (gethostname(hostname, sizeof(hostname)) == -1) { + perror("gethostname"); + return 0; + } - hostent = gethostbyname(hostname); - if(hostent == NULL) { - perror("gethostbyname"); - return 0; - } + hostent = gethostbyname(hostname); + if (hostent == NULL) { + perror("gethostbyname"); + return 0; + } - addr = ((unsigned char *)(hostent->h_addr))[0] << 24 | - ((unsigned char *)(hostent->h_addr))[1] << 16 | - ((unsigned char *)(hostent->h_addr))[2] << 8 | - ((unsigned char *)(hostent->h_addr))[3]; + addr = ((unsigned char *) (hostent->h_addr))[0] << 24 | + ((unsigned char *) (hostent->h_addr))[1] << 16 | + ((unsigned char *) (hostent->h_addr))[2] << 8 | + ((unsigned char *) (hostent->h_addr))[3]; - return addr; + return addr; } int getpagesize(void) { - return os_vm_page_size; + return os_vm_page_size; } diff --git a/lisp/interr.c b/lisp/interr.c index bc9387a09..79acc32a7 100644 --- a/lisp/interr.c +++ b/lisp/interr.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interr.c,v 1.7 2004/07/12 23:44:07 pmai Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interr.c,v 1.8 2005/09/15 18:26:51 rtoy Exp $ * * Stuff to handle internal errors. * @@ -17,23 +17,26 @@ #include "interr.h" #include "print.h" #include "lispregs.h" - + /* Lossage handler. */ -static void default_lossage_handler(void) +static void +default_lossage_handler(void) { exit(1); } -static void (*lossage_handler)(void) = default_lossage_handler; +static void (*lossage_handler) (void) = default_lossage_handler; -void set_lossage_handler(void handler(void)) +void +set_lossage_handler(void handler(void)) { lossage_handler = handler; } -void lose(char *fmt, ...) +void +lose(char *fmt, ...) { va_list ap; @@ -45,13 +48,14 @@ void lose(char *fmt, ...) } lossage_handler(); } - + /* Internal error handler for when the Lisp error system doesn't exist. */ static char *errors[] = ERRORS; -void internal_error(os_context_t *context) +void +internal_error(os_context_t * context) { unsigned char *ptr = arch_internal_error_arguments(context); int len, scoffset, sc, offset, ch; @@ -65,94 +69,101 @@ void internal_error(os_context_t *context) if (scoffset == 253) { scoffset = *ptr++; len--; - } - else if (scoffset == 254) { - scoffset = ptr[0] + ptr[1]*256; + } else if (scoffset == 254) { + scoffset = ptr[0] + ptr[1] * 256; ptr += 2; len -= 2; - } - else if (scoffset == 255) { - scoffset = ptr[0] + (ptr[1]<<8) + (ptr[2]<<16) + (ptr[3]<<24); + } else if (scoffset == 255) { + scoffset = ptr[0] + (ptr[1] << 8) + (ptr[2] << 16) + (ptr[3] << 24); ptr += 4; len -= 4; } sc = scoffset & 0x1f; offset = scoffset >> 5; - + printf(" SC: %d, Offset: %d", sc, offset); switch (sc) { case sc_AnyReg: case sc_DescriptorReg: - putchar('\t'); - brief_print(SC_REG(context, offset)); - break; + putchar('\t'); + brief_print(SC_REG(context, offset)); + break; case sc_BaseCharReg: - ch = SC_REG(context, offset); + ch = SC_REG(context, offset); #ifdef i386 - if (offset&1) - ch = ch>>8; - ch = ch & 0xff; + if (offset & 1) + ch = ch >> 8; + ch = ch & 0xff; #endif - switch (ch) { - case '\n': printf("\t'\\n'\n"); break; - case '\b': printf("\t'\\b'\n"); break; - case '\t': printf("\t'\\t'\n"); break; - case '\r': printf("\t'\\r'\n"); break; - default: - if (ch < 32 || ch > 127) - printf("\\%03o", ch); - else - printf("\t'%c'\n", ch); - break; - } - break; + switch (ch) { + case '\n': + printf("\t'\\n'\n"); + break; + case '\b': + printf("\t'\\b'\n"); + break; + case '\t': + printf("\t'\\t'\n"); + break; + case '\r': + printf("\t'\\r'\n"); + break; + default: + if (ch < 32 || ch > 127) + printf("\\%03o", ch); + else + printf("\t'%c'\n", ch); + break; + } + break; case sc_SapReg: #ifdef sc_WordPointerReg case sc_WordPointerReg: #endif - printf("\t0x%08x\n", SC_REG(context, offset)); - break; + printf("\t0x%08x\n", SC_REG(context, offset)); + break; case sc_SignedReg: - printf("\t%d\n", SC_REG(context, offset)); - break; + printf("\t%d\n", SC_REG(context, offset)); + break; case sc_UnsignedReg: - printf("\t%u\n", SC_REG(context, offset)); - break; -#if 0 /* broken */ + printf("\t%u\n", SC_REG(context, offset)); + break; +#if 0 /* broken */ #ifdef sc_SingleReg case sc_SingleReg: - printf("\t%g\n", *(float *) &context->sc_fpregs[offset]); - break; + printf("\t%g\n", *(float *) &context->sc_fpregs[offset]); + break; #endif #ifdef sc_DoubleReg case sc_DoubleReg: - printf("\t%g\n", *(double *) &context->sc_fpregs[offset]); - break; + printf("\t%g\n", *(double *) &context->sc_fpregs[offset]); + break; #endif #ifdef sc_LongReg case sc_LongReg: - printf("\t%Lg\n", *(long double *) &context->sc_fpregs[offset]); - break; + printf("\t%Lg\n", *(long double *) &context->sc_fpregs[offset]); + break; #endif #endif default: - printf("\t???\n"); - break; + printf("\t???\n"); + break; } } lose(NULL); } + - /* Utility routines used by random pieces of code. */ -lispobj debug_print(lispobj string) +lispobj +debug_print(lispobj string) { - printf("%s\n", (char *)(((struct vector *)PTR(string))->data)); + printf("%s\n", (char *) (((struct vector *) PTR(string))->data)); fflush(stdout); return NIL; diff --git a/lisp/interr.h b/lisp/interr.h index 48b3e9b4c..a9d827586 100644 --- a/lisp/interr.h +++ b/lisp/interr.h @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interr.h,v 1.3 2005/01/13 19:55:00 fgilham Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interr.h,v 1.4 2005/09/15 18:26:51 rtoy Rel $ */ #ifndef _INTERR_H_ @@ -9,7 +9,7 @@ extern void lose(char *fmt, ...); extern void set_lossage_handler(void fun(void)); -extern void internal_error(os_context_t *context); +extern void internal_error(os_context_t * context); extern lispobj debug_print(lispobj string); diff --git a/lisp/interrupt.c b/lisp/interrupt.c index 874fdddf0..ebaf5f094 100644 --- a/lisp/interrupt.c +++ b/lisp/interrupt.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.c,v 1.42 2004/10/15 19:28:49 cwang Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.c,v 1.43 2005/09/15 18:26:51 rtoy Exp $ */ /* Interrupt handling magic. */ @@ -27,16 +27,19 @@ boolean internal_errors_enabled = 0; os_context_t *lisp_interrupt_contexts[MAX_INTERRUPTS]; union interrupt_handler interrupt_handlers[NSIG]; -void (*interrupt_low_level_handlers[NSIG]) (HANDLER_ARGS) = {0}; +void (*interrupt_low_level_handlers[NSIG]) (HANDLER_ARGS) = { +0}; static int pending_signal = 0; #if defined(SOLARIS) || defined(__OpenBSD__) || defined(__NetBSD__) static siginfo_t *pending_code; + #define PASSCODE(code) ((code)) #define DEREFCODE(code) ((code)) #else static int pending_code = 0; + #define PASSCODE(code) (code) #define DEREFCODE(code) (code) #endif @@ -54,125 +57,124 @@ static boolean maybe_gc_pending = FALSE; \****************************************************************/ void -build_fake_control_stack_frame(os_context_t *context) +build_fake_control_stack_frame(os_context_t * context) { #if !(defined(i386) || defined(__x86_64)) - lispobj oldcont; - - /* Build a fake stack frame */ - current_control_frame_pointer = (lispobj *)SC_REG(context, reg_CSP); - if ((lispobj *)SC_REG(context, reg_CFP)==current_control_frame_pointer) { - /* There is a small window during call where the callee's frame */ - /* isn't built yet. */ - if (LowtagOf(SC_REG(context, reg_CODE)) == type_FunctionPointer) { - /* We have called, but not built the new frame, so - build it for them. */ - current_control_frame_pointer[0] = SC_REG(context, reg_OCFP); - current_control_frame_pointer[1] = SC_REG(context, reg_LRA); - current_control_frame_pointer += 8; - /* Build our frame on top of it. */ - oldcont = (lispobj)SC_REG(context, reg_CFP); + lispobj oldcont; + + /* Build a fake stack frame */ + current_control_frame_pointer = (lispobj *) SC_REG(context, reg_CSP); + if ((lispobj *) SC_REG(context, reg_CFP) == current_control_frame_pointer) { + /* There is a small window during call where the callee's frame */ + /* isn't built yet. */ + if (LowtagOf(SC_REG(context, reg_CODE)) == type_FunctionPointer) { + /* We have called, but not built the new frame, so + build it for them. */ + current_control_frame_pointer[0] = SC_REG(context, reg_OCFP); + current_control_frame_pointer[1] = SC_REG(context, reg_LRA); + current_control_frame_pointer += 8; + /* Build our frame on top of it. */ + oldcont = (lispobj) SC_REG(context, reg_CFP); + } else { + /* We haven't yet called, build our frame as if the + partial frame wasn't there. */ + oldcont = (lispobj) SC_REG(context, reg_OCFP); + } } + /* ### We can't tell if we are still in the caller if it had to + reg_ALLOCate the stack frame due to stack arguments. */ + /* ### Can anything strange happen during return? */ else { - /* We haven't yet called, build our frame as if the - partial frame wasn't there. */ - oldcont = (lispobj)SC_REG(context, reg_OCFP); + + /* Normal case. */ + oldcont = (lispobj) SC_REG(context, reg_CFP); } - } - /* ### We can't tell if we are still in the caller if it had to - reg_ALLOCate the stack frame due to stack arguments. */ - /* ### Can anything strange happen during return? */ - else { - - /* Normal case. */ - oldcont = (lispobj)SC_REG(context, reg_CFP); - } - - current_control_stack_pointer = current_control_frame_pointer + 8; - - current_control_frame_pointer[0] = oldcont; - current_control_frame_pointer[1] = NIL; - current_control_frame_pointer[2] = (lispobj)SC_REG(context, reg_CODE); + + current_control_stack_pointer = current_control_frame_pointer + 8; + + current_control_frame_pointer[0] = oldcont; + current_control_frame_pointer[1] = NIL; + current_control_frame_pointer[2] = (lispobj) SC_REG(context, reg_CODE); #endif } -void -fake_foreign_function_call(os_context_t *context) +void +fake_foreign_function_call(os_context_t * context) { int context_index; /* Get current LISP state from context */ #ifdef reg_ALLOC - current_dynamic_space_free_pointer = (lispobj *)SC_REG(context, reg_ALLOC); + current_dynamic_space_free_pointer = (lispobj *) SC_REG(context, reg_ALLOC); #ifdef alpha - if((long) current_dynamic_space_free_pointer & 1) { - printf("Dead in fake_foriegn_function-call, context = %x\n",context); - lose(""); + if ((long) current_dynamic_space_free_pointer & 1) { + printf("Dead in fake_foriegn_function-call, context = %x\n", context); + lose(""); } #endif #endif #ifdef reg_BSP - current_binding_stack_pointer = (lispobj *)SC_REG(context, reg_BSP); + current_binding_stack_pointer = (lispobj *) SC_REG(context, reg_BSP); #endif - + build_fake_control_stack_frame(context); - + /* Do dynamic binding of the active interrupt context index and save the context in the context array. */ - context_index = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2; - + context_index = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX) >> 2; + if (context_index >= MAX_INTERRUPTS) { - fprintf(stderr, + fprintf(stderr, "Maximum number (%d) of interrupts exceeded. Exiting.\n", - MAX_INTERRUPTS); - exit(1); + MAX_INTERRUPTS); + exit(1); } - - bind_variable(FREE_INTERRUPT_CONTEXT_INDEX, - make_fixnum(context_index + 1)); - + + bind_variable(FREE_INTERRUPT_CONTEXT_INDEX, make_fixnum(context_index + 1)); + lisp_interrupt_contexts[context_index] = context; - + /* No longer in Lisp now. */ foreign_function_call_active = 1; } -void -undo_fake_foreign_function_call(os_context_t *context) +void +undo_fake_foreign_function_call(os_context_t * context) { /* Block all blockable signals */ #ifdef POSIX_SIGS sigset_t block; + sigemptyset(&block); FILLBLOCKSET(&block); sigprocmask(SIG_BLOCK, &block, 0); #else sigblock(BLOCKABLE); #endif - + /* Going back into lisp. */ foreign_function_call_active = 0; - + /* Undo dynamic binding. */ /* ### Do I really need to unbind_to_here()? */ unbind(); - + #ifdef reg_ALLOC /* Put the dynamic space free pointer back into the context. */ SC_REG(context, reg_ALLOC) = - (unsigned long) current_dynamic_space_free_pointer; + (unsigned long) current_dynamic_space_free_pointer; #endif } -void +void interrupt_internal_error(HANDLER_ARGS, boolean continuable) { lispobj context_sap = NIL; + #if ( defined( __linux__ ) && (defined( i386 ) || defined( __x86_64 ) ) ) GET_CONTEXT #endif - - fake_foreign_function_call(context); + fake_foreign_function_call(context); /* Allocate the SAP object while the interrupts are still disabled. */ if (internal_errors_enabled) @@ -183,10 +185,11 @@ interrupt_internal_error(HANDLER_ARGS, boolean continuable) sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0); #else { - sigset_t temp; - sigemptyset(&temp); - temp.__val[0] = context->uc_sigmask; - sigprocmask(SIG_SETMASK, &temp, 0); + sigset_t temp; + + sigemptyset(&temp); + temp.__val[0] = context->uc_sigmask; + sigprocmask(SIG_SETMASK, &temp, 0); } #endif #else @@ -203,8 +206,8 @@ interrupt_internal_error(HANDLER_ARGS, boolean continuable) arch_skip_instruction(context); } -void -interrupt_handle_pending(os_context_t *context) +void +interrupt_handle_pending(os_context_t * context) { boolean were_in_lisp = !foreign_function_call_active; @@ -222,7 +225,6 @@ interrupt_handle_pending(os_context_t *context) #endif undo_fake_foreign_function_call(context); } - #ifdef POSIX_SIGS #if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) context->uc_sigmask = pending_mask; @@ -237,6 +239,7 @@ interrupt_handle_pending(os_context_t *context) if (pending_signal) { int signal; + #if defined(SOLARIS) || defined(__OpenBSD__) || defined(__NetBSD__) siginfo_t *code; #else @@ -247,7 +250,7 @@ interrupt_handle_pending(os_context_t *context) pending_signal = 0; /* pending_code = 0; */ #if ( defined( __linux__ ) && ( defined( i386 ) || defined ( __x86_64 ) ) ) - interrupt_handle_now(signal, *context); + interrupt_handle_now(signal, *context); #else interrupt_handle_now(signal, PASSCODE(code), context); #endif @@ -263,28 +266,27 @@ interrupt_handle_pending(os_context_t *context) * a handler. * \****************************************************************/ -void +void interrupt_handle_now_handler(HANDLER_ARGS) { #if defined(__linux__) && (defined(i386) || defined(__x86_64)) - interrupt_handle_now(signal, contextstruct); + interrupt_handle_now(signal, contextstruct); #else - interrupt_handle_now(signal, code, context); + interrupt_handle_now(signal, code, context); #endif #ifdef DARWIN - /* Work around G5 bug; fix courtesy gbyers via chandler */ + /* Work around G5 bug; fix courtesy gbyers via chandler */ sigreturn(context); #endif } -void +void interrupt_handle_now(HANDLER_ARGS) { #if defined(__linux__) && (defined(i386) || defined(__x86_64)) GET_CONTEXT #endif - int were_in_lisp; union interrupt_handler handler; @@ -295,167 +297,168 @@ interrupt_handle_now(HANDLER_ARGS) if (contextstruct.fpstate) #if defined(__x86_64) - setfpucw(contextstruct.fpstate->cwd & ~0xc00); + setfpucw(contextstruct.fpstate->cwd & ~0xc00); #else - setfpucw(contextstruct.fpstate->cw & ~0xc00); + setfpucw(contextstruct.fpstate->cw & ~0xc00); #endif #endif handler = interrupt_handlers[signal]; - if(handler.c == (void (*)(HANDLER_ARGS)) SIG_IGN) + if (handler.c == (void (*)(HANDLER_ARGS)) SIG_IGN) return; - SAVE_CONTEXT(); /**/ - - were_in_lisp = !foreign_function_call_active; + SAVE_CONTEXT(); + /**/ were_in_lisp = !foreign_function_call_active; #if ! (defined(i386) || defined(_x86_64)) if (were_in_lisp) #endif - fake_foreign_function_call(context); - + fake_foreign_function_call(context); + if (handler.c == (void (*)(HANDLER_ARGS)) SIG_DFL) /* This can happen if someone tries to ignore or default on one of the */ /* signals we need for runtime support, and the runtime support */ /* decides to pass on it. */ lose("interrupt_handle_now: No handler for signal %d?\n", signal); else if (LowtagOf(handler.lisp) == type_FunctionPointer) { - /* Allocate the SAP object while the interrupts are still - disabled. */ - lispobj context_sap = alloc_sap(context); + /* Allocate the SAP object while the interrupts are still + disabled. */ + lispobj context_sap = alloc_sap(context); - /* Allow signals again. */ + /* Allow signals again. */ #ifdef POSIX_SIGS #if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) - sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0); + sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0); #else { - sigset_t temp; - sigemptyset(&temp); - temp.__val[0] = context->uc_sigmask; - sigprocmask(SIG_SETMASK, &temp, 0); + sigset_t temp; + + sigemptyset(&temp); + temp.__val[0] = context->uc_sigmask; + sigprocmask(SIG_SETMASK, &temp, 0); } #endif #else - sigsetmask(context->sc_mask); + sigsetmask(context->sc_mask); #endif /* POSIX_SIGS */ - + #if 1 - funcall3(handler.lisp, make_fixnum(signal), make_fixnum(CODE(code)), + funcall3(handler.lisp, make_fixnum(signal), make_fixnum(CODE(code)), context_sap); #else - funcall3(handler.lisp, make_fixnum(signal), alloc_sap(code), + funcall3(handler.lisp, make_fixnum(signal), alloc_sap(code), alloc_sap(context)); #endif } else { - /* Allow signals again. */ + /* Allow signals again. */ #ifdef POSIX_SIGS #if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) - sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0); + sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0); #else { - sigset_t temp; - sigemptyset(&temp); - temp.__val[0] = context->uc_sigmask; - sigprocmask(SIG_SETMASK, &temp, 0); + sigset_t temp; + + sigemptyset(&temp); + temp.__val[0] = context->uc_sigmask; + sigprocmask(SIG_SETMASK, &temp, 0); } #endif #else - sigsetmask(context->sc_mask); + sigsetmask(context->sc_mask); #endif /* POSIX_SIGS */ - + #if ( defined( __linux__ ) && ( defined( i386 ) || defined ( __x86_64 ) ) ) - (*handler.c)(signal, contextstruct); + (*handler.c) (signal, contextstruct); #else - (*handler.c)(signal, code, context); + (*handler.c) (signal, code, context); #endif } - + #if !(defined(i386) || defined(__x86_64)) if (were_in_lisp) #endif - undo_fake_foreign_function_call(context); + undo_fake_foreign_function_call(context); } -static void +static void maybe_now_maybe_later(HANDLER_ARGS) { #if defined(__linux__) && (defined(i386) || defined(__x86_64)) GET_CONTEXT #endif - - SAVE_CONTEXT(); /**/ - - if (SymbolValue(INTERRUPTS_ENABLED) == NIL) { - pending_signal = signal; - pending_code = DEREFCODE(code); + SAVE_CONTEXT(); + /**/ if (SymbolValue(INTERRUPTS_ENABLED) == NIL) { + pending_signal = signal; + pending_code = DEREFCODE(code); #ifdef POSIX_SIGS #if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) - pending_mask = context->uc_sigmask; + pending_mask = context->uc_sigmask; FILLBLOCKSET(&context->uc_sigmask); #else { - sigset_t temp; - sigemptyset(&temp); - pending_mask.__val[0] = context->uc_sigmask; - temp.__val[0] = context->uc_sigmask; - FILLBLOCKSET(&temp); - - context->uc_sigmask = temp.__val[0]; + sigset_t temp; + + sigemptyset(&temp); + pending_mask.__val[0] = context->uc_sigmask; + temp.__val[0] = context->uc_sigmask; + FILLBLOCKSET(&temp); + + context->uc_sigmask = temp.__val[0]; } #endif #else - pending_mask = context->sc_mask; - context->sc_mask |= BLOCKABLE; + pending_mask = context->sc_mask; + context->sc_mask |= BLOCKABLE; #endif /* POSIX_SIGS */ - SetSymbolValue(INTERRUPT_PENDING, T); + SetSymbolValue(INTERRUPT_PENDING, T); } else if ( #if !(defined(i386) || defined(__x86_64)) - (!foreign_function_call_active) && + (!foreign_function_call_active) && #endif - arch_pseudo_atomic_atomic(context)) { - pending_signal = signal; - pending_code = DEREFCODE(code); + arch_pseudo_atomic_atomic(context)) { + pending_signal = signal; + pending_code = DEREFCODE(code); #ifdef POSIX_SIGS #if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) - pending_mask = context->uc_sigmask; + pending_mask = context->uc_sigmask; FILLBLOCKSET(&context->uc_sigmask); #else { - sigset_t temp; - sigemptyset(&temp); - pending_mask.__val[0] = context->uc_sigmask; - temp.__val[0] = context->uc_sigmask; - FILLBLOCKSET(&temp); - context->uc_sigmask = temp.__val[0]; + sigset_t temp; + + sigemptyset(&temp); + pending_mask.__val[0] = context->uc_sigmask; + temp.__val[0] = context->uc_sigmask; + FILLBLOCKSET(&temp); + context->uc_sigmask = temp.__val[0]; } #endif #else - pending_mask = context->sc_mask; - context->sc_mask |= BLOCKABLE; + pending_mask = context->sc_mask; + context->sc_mask |= BLOCKABLE; #endif /* POSIX_SIGS */ arch_set_pseudo_atomic_interrupted(context); } else { #if defined(__linux__) && (defined(i386) || defined(__x86_64)) - /* - * Restore the FPU control word, setting the rounding mode to nearest. - */ + /* + * Restore the FPU control word, setting the rounding mode to nearest. + */ - if (contextstruct.fpstate) + if (contextstruct.fpstate) #if defined(__x86_64) - setfpucw(contextstruct.fpstate->cwd & ~0xc00); + setfpucw(contextstruct.fpstate->cwd & ~0xc00); #else - setfpucw(contextstruct.fpstate->cw & ~0xc00); + setfpucw(contextstruct.fpstate->cw & ~0xc00); #endif #endif #if ( defined( __linux__ ) && ( defined( i386 ) || defined( __x86_64 ) ) ) - interrupt_handle_now(signal, contextstruct); + interrupt_handle_now(signal, contextstruct); #else - interrupt_handle_now(signal, code, context); + interrupt_handle_now(signal, code, context); #endif } @@ -471,30 +474,35 @@ maybe_now_maybe_later(HANDLER_ARGS) \****************************************************************/ #ifndef INTERNAL_GC_TRIGGER -static boolean gc_trigger_hit(HANDLER_ARGS) +static boolean +gc_trigger_hit(HANDLER_ARGS) { if (current_auto_gc_trigger == NULL) { return FALSE; } else { - lispobj *badaddr=(lispobj *)arch_get_bad_addr(signal, code, context); + lispobj *badaddr = (lispobj *) arch_get_bad_addr(signal, code, context); #ifdef PRINTNOISE - fprintf (stderr, "gc_trigger_hit: badaddr=%p, current_auto_gc_trigger=%p, limit=%p\n", - badaddr, current_auto_gc_trigger, - current_dynamic_space + dynamic_space_size); + fprintf(stderr, + "gc_trigger_hit: badaddr=%p, current_auto_gc_trigger=%p, limit=%p\n", + badaddr, current_auto_gc_trigger, + current_dynamic_space + dynamic_space_size); #endif return (badaddr >= current_auto_gc_trigger && - (unsigned long) badaddr < (unsigned long) current_dynamic_space + (unsigned long) dynamic_space_size); + (unsigned long) badaddr < + (unsigned long) current_dynamic_space + + (unsigned long) dynamic_space_size); } } #endif #if !(defined(i386) || defined(__x86_64)) -boolean interrupt_maybe_gc(HANDLER_ARGS) +boolean +interrupt_maybe_gc(HANDLER_ARGS) { if (!foreign_function_call_active #ifndef INTERNAL_GC_TRIGGER - && gc_trigger_hit(signal, code, context) + && gc_trigger_hit(signal, code, context) #endif ) { #ifndef INTERNAL_GC_TRIGGER @@ -506,17 +514,18 @@ boolean interrupt_maybe_gc(HANDLER_ARGS) if (pending_signal == 0) { #ifdef POSIX_SIGS #if !defined(__linux__) || (defined(__linux__) && (__GNU_LIBRARY__ < 6)) - pending_mask = context->uc_sigmask; + pending_mask = context->uc_sigmask; FILLBLOCKSET(&context->uc_sigmask); #else { - sigset_t temp; - sigemptyset(&temp); - pending_mask.__val[0] = context->uc_sigmask; - temp.__val[0] = context->uc_sigmask; - FILLBLOCKSET(&temp); + sigset_t temp; + + sigemptyset(&temp); + pending_mask.__val[0] = context->uc_sigmask; + temp.__val[0] = context->uc_sigmask; + FILLBLOCKSET(&temp); - context->uc_sigmask = temp.__val[0]; + context->uc_sigmask = temp.__val[0]; } #endif #else @@ -525,8 +534,7 @@ boolean interrupt_maybe_gc(HANDLER_ARGS) #endif /* POSIX_SIGS */ } arch_set_pseudo_atomic_interrupted(context); - } - else { + } else { fake_foreign_function_call(context); funcall0(SymbolFunction(MAYBE_GC)); undo_fake_foreign_function_call(context); @@ -548,63 +556,63 @@ static char altstack[SIGNAL_STACK_SIZE]; #endif void -interrupt_install_low_level_handler (int signal, void handler (HANDLER_ARGS)) +interrupt_install_low_level_handler(int signal, void handler(HANDLER_ARGS)) { #ifdef POSIX_SIGS - struct sigaction sa; - - sa.sa_sigaction = handler; - sigemptyset (&sa.sa_mask); - FILLBLOCKSET (&sa.sa_mask); - sa.sa_flags = SA_RESTART | USE_SA_SIGINFO; - - /* Deliver protection violations on a dedicated signal stack, - because, when we get that signal because of hitting a control - stack guard zone, it's not a good idea to use more of the - control stack for handling the signal. */ - /* But we only need this on x86 since the Lisp control stack and the - C control stack are the same. For others, they're separate so - the C stack can still be used. */ + struct sigaction sa; + + sa.sa_sigaction = handler; + sigemptyset(&sa.sa_mask); + FILLBLOCKSET(&sa.sa_mask); + sa.sa_flags = SA_RESTART | USE_SA_SIGINFO; + + /* Deliver protection violations on a dedicated signal stack, + because, when we get that signal because of hitting a control + stack guard zone, it's not a good idea to use more of the + control stack for handling the signal. */ + /* But we only need this on x86 since the Lisp control stack and the + C control stack are the same. For others, they're separate so + the C stack can still be used. */ #ifdef RED_ZONE_HIT - if (signal == PROTECTION_VIOLATION_SIGNAL) - { - stack_t sigstack; + if (signal == PROTECTION_VIOLATION_SIGNAL) { + stack_t sigstack; + #if (defined( i386 ) || defined(__x86_64)) - sigstack.ss_sp = (void *) SIGNAL_STACK_START; + sigstack.ss_sp = (void *) SIGNAL_STACK_START; #else - sigstack.ss_sp = (void *) altstack; + sigstack.ss_sp = (void *) altstack; #endif - sigstack.ss_flags = 0; - sigstack.ss_size = SIGNAL_STACK_SIZE; - if (sigaltstack (&sigstack, 0) == -1) - perror ("sigaltstack"); - sa.sa_flags |= SA_ONSTACK; + sigstack.ss_flags = 0; + sigstack.ss_size = SIGNAL_STACK_SIZE; + if (sigaltstack(&sigstack, 0) == -1) + perror("sigaltstack"); + sa.sa_flags |= SA_ONSTACK; } #endif /* RED_ZONE_HIT */ - sigaction (signal, &sa, NULL); - + sigaction(signal, &sa, NULL); + #else /* not POSIX_SIGNALS */ - struct sigvec sv; + struct sigvec sv; - sv.sv_handler = handler; - sv.sv_mask = BLOCKABLE; - sv.sv_flags = 0; - sigvec (signal, &sv, NULL); + sv.sv_handler = handler; + sv.sv_mask = BLOCKABLE; + sv.sv_flags = 0; + sigvec(signal, &sv, NULL); #endif /* not POSIX_SIGNALS */ - if (handler == (void (*)(HANDLER_ARGS)) SIG_DFL) - interrupt_low_level_handlers[signal] = 0; - else - interrupt_low_level_handlers[signal] = handler; + if (handler == (void (*)(HANDLER_ARGS)) SIG_DFL) + interrupt_low_level_handlers[signal] = 0; + else + interrupt_low_level_handlers[signal] = handler; } -unsigned long install_handler(int signal, - void handler(HANDLER_ARGS)) +unsigned long +install_handler(int signal, void handler(HANDLER_ARGS)) #ifdef POSIX_SIGS { struct sigaction sa; - sigset_t old,new; + sigset_t old, new; union interrupt_handler oldhandler; sigemptyset(&new); @@ -614,9 +622,9 @@ unsigned long install_handler(int signal, sigemptyset(&new); FILLBLOCKSET(&new); - if(interrupt_low_level_handlers[signal]==0){ - if(handler == (void (*)(HANDLER_ARGS)) SIG_DFL - || handler == (void (*)(HANDLER_ARGS)) SIG_IGN) + if (interrupt_low_level_handlers[signal] == 0) { + if (handler == (void (*)(HANDLER_ARGS)) SIG_DFL + || handler == (void (*)(HANDLER_ARGS)) SIG_IGN) sa.sa_sigaction = handler; else if (sigismember(&new, signal)) sa.sa_sigaction = maybe_now_maybe_later; @@ -645,9 +653,9 @@ unsigned long install_handler(int signal, oldmask = sigblock(sigmask(signal)); - if(interrupt_low_level_handlers[signal]==0){ - if(handler == (void (*)(HANDLER_ARGS)) SIG_DFL - || handler == (void (*)(HANDLER_ARGS)) SIG_IGN) + if (interrupt_low_level_handlers[signal] == 0) { + if (handler == (void (*)(HANDLER_ARGS)) SIG_DFL + || handler == (void (*)(HANDLER_ARGS)) SIG_IGN) sv.sv_handler = handler; else if (sigmask(signal) & BLOCKABLE) sv.sv_handler = maybe_now_maybe_later; @@ -670,34 +678,34 @@ unsigned long install_handler(int signal, #ifdef FEATURE_HEAP_OVERFLOW_CHECK void -interrupt_handle_space_overflow(lispobj error, os_context_t *context) +interrupt_handle_space_overflow(lispobj error, os_context_t * context) { #ifdef i386 - /* ECX is the argument count. */ + /* ECX is the argument count. */ #if USE_SA_SIGINFO - context->uc_mcontext.__gregs[_REG_EIP] == - (int) ((struct function *) PTR (error))->code; - context->uc_mcontext.__gregs[_REG_ECX] == 0; + context->uc_mcontext.__gregs[_REG_EIP] == + (int) ((struct function *) PTR(error))->code; + context->uc_mcontext.__gregs[_REG_ECX] == 0; #else - SC_PC(context) = (int) ((struct function *) PTR (error))->code; - context->sc_ecx = 0; + SC_PC(context) = (int) ((struct function *) PTR(error))->code; + context->sc_ecx = 0; #endif #else #ifdef __x86_64 - /* RCX is the argument count. */ - context->sc_rip = (unsigned long) ((struct function *) PTR (error))->code; - context->sc_rcx = 0; + /* RCX is the argument count. */ + context->sc_rip = (unsigned long) ((struct function *) PTR(error))->code; + context->sc_rcx = 0; #else #ifdef sparc - build_fake_control_stack_frame (context); - /* This part should be common to all non-x86 ports */ - SC_PC(context) = (long) ((struct function *) PTR (error))->code; - SC_NPC(context) = SC_PC(context) + 4; - SC_REG(context, reg_NARGS) = 0; - SC_REG(context, reg_LIP) = (long) ((struct function *) PTR (error))->code; - SC_REG(context, reg_CFP) = (long) current_control_frame_pointer; - /* This is sparc specific */ - SC_REG(context, reg_CODE) = ((long) PTR(error)) + type_FunctionPointer; + build_fake_control_stack_frame(context); + /* This part should be common to all non-x86 ports */ + SC_PC(context) = (long) ((struct function *) PTR(error))->code; + SC_NPC(context) = SC_PC(context) + 4; + SC_REG(context, reg_NARGS) = 0; + SC_REG(context, reg_LIP) = (long) ((struct function *) PTR(error))->code; + SC_REG(context, reg_CFP) = (long) current_control_frame_pointer; + /* This is sparc specific */ + SC_REG(context, reg_CODE) = ((long) PTR(error)) + type_FunctionPointer; #else #error interrupt_handle_space_overflow not implemented for this system #endif @@ -706,10 +714,11 @@ interrupt_handle_space_overflow(lispobj error, os_context_t *context) } #endif /* FEATURE_HEAP_OVERFLOW_CHECK */ -void interrupt_init(void) +void +interrupt_init(void) { int i; for (i = 0; i < NSIG; i++) - interrupt_handlers[i].c = (void (*)(HANDLER_ARGS)) SIG_DFL; + interrupt_handlers[i].c = (void (*)(HANDLER_ARGS)) SIG_DFL; } diff --git a/lisp/interrupt.h b/lisp/interrupt.h index fe01ce474..322277191 100644 --- a/lisp/interrupt.h +++ b/lisp/interrupt.h @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.h,v 1.9 2005/01/13 19:55:00 fgilham Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/interrupt.h,v 1.10 2005/09/15 18:26:51 rtoy Exp $ */ #ifndef _INTERRUPT_H_ #define _INTERRUPT_H_ @@ -10,25 +10,26 @@ extern os_context_t *lisp_interrupt_contexts[MAX_INTERRUPTS]; union interrupt_handler { - lispobj lisp; - void (*c)(HANDLER_ARGS); + lispobj lisp; + void (*c) (HANDLER_ARGS); }; extern void interrupt_init(void); -extern void fake_foreign_function_call(os_context_t *context); -extern void undo_fake_foreign_function_call(os_context_t *context); +extern void fake_foreign_function_call(os_context_t * context); +extern void undo_fake_foreign_function_call(os_context_t * context); extern void interrupt_handle_now(HANDLER_ARGS); -extern void interrupt_handle_pending(os_context_t *scp); +extern void interrupt_handle_pending(os_context_t * scp); extern void interrupt_internal_error(HANDLER_ARGS, boolean continuable); extern boolean interrupt_maybe_gc(HANDLER_ARGS); extern void interrupt_install_low_level_handler - (int signal, - void handler(HANDLER_ARGS)); -extern unsigned long install_handler(int signal, - void handler(HANDLER_ARGS)); -extern void build_fake_control_stack_frame(os_context_t* context); -extern void interrupt_handle_space_overflow(lispobj error, os_context_t *context); + (int signal, void handler(HANDLER_ARGS)); +extern unsigned long install_handler(int signal, void handler(HANDLER_ARGS)); + +extern void build_fake_control_stack_frame(os_context_t * context); +extern void interrupt_handle_space_overflow(lispobj error, + + os_context_t * context); extern union interrupt_handler interrupt_handlers[NSIG]; diff --git a/lisp/irix-asm-munge.c b/lisp/irix-asm-munge.c index c58cc4d08..843d344ba 100644 --- a/lisp/irix-asm-munge.c +++ b/lisp/irix-asm-munge.c @@ -29,72 +29,76 @@ #include "internals.h" struct nlist nl[] = { - {"mipsmungelra", 0, 0}, - {"undefined_tramp", 0, 0}, - {"function_end_breakpoint_guts", 0, 0}, - {NULL, 0, 0}}; + {"mipsmungelra", 0, 0}, + {"undefined_tramp", 0, 0}, + {"function_end_breakpoint_guts", 0, 0}, + {NULL, 0, 0} +}; main(int argc, char **argv) { - int fd; - Elf *elf; - Elf32_Ehdr *ehdr; - Elf_Scn *scn; - Elf_Data *data; - Elf32_Half ndx; - Elf32_Shdr *shdr; - unsigned int *textdata; - - if(argc != 2) exit(2); - - assert(!nlist(argv[1], nl)); - assert(nl[0].n_value && !(nl[0].n_value&0x3)); - assert(nl[1].n_value && !(nl[1].n_value&0x3)); - assert(nl[2].n_value && !(nl[2].n_value&0x3)); - - if(elf_version(EV_CURRENT) == EV_NONE) { - fprintf(stderr, "ELF punted! Recompile %s\n", argv[0]); - exit(1); - } - - fd = open(argv[1], O_RDWR); - if(fd < 0) { - perror("open"); - exit(1); - } - - elf = elf_begin(fd, ELF_C_RDWR, NULL); - - ehdr = elf32_getehdr(elf); - assert(ehdr); - /* want SHT_PROGBITS section named .text */ - ndx = ehdr->e_shstrndx; - scn = NULL; - while((scn = elf_nextscn(elf, scn))) { - char *name = NULL; - if((shdr = elf32_getshdr(scn))) - name = elf_strptr(elf, ndx, (size_t)shdr->sh_name); - if(!strcmp(name, ".text")) break; - } - - data = elf_getdata(scn, NULL); - assert(data && data->d_size && !data->d_off); - textdata = (unsigned int*)data->d_buf; - - /* process */ - assert(textdata[nl[0].n_value/4] == 0x000B000D); - textdata[nl[0].n_value/4] = type_ReturnPcHeader; - - assert(textdata[nl[1].n_value/4] == 0x000A000D); - assert(textdata[nl[1].n_value/4+1] == 0x000B000D); - assert(textdata[nl[1].n_value/4+2] == 0x000B000D); - textdata[nl[1].n_value/4+1] = 0x0417FECC; - textdata[nl[1].n_value/4+2] = 0x01000000; - - assert(textdata[nl[2].n_value/4] == 0x000B000D); - textdata[nl[2].n_value/4] = type_ReturnPcHeader; - - elf_flagdata(data, ELF_C_SET, ELF_F_DIRTY); - elf_update(elf, ELF_C_WRITE); - elf_end(elf); - } + int fd; + Elf *elf; + Elf32_Ehdr *ehdr; + Elf_Scn *scn; + Elf_Data *data; + Elf32_Half ndx; + Elf32_Shdr *shdr; + unsigned int *textdata; + + if (argc != 2) + exit(2); + + assert(!nlist(argv[1], nl)); + assert(nl[0].n_value && !(nl[0].n_value & 0x3)); + assert(nl[1].n_value && !(nl[1].n_value & 0x3)); + assert(nl[2].n_value && !(nl[2].n_value & 0x3)); + + if (elf_version(EV_CURRENT) == EV_NONE) { + fprintf(stderr, "ELF punted! Recompile %s\n", argv[0]); + exit(1); + } + + fd = open(argv[1], O_RDWR); + if (fd < 0) { + perror("open"); + exit(1); + } + + elf = elf_begin(fd, ELF_C_RDWR, NULL); + + ehdr = elf32_getehdr(elf); + assert(ehdr); + /* want SHT_PROGBITS section named .text */ + ndx = ehdr->e_shstrndx; + scn = NULL; + while ((scn = elf_nextscn(elf, scn))) { + char *name = NULL; + + if ((shdr = elf32_getshdr(scn))) + name = elf_strptr(elf, ndx, (size_t) shdr->sh_name); + if (!strcmp(name, ".text")) + break; + } + + data = elf_getdata(scn, NULL); + assert(data && data->d_size && !data->d_off); + textdata = (unsigned int *) data->d_buf; + + /* process */ + assert(textdata[nl[0].n_value / 4] == 0x000B000D); + textdata[nl[0].n_value / 4] = type_ReturnPcHeader; + + assert(textdata[nl[1].n_value / 4] == 0x000A000D); + assert(textdata[nl[1].n_value / 4 + 1] == 0x000B000D); + assert(textdata[nl[1].n_value / 4 + 2] == 0x000B000D); + textdata[nl[1].n_value / 4 + 1] = 0x0417FECC; + textdata[nl[1].n_value / 4 + 2] = 0x01000000; + + assert(textdata[nl[2].n_value / 4] == 0x000B000D); + textdata[nl[2].n_value / 4] = type_ReturnPcHeader; + + elf_flagdata(data, ELF_C_SET, ELF_F_DIRTY); + elf_update(elf, ELF_C_WRITE); + elf_end(elf); +} diff --git a/lisp/irix-os.c b/lisp/irix-os.c index 316a1a7d6..0ee781332 100644 --- a/lisp/irix-os.c +++ b/lisp/irix-os.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/irix-os.c,v 1.1 1994/07/05 16:09:23 hallgren Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/irix-os.c,v 1.2 2005/09/15 18:26:52 rtoy Exp $ * * OS-dependent routines. This file (along with os.h) exports an * OS-independent interface to the operating system VM facilities. @@ -25,108 +25,107 @@ /* #define DEBUG */ -os_vm_size_t os_vm_page_size=(-1); +os_vm_size_t os_vm_page_size = (-1); int zero_fd; void os_init() { - zero_fd = open("/dev/zero",O_RDONLY); - os_vm_page_size=getpagesize(); + zero_fd = open("/dev/zero", O_RDONLY); + os_vm_page_size = getpagesize(); } -os_vm_address_t -os_validate(os_vm_address_t addr, os_vm_size_t len) +os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len) { - int flags = MAP_PRIVATE|MAP_AUTORESRV; + int flags = MAP_PRIVATE | MAP_AUTORESRV; #ifdef DEBUG - printf("os_validate: addr = %x, len = %x\n",addr,len); + printf("os_validate: addr = %x, len = %x\n", addr, len); #endif - if(addr) flags|=MAP_FIXED; + if (addr) + flags |= MAP_FIXED; - if((addr=mmap(addr,len,OS_VM_PROT_ALL,flags,zero_fd,0)) == - (os_vm_address_t) -1) - perror("mmap"); + if ((addr = mmap(addr, len, OS_VM_PROT_ALL, flags, zero_fd, 0)) == + (os_vm_address_t) - 1) + perror("mmap"); - return addr; + return addr; } void os_invalidate(os_vm_address_t addr, os_vm_size_t len) { #ifdef DEBUG - printf("os_invalidate: addr = %x, len = %x\n",addr,len); + printf("os_invalidate: addr = %x, len = %x\n", addr, len); #endif - if(munmap(addr,len) == -1) - perror("munmap"); + if (munmap(addr, len) == -1) + perror("munmap"); } os_vm_address_t os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len) { #ifdef DEBUG - printf("os_map: fd = %d, offset = %d, addr = %x, len = %x\n",fd,offset,addr,len); + printf("os_map: fd = %d, offset = %d, addr = %x, len = %x\n", fd, offset, + addr, len); #endif - if((addr=mmap(addr,len,OS_VM_PROT_ALL,MAP_PRIVATE|MAP_FIXED,fd, - (off_t) offset)) == (os_vm_address_t) -1) - perror("mmap"); - - return addr; + if ((addr = mmap(addr, len, OS_VM_PROT_ALL, MAP_PRIVATE | MAP_FIXED, fd, + (off_t) offset)) == (os_vm_address_t) - 1) + perror("mmap"); + + return addr; } void sanctify_for_execution(os_vm_address_t addr, os_vm_size_t len) { - char* end_addr = addr+len; - addr = os_trunc_to_page(addr); - len = end_addr - addr; + char *end_addr = addr + len; + + addr = os_trunc_to_page(addr); + len = end_addr - addr; - if(mprotect(addr,len,OS_VM_PROT_ALL)== -1) - perror("mprotect"); + if (mprotect(addr, len, OS_VM_PROT_ALL) == -1) + perror("mprotect"); } void os_flush_icache(os_vm_address_t address, os_vm_size_t length) { - sanctify_for_execution(address,length); + sanctify_for_execution(address, length); } void os_protect(os_vm_address_t addr, os_vm_size_t len, os_vm_prot_t prot) { - if(mprotect(addr, len, prot) == -1) - perror("mprotect"); + if (mprotect(addr, len, prot) == -1) + perror("mprotect"); } -boolean -valid_addr(os_vm_address_t addr) +boolean valid_addr(os_vm_address_t addr) { } static void sigbus_handler(int signal, int code, struct sigcontext *context) { - if(!interrupt_maybe_gc(signal, code, context)) - interrupt_handle_now(signal, code, context); + if (!interrupt_maybe_gc(signal, code, context)) + interrupt_handle_now(signal, code, context); } static void sigsegv_handler(int signal, int code, struct sigcontext *context) { - if(!interrupt_maybe_gc(signal, code, context)) - interrupt_handle_now(signal, code, context); + if (!interrupt_maybe_gc(signal, code, context)) + interrupt_handle_now(signal, code, context); } -void +void os_install_interrupt_handlers(void) { - interrupt_install_low_level_handler(SIGSEGV,sigsegv_handler); - interrupt_install_low_level_handler(SIGBUS,sigbus_handler); + interrupt_install_low_level_handler(SIGSEGV, sigsegv_handler); + interrupt_install_low_level_handler(SIGBUS, sigbus_handler); } - - diff --git a/lisp/lisp.c b/lisp/lisp.c index 962296ded..34a098c8d 100644 --- a/lisp/lisp.c +++ b/lisp/lisp.c @@ -1,7 +1,7 @@ /* * main() entry point for a stand alone lisp image. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.49 2005/09/06 13:05:58 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/lisp.c,v 1.50 2005/09/15 18:26:52 rtoy Exp $ * */ @@ -33,55 +33,56 @@ #include "core.h" #include "save.h" #include "lispregs.h" + - /* SIGINT handler that invokes the monitor. */ -static void sigint_handler(HANDLER_ARGS) +static void +sigint_handler(HANDLER_ARGS) { #if ( defined( __linux__ ) && ( defined( i386 ) || defined ( __x86_64 ) ) ) - GET_CONTEXT + GET_CONTEXT #endif - - SAVE_CONTEXT(); + SAVE_CONTEXT(); printf("\nSIGINT hit at 0x%08lX\n", (unsigned long) SC_PC(context)); ldb_monitor(); } /* Not static, because we want to be able to call it from lisp land. */ -void sigint_init(void) +void +sigint_init(void) { install_handler(SIGINT, sigint_handler); } - + /* Noise to convert argv and envp into lists. */ -static lispobj alloc_str_list(char *list[]) +static lispobj +alloc_str_list(char *list[]) { lispobj result, newcons; struct cons *ptr; if (*list == NULL) - result = NIL; + result = NIL; else { - result = newcons = alloc_cons(alloc_string(*list++), NIL); + result = newcons = alloc_cons(alloc_string(*list++), NIL); - while (*list != NULL) { - ptr = (struct cons *)PTR(newcons); - newcons = alloc_cons(alloc_string(*list++), NIL); - ptr->cdr = newcons; - } + while (*list != NULL) { + ptr = (struct cons *) PTR(newcons); + newcons = alloc_cons(alloc_string(*list++), NIL); + ptr->cdr = newcons; + } } return result; } /* Default paths for CMUCLLIB */ -static char* cmucllib_search_list[] = -{ +static char *cmucllib_search_list[] = { "./.", "./../lib/cmucl/lib", "./../lib", @@ -107,13 +108,13 @@ static int debug_lisp_search = FALSE; * default for CMUCLLIB */ char * -default_cmucllib(const char* argv0arg) +default_cmucllib(const char *argv0arg) { - char* p; - char* defpath; - char* cwd; + char *p; + char *defpath; + char *cwd; char *argv0_dir = strdup(argv0arg); - + /* * From argv[0], create the appropriate directory by lopping off the * executable name @@ -121,150 +122,151 @@ default_cmucllib(const char* argv0arg) p = strrchr(argv0_dir, '/'); if (p == NULL) { - *argv0_dir = '\0'; + *argv0_dir = '\0'; } else if (p != argv0_dir) { - *p = '\0'; + *p = '\0'; } - + /* * Create the full pathname of the directory containing the * executable. argv[0] can be an absolute or relative path. */ if (debug_lisp_search) { - fprintf(stderr, "argv[0] = %s\n", argv0arg); - fprintf(stderr, "argv_dir = %s\n", argv0_dir); + fprintf(stderr, "argv[0] = %s\n", argv0arg); + fprintf(stderr, "argv_dir = %s\n", argv0_dir); } - - + + if (argv0_dir[0] == '/') { - cwd = malloc(strlen(argv0_dir) + 2); - strcpy(cwd, argv0_dir); - strcat(cwd, "/"); - if (debug_lisp_search) { - fprintf(stderr, "absolute path, argv[0] = %s\n", cwd); - } - + cwd = malloc(strlen(argv0_dir) + 2); + strcpy(cwd, argv0_dir); + strcat(cwd, "/"); + if (debug_lisp_search) { + fprintf(stderr, "absolute path, argv[0] = %s\n", cwd); + } + } else if (*argv0_dir != '\0') { - /* - * argv[0] is a relative path. Get the current directory and - * append argv[0], after stripping off the executable name. - */ - cwd = malloc(MAXPATHLEN + strlen(argv0_dir) + 100); - getcwd(cwd, MAXPATHLEN); - strcat(cwd, "/"); - if (*argv0_dir != '\0') { - strcat(cwd, argv0_dir); - strcat(cwd, "/"); - } - if (debug_lisp_search) { - fprintf(stderr, "relative path, argv[0] = %s\n", cwd); - } + /* + * argv[0] is a relative path. Get the current directory and + * append argv[0], after stripping off the executable name. + */ + cwd = malloc(MAXPATHLEN + strlen(argv0_dir) + 100); + getcwd(cwd, MAXPATHLEN); + strcat(cwd, "/"); + if (*argv0_dir != '\0') { + strcat(cwd, argv0_dir); + strcat(cwd, "/"); + } + if (debug_lisp_search) { + fprintf(stderr, "relative path, argv[0] = %s\n", cwd); + } } else { - /* - * argv[0] is someplace on the user's PATH - * - */ - char *path = getenv("PATH"); - char *p1, *p2 = NULL; - struct stat buf; - - if (debug_lisp_search) { - fprintf(stderr, "User's PATH = %s\n", path ? path : "<NULL>"); - } - - cwd = malloc(MAXPATHLEN + strlen(argv0arg) + 100); - cwd[0] = '\0'; - - if (path) { - - if (p == NULL) { - p = argv0arg; - } - - for (p1 = path ; *p1 != '\0' ; p1 = p2) { - p2 = strchr(p1, ':'); - if (p2 == NULL) - p2 = p1 + strlen(p1); - strncpy(cwd, p1, p2 - p1); - cwd[p2 - p1] = '/'; - cwd[p2 - p1 + 1] = '\0'; - strcpy(cwd + (p2 - p1 + 1), p); - - if (debug_lisp_search) { - fprintf(stderr, "User's PATH, trying %s\n", cwd); - } - - if (stat(cwd, &buf) == 0) { - - if (debug_lisp_search) { - fprintf(stderr, "User's PATH, found %s\n", cwd); - } - if (access(cwd, X_OK) == 0) { - break; - } else { - if (debug_lisp_search) { - fprintf(stderr, " But not executable. Continuing...\n"); - } - } - - } - - if (*p2 == ':') { - p2++; - } - - } - if ((p1 == p2) || (p2 == NULL)) { - cwd[0] = '\0'; - } else { - cwd[p2 - p1 + 1] = '\0'; - } - if (debug_lisp_search) { - fprintf(stderr, "User's PATH, Final cwd %s\n", cwd); - } - - } + /* + * argv[0] is someplace on the user's PATH + * + */ + char *path = getenv("PATH"); + char *p1, *p2 = NULL; + struct stat buf; + + if (debug_lisp_search) { + fprintf(stderr, "User's PATH = %s\n", path ? path : "<NULL>"); + } + + cwd = malloc(MAXPATHLEN + strlen(argv0arg) + 100); + cwd[0] = '\0'; + + if (path) { + + if (p == NULL) { + p = argv0arg; + } + + for (p1 = path; *p1 != '\0'; p1 = p2) { + p2 = strchr(p1, ':'); + if (p2 == NULL) + p2 = p1 + strlen(p1); + strncpy(cwd, p1, p2 - p1); + cwd[p2 - p1] = '/'; + cwd[p2 - p1 + 1] = '\0'; + strcpy(cwd + (p2 - p1 + 1), p); + + if (debug_lisp_search) { + fprintf(stderr, "User's PATH, trying %s\n", cwd); + } + + if (stat(cwd, &buf) == 0) { + + if (debug_lisp_search) { + fprintf(stderr, "User's PATH, found %s\n", cwd); + } + if (access(cwd, X_OK) == 0) { + break; + } else { + if (debug_lisp_search) { + fprintf(stderr, + " But not executable. Continuing...\n"); + } + } + + } + + if (*p2 == ':') { + p2++; + } + + } + if ((p1 == p2) || (p2 == NULL)) { + cwd[0] = '\0'; + } else { + cwd[p2 - p1 + 1] = '\0'; + } + if (debug_lisp_search) { + fprintf(stderr, "User's PATH, Final cwd %s\n", cwd); + } + + } } /* Create the appropriate value for CMUCLLIB */ { - char** ptr; - int total_len; - int cwd_len; - + char **ptr; + int total_len; + int cwd_len; + /* First figure out how much space we need */ - total_len = 0; - cwd_len = strlen(cwd); + total_len = 0; + cwd_len = strlen(cwd); + + ptr = cmucllib_search_list; - ptr = cmucllib_search_list; - - while (*ptr != NULL) { - /* Plus 2 for the ":" and "/" we need to add */ - total_len += strlen(*ptr) + cwd_len + 2; - ++ptr; - } + while (*ptr != NULL) { + /* Plus 2 for the ":" and "/" we need to add */ + total_len += strlen(*ptr) + cwd_len + 2; + ++ptr; + } /* Create the colon separated list of directories */ - - defpath = malloc(total_len + 1); + + defpath = malloc(total_len + 1); *defpath = '\0'; - ptr = cmucllib_search_list; - while (*ptr != NULL) { - if (*ptr[0] != '/') { - strcat(defpath, cwd); - } - - strcat(defpath, *ptr); - - if (ptr[1] != NULL) { - strcat(defpath, ":"); - } - - ++ptr; - } + ptr = cmucllib_search_list; + while (*ptr != NULL) { + if (*ptr[0] != '/') { + strcat(defpath, cwd); + } + + strcat(defpath, *ptr); + + if (ptr[1] != NULL) { + strcat(defpath, ":"); + } + + ++ptr; + } if (strlen(defpath) > total_len) { abort(); @@ -284,8 +286,8 @@ default_cmucllib(const char* argv0arg) * Return the full path, if found, or NULL if not. */ -char* -search_core(const char* lib, const char* default_core) +char * +search_core(const char *lib, const char *default_core) { char *buf; char *dst; @@ -295,7 +297,7 @@ search_core(const char* lib, const char* default_core) * slash, and a the string terminator */ buf = malloc(strlen(lib) + strlen(default_core) + 2); - + do { dst = buf; /* @@ -309,20 +311,20 @@ search_core(const char* lib, const char* default_core) strcpy(dst, default_core); /* If it exists, we are done! */ - if (debug_lisp_search) { - fprintf(stderr, "Looking at `%s'\n", buf); - } - + if (debug_lisp_search) { + fprintf(stderr, "Looking at `%s'\n", buf); + } + if (access(buf, R_OK) == 0) { - if (debug_lisp_search) { - fprintf(stderr, "Found it!\n"); - } - - return buf; - } else { - if (debug_lisp_search) { - fprintf(stderr, "Found it, but we can't read it!\n"); - } + if (debug_lisp_search) { + fprintf(stderr, "Found it!\n"); + } + + return buf; + } else { + if (debug_lisp_search) { + fprintf(stderr, "Found it, but we can't read it!\n"); + } } } while (*lib++ == ':'); @@ -336,14 +338,14 @@ search_core(const char* lib, const char* default_core) * * Return the new lib path. */ -char* -prepend_core_path(char* lib, char* corefile) +char * +prepend_core_path(char *lib, char *corefile) { char cwd[MAXPATHLEN]; char *path; char *result; char *sep; - + if (*corefile == '/') { path = strdup(corefile); } else { @@ -396,7 +398,8 @@ long initial_function_addr = 0; /* And here be main. */ -int main(int argc, char *argv[], char *envp[]) +int +main(int argc, char *argv[], char *envp[]) { char *arg, **argptr; char *core = NULL; @@ -408,7 +411,7 @@ int main(int argc, char *argv[], char *envp[]) lispobj initial_function = 0; if (builtin_image_flag != 0) - initial_function = (lispobj) &initial_function_addr; + initial_function = (lispobj) & initial_function_addr; #if defined(SVR4) || defined(__linux__) tzset(); @@ -417,7 +420,7 @@ int main(int argc, char *argv[], char *envp[]) set_lossage_handler(ldb_monitor); monitor = FALSE; - + #ifdef DEFAULT_DYNAMIC_SPACE_SIZE dynamic_space_size = DEFAULT_DYNAMIC_SPACE_SIZE; #else @@ -425,89 +428,79 @@ int main(int argc, char *argv[], char *envp[]) #endif argptr = argv; - while ((arg = *++argptr) != NULL) - { - if (strcmp(arg, "-core") == 0) - { + while ((arg = *++argptr) != NULL) { + if (strcmp(arg, "-core") == 0) { if (builtin_image_flag) { - fprintf(stderr, "Cannot specify core file in executable image --- sorry about that.\n"); - exit(1); - } - if (core != NULL) - { - fprintf(stderr, "can only specify one core file.\n"); - exit(1); - } - core = *++argptr; - if (core == NULL) - { - fprintf(stderr, "-core must be followed by the name of the core file to use.\n"); - exit(1); - } - } - else if (strcmp(arg, "-lib") == 0) - { + fprintf(stderr, + "Cannot specify core file in executable image --- sorry about that.\n"); + exit(1); + } + if (core != NULL) { + fprintf(stderr, "can only specify one core file.\n"); + exit(1); + } + core = *++argptr; + if (core == NULL) { + fprintf(stderr, + "-core must be followed by the name of the core file to use.\n"); + exit(1); + } + } else if (strcmp(arg, "-lib") == 0) { lib = *++argptr; - if (lib == NULL) - { - fprintf(stderr, "-lib must be followed by a string denoting the CMUCL library path.\n"); + if (lib == NULL) { + fprintf(stderr, + "-lib must be followed by a string denoting the CMUCL library path.\n"); + exit(1); + } + } else if (strcmp(arg, "-dynamic-space-size") == 0) { + char *str; + + str = *++argptr; + if (str == NULL) { + fprintf(stderr, + "-dynamic-space-size must be followed by the size to use in MBytes.\n"); exit(1); - } - } - else if (strcmp(arg, "-dynamic-space-size") == 0) - { - char *str; - - str = *++argptr; - if (str == NULL) - { - fprintf(stderr, "-dynamic-space-size must be followed by the size to use in MBytes.\n"); - exit(1); - } + } #ifndef sparc dynamic_space_size = atoi(str) * 1024 * 1024; #else - { - int val; - - /* - * Martin Rydstrom says core sizes that aren't a - * multiple of 8 MB eventually causes GC lossage with - * gencgc on Solaris 10. No one seems to understand why - * that is, but it is. So here we enforce the 8 MB - * boundary by rounding up the size. We print a warning - * message if we do have to round. - * - * We do this for all versions, since it doesn't hurt - * other versions of Solaris. - */ - val = atoi(str); - dynamic_space_size = (val + 7) & ~7; - - if (val != dynamic_space_size) - { - fprintf(stderr, "Note: Rounding dynamic-space-size from %d MB to %d MB\n", - val, dynamic_space_size); - } - dynamic_space_size *= 1024 * 1024; - } + { + int val; + + /* + * Martin Rydstrom says core sizes that aren't a + * multiple of 8 MB eventually causes GC lossage with + * gencgc on Solaris 10. No one seems to understand why + * that is, but it is. So here we enforce the 8 MB + * boundary by rounding up the size. We print a warning + * message if we do have to round. + * + * We do this for all versions, since it doesn't hurt + * other versions of Solaris. + */ + val = atoi(str); + dynamic_space_size = (val + 7) & ~7; + + if (val != dynamic_space_size) { + fprintf(stderr, + "Note: Rounding dynamic-space-size from %d MB to %d MB\n", + val, dynamic_space_size); + } + dynamic_space_size *= 1024 * 1024; + } #endif - if (dynamic_space_size > DYNAMIC_SPACE_SIZE) - { - fprintf(stderr, "-dynamic-space-size must be no greater than %d MBytes.\n", + if (dynamic_space_size > DYNAMIC_SPACE_SIZE) { + fprintf(stderr, + "-dynamic-space-size must be no greater than %d MBytes.\n", DYNAMIC_SPACE_SIZE / (1024 * 1024)); - exit(1); - } - } - else if (strcmp(arg, "-monitor") == 0) - { + exit(1); + } + } else if (strcmp(arg, "-monitor") == 0) { monitor = TRUE; - } - else if (strcmp(arg, "-debug-lisp-search") == 0) - { - debug_lisp_search = TRUE; - } - } + } else if (strcmp(arg, "-debug-lisp-search") == 0) { + debug_lisp_search = TRUE; + } + } default_core = arch_init(); if (default_core == NULL) @@ -516,7 +509,7 @@ int main(int argc, char *argv[], char *envp[]) os_init(); #if defined(__FreeBSD__) || defined(__linux__) if (builtin_image_flag != 0) - map_core_sections(argv[0]); + map_core_sections(argv[0]); #endif validate(); gc_init(); @@ -526,28 +519,28 @@ int main(int argc, char *argv[], char *envp[]) * use of mmap() by malloc(). */ define_var("nil", NIL, TRUE); - define_var("t" , T, TRUE); + define_var("t", T, TRUE); /* * Basic algorithm for setting CMUCLLIB and CMUCLCORE, from Pierre * Mai. * * if CMUCLLIB envvar is not set - * CMUCLLIB = our list of places to look - * if -core option/CMUCLCORE given - * CMUCLLIB = CMUCLLIB + full path to the specified core file - * endif + * CMUCLLIB = our list of places to look + * if -core option/CMUCLCORE given + * CMUCLLIB = CMUCLLIB + full path to the specified core file + * endif * endif * * if -core option/CMUCLCORE unset - * search for a core file (named whatever arch_init returns or - * lisp.core) somewhere in the CMUCLLIB list. + * search for a core file (named whatever arch_init returns or + * lisp.core) somewhere in the CMUCLLIB list. * endif * * if core found - * use that + * use that * else - * give error message and die + * give error message and die * endif * * CMUCLCORE = where the core file was found/specced @@ -589,53 +582,55 @@ int main(int argc, char *argv[], char *envp[]) } - /* Only look for a core file if we're not using a built-in image.*/ + /* Only look for a core file if we're not using a built-in image. */ if (builtin_image_flag == 0) { - /* - * If no core file specified, search for it in CMUCLLIB - */ - if (core == NULL) { - if (getenv("CMUCLCORE") == NULL) { - core = search_core(cmucllib, default_core); - } else { - core = getenv("CMUCLCORE"); - } - } - - /* Die if the core file doesn't exist. */ - { - struct stat statbuf; - - if (stat(core, &statbuf) != 0) { - /* Can't find it so print a message and exit */ - fprintf(stderr, "Cannot find core file"); - if (core != NULL) { - fprintf(stderr, " %s", core); - } - fprintf(stderr, "\n"); - fprintf(stderr, "Based on lisp binary path `%s'\n", argv[0]); - exit(1); - } - } + /* + * If no core file specified, search for it in CMUCLLIB + */ + if (core == NULL) { + if (getenv("CMUCLCORE") == NULL) { + core = search_core(cmucllib, default_core); + } else { + core = getenv("CMUCLCORE"); + } + } + + /* Die if the core file doesn't exist. */ + { + struct stat statbuf; + + if (stat(core, &statbuf) != 0) { + /* Can't find it so print a message and exit */ + fprintf(stderr, "Cannot find core file"); + if (core != NULL) { + fprintf(stderr, " %s", core); + } + fprintf(stderr, "\n"); + fprintf(stderr, "Based on lisp binary path `%s'\n", argv[0]); + exit(1); + } + } } else { - /* The "core file" is the executable. We have to do this - * because this file actually gets checked for later." - */ - core = argv[0]; + /* The "core file" is the executable. We have to do this + * because this file actually gets checked for later." + */ + core = argv[0]; } globals_init(); - if(builtin_image_flag != 0) { - extern int image_dynamic_space_size; - long allocation_pointer = (long) dynamic_0_space + (int)&image_dynamic_space_size; + if (builtin_image_flag != 0) { + extern int image_dynamic_space_size; + long allocation_pointer = + + (long) dynamic_0_space + (int) &image_dynamic_space_size; #if defined(i386) || defined(__x86_64) - SetSymbolValue(ALLOCATION_POINTER, (lispobj)allocation_pointer); + SetSymbolValue(ALLOCATION_POINTER, (lispobj) allocation_pointer); #else - current_dynamic_space_free_pointer = (lispobj*)allocation_pointer; + current_dynamic_space_free_pointer = (lispobj *) allocation_pointer; #endif } else { - initial_function = load_core_file(core); + initial_function = load_core_file(core); } #if defined LINKAGE_TABLE @@ -647,16 +642,17 @@ int main(int argc, char *argv[], char *envp[]) #else #if defined WANT_CGC && defined X86_CGC_ACTIVE_P { - extern int use_cgc_p; - lispobj x = SymbolValue(X86_CGC_ACTIVE_P); - if(x != type_UnboundMarker && x != NIL) - use_cgc_p = 1; /* enable allocator */ + extern int use_cgc_p; + lispobj x = SymbolValue(X86_CGC_ACTIVE_P); + + if (x != type_UnboundMarker && x != NIL) + use_cgc_p = 1; /* enable allocator */ } #endif #endif #ifdef BINDING_STACK_POINTER - SetSymbolValue(BINDING_STACK_POINTER, (lispobj)binding_stack); + SetSymbolValue(BINDING_STACK_POINTER, (lispobj) binding_stack); #endif #if defined INTERNAL_GC_TRIGGER && !defined i386 SetSymbolValue(INTERNAL_GC_TRIGGER, make_fixnum(-1)); @@ -680,18 +676,17 @@ int main(int argc, char *argv[], char *envp[]) /* Set cmucllib and cmuclcore appropriately */ SetSymbolValue(CMUCL_LIB, alloc_string(cmucllib)); SetSymbolValue(CMUCL_CORE_PATH, alloc_string(core)); - + /* * Parse the command line again, picking up values that override * those loaded from the core. */ argptr = argv; - while ((arg = *++argptr) != NULL) - { + while ((arg = *++argptr) != NULL) { if (strcmp(arg, "-batch") == 0) - SetSymbolValue(BATCH_MODE, T); - } + SetSymbolValue(BATCH_MODE, T); + } /* * Pick off sigint until the lisp system gets far enough along to @@ -700,13 +695,13 @@ int main(int argc, char *argv[], char *envp[]) sigint_init(); if (monitor) { - while (1) { - ldb_monitor(); - } + while (1) { + ldb_monitor(); + } } else { funcall0(initial_function); printf("Initial function returned?\n"); exit(1); } - return 0; /* not reached */ + return 0; /* not reached */ } diff --git a/lisp/mach-os.c b/lisp/mach-os.c index 70809902f..ac07ac4f7 100644 --- a/lisp/mach-os.c +++ b/lisp/mach-os.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/mach-os.c,v 1.3 1992/09/16 22:26:53 wlott Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/mach-os.c,v 1.4 2005/09/15 18:26:52 rtoy Exp $ * * OS-dependent routines. This file (along with os.h) exports an * OS-independent interface to the operating system VM facilities. @@ -30,22 +30,25 @@ static int segments = -1; vm_size_t os_vm_page_size; #if defined(i386) || defined(parisc) -mach_port_t task_self() +mach_port_t +task_self() { return mach_task_self(); } #endif -void os_init() +void +os_init() { - os_vm_page_size = vm_page_size; + os_vm_page_size = vm_page_size; } -os_vm_address_t os_validate(vm_address_t addr, vm_size_t len) +os_vm_address_t +os_validate(vm_address_t addr, vm_size_t len) { kern_return_t res; - res = vm_allocate(task_self(), &addr, len, addr==NULL); + res = vm_allocate(task_self(), &addr, len, addr == NULL); if (res != KERN_SUCCESS) return 0; @@ -53,24 +56,26 @@ os_vm_address_t os_validate(vm_address_t addr, vm_size_t len) segments = -1; vm_protect(task_self(), addr, len, FALSE, - VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE); + VM_PROT_READ | VM_PROT_WRITE | VM_PROT_EXECUTE); return addr; } -void os_invalidate(vm_address_t addr, vm_size_t len) +void +os_invalidate(vm_address_t addr, vm_size_t len) { kern_return_t res; res = vm_deallocate(task_self(), addr, len); if (res != KERN_SUCCESS) - mach_error("Could not vm_allocate memory: ", res); + mach_error("Could not vm_allocate memory: ", res); segments = -1; } -vm_address_t os_map(int fd, int offset, vm_address_t addr, vm_size_t len) +vm_address_t +os_map(int fd, int offset, vm_address_t addr, vm_size_t len) { kern_return_t res; @@ -78,9 +83,10 @@ vm_address_t os_map(int fd, int offset, vm_address_t addr, vm_size_t len) if (res != KERN_SUCCESS) { char buf[256]; + sprintf(buf, "Could not map_fd(%d, %d, 0x%08x, 0x%08x): ", fd, offset, addr, len); - mach_error(buf, res); + mach_error(buf, res); lseek(fd, offset, L_SET); read(fd, addr, len); @@ -89,33 +95,36 @@ vm_address_t os_map(int fd, int offset, vm_address_t addr, vm_size_t len) segments = -1; vm_protect(task_self(), addr, len, FALSE, - VM_PROT_READ|VM_PROT_WRITE|VM_PROT_EXECUTE); + VM_PROT_READ | VM_PROT_WRITE | VM_PROT_EXECUTE); return addr; } -void os_flush_icache(vm_address_t address, vm_size_t length) +void +os_flush_icache(vm_address_t address, vm_size_t length) { #ifdef mips - vm_machine_attribute_val_t flush; - kern_return_t kr; + vm_machine_attribute_val_t flush; + kern_return_t kr; - flush = MATTR_VAL_ICACHE_FLUSH; + flush = MATTR_VAL_ICACHE_FLUSH; - kr = vm_machine_attribute(task_self(), address, length, - MATTR_CACHE, &flush); - if (kr != KERN_SUCCESS) - mach_error("Could not flush the instruction cache", kr); + kr = vm_machine_attribute(task_self(), address, length, + MATTR_CACHE, &flush); + if (kr != KERN_SUCCESS) + mach_error("Could not flush the instruction cache", kr); #endif } -void os_protect(vm_address_t address, vm_size_t length, vm_prot_t protection) +void +os_protect(vm_address_t address, vm_size_t length, vm_prot_t protection) { - vm_protect(task_self(), address, length, FALSE, protection); + vm_protect(task_self(), address, length, FALSE, protection); } -boolean valid_addr(test) -vm_address_t test; +boolean +valid_addr(test) + vm_address_t test; { vm_address_t addr; vm_size_t size; @@ -123,47 +132,53 @@ vm_address_t test; int curseg; if (segments == -1) { - addr = 0; - curseg = 0; - - while (1) { - if (vm_region(task_self(), &addr, &size, &bullshit, &bullshit, &bullshit, &bullshit, &bullshit, &bullshit) != KERN_SUCCESS) - break; - - if (curseg > 0 && addr_map[curseg-1].start + addr_map[curseg-1].length == addr) - addr_map[curseg-1].length += size; - else { - addr_map[curseg].start = addr; - addr_map[curseg].length = size; - curseg++; - } - - addr += size; - } - - segments = curseg; + addr = 0; + curseg = 0; + + while (1) { + if (vm_region + (task_self(), &addr, &size, &bullshit, &bullshit, &bullshit, + &bullshit, &bullshit, &bullshit) != KERN_SUCCESS) + break; + + if (curseg > 0 + && addr_map[curseg - 1].start + addr_map[curseg - 1].length == + addr) addr_map[curseg - 1].length += size; + else { + addr_map[curseg].start = addr; + addr_map[curseg].length = size; + curseg++; + } + + addr += size; + } + + segments = curseg; } - + for (curseg = 0; curseg < segments; curseg++) - if (addr_map[curseg].start <= test && test < addr_map[curseg].start + addr_map[curseg].length) - return TRUE; + if (addr_map[curseg].start <= test + && test < addr_map[curseg].start + addr_map[curseg].length) + return TRUE; return FALSE; } #ifndef ibmrt -static void sigbus_handler(int signal, int code, struct sigcontext *context) +static void +sigbus_handler(int signal, int code, struct sigcontext *context) { - if(!interrupt_maybe_gc(signal, code, context)) + if (!interrupt_maybe_gc(signal, code, context)) interrupt_handle_now(signal, code, context); } #endif -void os_install_interrupt_handlers(void) +void +os_install_interrupt_handlers(void) { #ifndef ibmrt - interrupt_install_low_level_handler(SIGBUS,sigbus_handler); + interrupt_install_low_level_handler(SIGBUS, sigbus_handler); #endif #ifdef mips - interrupt_install_low_level_handler(SIGSEGV,sigbus_handler); + interrupt_install_low_level_handler(SIGSEGV, sigbus_handler); #endif } diff --git a/lisp/mips-arch.c b/lisp/mips-arch.c index 2c0dfabbd..b0f13f3ab 100644 --- a/lisp/mips-arch.c +++ b/lisp/mips-arch.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/mips-arch.c,v 1.9 1994/10/27 17:13:54 ram Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/mips-arch.c,v 1.10 2005/09/15 18:26:52 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -30,134 +30,143 @@ #include "interr.h" #include "breakpoint.h" -char *arch_init(void) +char * +arch_init(void) { return NULL; } -os_vm_address_t arch_get_bad_addr(int sig, int code, struct sigcontext *scp) +os_vm_address_t +arch_get_bad_addr(int sig, int code, struct sigcontext * scp) { /* Finding the bad address on the mips is easy. */ - return (os_vm_address_t)scp->sc_badvaddr; + return (os_vm_address_t) scp->sc_badvaddr; } #ifdef irix void emulate_branch(struct sigcontext *scp, unsigned long inst) { - long opcode = inst >> 26; - long r1 = (inst >> 21) & 0x1f; - long r2 = (inst >> 16) & 0x1f; - long bdisp = (inst&(1<<15)) ? inst | (-1 << 16) : inst&0xffff; - long jdisp = (inst&(1<<25)) ? inst | (-1 << 26) : inst&0xffff; - long disp = 0; - - switch(opcode) { - case 0x1: /* bltz, bgez, bltzal, bgezal */ - switch((inst >> 16) & 0x1f) { - case 0x00: /* bltz */ - if(scp->sc_regs[r1] < 0) - disp = bdisp; - break; - case 0x01: /* bgez */ - if(scp->sc_regs[r1] >= 0) - disp = bdisp; - break; - case 0x10: /* bltzal */ - if(scp->sc_regs[r1] < 0) - disp = bdisp; - scp->sc_regs[31] = scp->sc_pc + 4; - break; - case 0x11: /* bgezal */ - if(scp->sc_regs[r1] >= 0) - disp = bdisp; - scp->sc_regs[31] = scp->sc_pc + 4; - break; + long opcode = inst >> 26; + long r1 = (inst >> 21) & 0x1f; + long r2 = (inst >> 16) & 0x1f; + long bdisp = (inst & (1 << 15)) ? inst | (-1 << 16) : inst & 0xffff; + long jdisp = (inst & (1 << 25)) ? inst | (-1 << 26) : inst & 0xffff; + long disp = 0; + + switch (opcode) { + case 0x1: /* bltz, bgez, bltzal, bgezal */ + switch ((inst >> 16) & 0x1f) { + case 0x00: /* bltz */ + if (scp->sc_regs[r1] < 0) + disp = bdisp; + break; + case 0x01: /* bgez */ + if (scp->sc_regs[r1] >= 0) + disp = bdisp; + break; + case 0x10: /* bltzal */ + if (scp->sc_regs[r1] < 0) + disp = bdisp; + scp->sc_regs[31] = scp->sc_pc + 4; + break; + case 0x11: /* bgezal */ + if (scp->sc_regs[r1] >= 0) + disp = bdisp; + scp->sc_regs[31] = scp->sc_pc + 4; + break; + } + break; + case 0x4: /* beq */ + if (scp->sc_regs[r1] == scp->sc_regs[r2]) + disp = bdisp; + break; + case 0x5: /* bne */ + if (scp->sc_regs[r1] != scp->sc_regs[r2]) + disp = bdisp; + break; + case 0x6: /* ble */ + if (scp->sc_regs[r1] <= scp->sc_regs[r2]) + disp = bdisp; + break; + case 0x7: /* bgtz */ + if (scp->sc_regs[r1] >= scp->sc_regs[r2]) + disp = bdisp; + break; + case 0x2: /* j */ + disp = jdisp; + break; + case 0x3: /* jal */ + disp = jdisp; + scp->sc_regs[31] = scp->sc_pc + 4; + break; } - break; - case 0x4: /* beq */ - if(scp->sc_regs[r1] == scp->sc_regs[r2]) - disp = bdisp; - break; - case 0x5: /* bne */ - if(scp->sc_regs[r1] != scp->sc_regs[r2]) - disp = bdisp; - break; - case 0x6: /* ble */ - if(scp->sc_regs[r1] <= scp->sc_regs[r2]) - disp = bdisp; - break; - case 0x7: /* bgtz */ - if(scp->sc_regs[r1] >= scp->sc_regs[r2]) - disp = bdisp; - break; - case 0x2: /* j */ - disp = jdisp; - break; - case 0x3: /* jal */ - disp = jdisp; - scp->sc_regs[31] = scp->sc_pc + 4; - break; - } - scp->sc_pc += disp*4; + scp->sc_pc += disp * 4; } #endif -void arch_skip_instruction(scp) -struct sigcontext *scp; +void +arch_skip_instruction(scp) + struct sigcontext *scp; { /* Skip the offending instruction */ if (scp->sc_cause & CAUSE_BD) - emulate_branch(scp, *(unsigned long *)scp->sc_pc); + emulate_branch(scp, *(unsigned long *) scp->sc_pc); else - scp->sc_pc += 4; + scp->sc_pc += 4; } -unsigned char *arch_internal_error_arguments(struct sigcontext *scp) +unsigned char * +arch_internal_error_arguments(struct sigcontext *scp) { if (scp->sc_cause & CAUSE_BD) - return (unsigned char *)(scp->sc_pc+8); + return (unsigned char *) (scp->sc_pc + 8); else - return (unsigned char *)(scp->sc_pc+4); + return (unsigned char *) (scp->sc_pc + 4); } -boolean arch_pseudo_atomic_atomic(struct sigcontext *scp) +boolean +arch_pseudo_atomic_atomic(struct sigcontext *scp) { return (scp->sc_regs[reg_ALLOC] & 1); } #define PSEUDO_ATOMIC_INTERRUPTED_BIAS 0x7f000000 -void arch_set_pseudo_atomic_interrupted(struct sigcontext *scp) +void +arch_set_pseudo_atomic_interrupted(struct sigcontext *scp) { scp->sc_regs[reg_NL4] += PSEUDO_ATOMIC_INTERRUPTED_BIAS; } -unsigned long arch_install_breakpoint(void *pc) +unsigned long +arch_install_breakpoint(void *pc) { - unsigned long *ptr = (unsigned long *)pc; + unsigned long *ptr = (unsigned long *) pc; unsigned long result = *ptr; + *ptr = (trap_Breakpoint << 16) | 0xd; - os_flush_icache((os_vm_address_t)ptr, sizeof(unsigned long)); + os_flush_icache((os_vm_address_t) ptr, sizeof(unsigned long)); return result; } -void arch_remove_breakpoint(void *pc, unsigned long orig_inst) +void +arch_remove_breakpoint(void *pc, unsigned long orig_inst) { - *(unsigned long *)pc = orig_inst; + *(unsigned long *) pc = orig_inst; - os_flush_icache((os_vm_address_t)pc, sizeof(unsigned long)); + os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long)); } static unsigned long *skipped_break_addr, displaced_after_inst; static int orig_sigmask; -void arch_do_displaced_inst(struct sigcontext *scp, - unsigned long orig_inst) +void +arch_do_displaced_inst(struct sigcontext *scp, unsigned long orig_inst) { - unsigned long *pc = (unsigned long *)scp->sc_pc; + unsigned long *pc = (unsigned long *) scp->sc_pc; unsigned long *break_pc, *next_pc; unsigned long next_inst; int opcode; @@ -168,39 +177,40 @@ void arch_do_displaced_inst(struct sigcontext *scp, /* Figure out where the breakpoint is, and what happens next. */ if (scp->sc_cause & CAUSE_BD) { - break_pc = pc+1; + break_pc = pc + 1; next_inst = *pc; - } - else { + } else { break_pc = pc; next_inst = orig_inst; } /* Put the original instruction back. */ *break_pc = orig_inst; - os_flush_icache((os_vm_address_t)break_pc, sizeof(unsigned long)); + os_flush_icache((os_vm_address_t) break_pc, sizeof(unsigned long)); + skipped_break_addr = break_pc; /* Figure out where it goes. */ opcode = next_inst >> 26; - if (opcode == 1 || ((opcode & 0x3c) == 0x4) || ((next_inst & 0xf00e0000) == 0x80000000)) { + if (opcode == 1 || ((opcode & 0x3c) == 0x4) + || ((next_inst & 0xf00e0000) == 0x80000000)) { tmp = *scp; - emulate_branch(&tmp, next_inst); - next_pc = (unsigned long *)tmp.sc_pc; - } - else - next_pc = pc+1; + emulate_branch(&tmp, next_inst); + next_pc = (unsigned long *) tmp.sc_pc; + } else + next_pc = pc + 1; displaced_after_inst = *next_pc; *next_pc = (trap_AfterBreakpoint << 16) | 0xd; - os_flush_icache((os_vm_address_t)next_pc, sizeof(unsigned long)); + os_flush_icache((os_vm_address_t) next_pc, sizeof(unsigned long)); #ifdef mach sigreturn(scp); #endif } -static void sigtrap_handler(int signal, int code, struct sigcontext *scp) +static void +sigtrap_handler(int signal, int code, struct sigcontext *scp) { /* Don't disallow recursive breakpoint traps. Otherwise, we can't */ /* use debugger breakpoints anywhere in here. */ @@ -208,46 +218,49 @@ static void sigtrap_handler(int signal, int code, struct sigcontext *scp) switch (code) { case trap_PendingInterrupt: - arch_skip_instruction(scp); - interrupt_handle_pending(scp); - break; + arch_skip_instruction(scp); + interrupt_handle_pending(scp); + break; case trap_Halt: - fake_foreign_function_call(scp); - lose("%%primitive halt called; the party is over.\n"); + fake_foreign_function_call(scp); + lose("%%primitive halt called; the party is over.\n"); case trap_Error: case trap_Cerror: - interrupt_internal_error(signal, code, scp, code==trap_Cerror); - break; + interrupt_internal_error(signal, code, scp, code == trap_Cerror); + break; case trap_Breakpoint: - handle_breakpoint(signal, code, scp); - break; + handle_breakpoint(signal, code, scp); + break; case trap_FunctionEndBreakpoint: - scp->sc_pc = (int)handle_function_end_breakpoint(signal, code, scp); - break; + scp->sc_pc = (int) handle_function_end_breakpoint(signal, code, scp); + break; case trap_AfterBreakpoint: - *skipped_break_addr = (trap_Breakpoint << 16) | 0xd; - os_flush_icache((os_vm_address_t)skipped_break_addr, - sizeof(unsigned long)); - skipped_break_addr = NULL; - *(unsigned long *)scp->sc_pc = displaced_after_inst; - os_flush_icache((os_vm_address_t)scp->sc_pc, sizeof(unsigned long)); - scp->sc_mask = orig_sigmask; - break; + *skipped_break_addr = (trap_Breakpoint << 16) | 0xd; + os_flush_icache((os_vm_address_t) skipped_break_addr, + + sizeof(unsigned long)); + skipped_break_addr = NULL; + *(unsigned long *) scp->sc_pc = displaced_after_inst; + os_flush_icache((os_vm_address_t) scp->sc_pc, sizeof(unsigned long)); + + scp->sc_mask = orig_sigmask; + break; default: - interrupt_handle_now(signal, code, scp); - break; + interrupt_handle_now(signal, code, scp); + break; } } #define FIXNUM_VALUE(lispobj) (((int)lispobj)>>2) -static void sigfpe_handler(int signal, int code, struct sigcontext *scp) +static void +sigfpe_handler(int signal, int code, struct sigcontext *scp) { unsigned long bad_inst; unsigned int op, rs, rt, rd, funct, dest; @@ -255,87 +268,93 @@ static void sigfpe_handler(int signal, int code, struct sigcontext *scp) long result; if (scp->sc_cause & CAUSE_BD) - bad_inst = *(unsigned long *)(scp->sc_pc + 4); + bad_inst = *(unsigned long *) (scp->sc_pc + 4); else - bad_inst = *(unsigned long *)(scp->sc_pc); + bad_inst = *(unsigned long *) (scp->sc_pc); op = (bad_inst >> 26) & 0x3f; rs = (bad_inst >> 21) & 0x1f; rt = (bad_inst >> 16) & 0x1f; rd = (bad_inst >> 11) & 0x1f; funct = bad_inst & 0x3f; - immed = (((int)(bad_inst & 0xffff)) << 16) >> 16; + immed = (((int) (bad_inst & 0xffff)) << 16) >> 16; switch (op) { - case 0x0: /* SPECIAL */ - switch (funct) { - case 0x20: /* ADD */ - /* Check to see if this is really a pa_interrupted hit */ - if (rs == reg_ALLOC && rt == reg_NL4) { - scp->sc_regs[reg_ALLOC] += - (scp->sc_regs[reg_NL4] - - PSEUDO_ATOMIC_INTERRUPTED_BIAS); - arch_skip_instruction(scp); - interrupt_handle_pending(scp); - return; - } - result = FIXNUM_VALUE(scp->sc_regs[rs]) + FIXNUM_VALUE(scp->sc_regs[rt]); - dest = rd; - break; - - case 0x22: /* SUB */ - result = FIXNUM_VALUE(scp->sc_regs[rs]) - FIXNUM_VALUE(scp->sc_regs[rt]); - dest = rd; - break; - - default: - dest = 32; - break; - } - break; - - case 0x8: /* ADDI */ - result = FIXNUM_VALUE(scp->sc_regs[rs]) + (immed>>2); - dest = rt; - break; - - default: - dest = 32; - break; + case 0x0: /* SPECIAL */ + switch (funct) { + case 0x20: /* ADD */ + /* Check to see if this is really a pa_interrupted hit */ + if (rs == reg_ALLOC && rt == reg_NL4) { + scp->sc_regs[reg_ALLOC] += + (scp->sc_regs[reg_NL4] - + PSEUDO_ATOMIC_INTERRUPTED_BIAS); + arch_skip_instruction(scp); + interrupt_handle_pending(scp); + return; + } + result = + FIXNUM_VALUE(scp->sc_regs[rs]) + + FIXNUM_VALUE(scp->sc_regs[rt]); + dest = rd; + break; + + case 0x22: /* SUB */ + result = + FIXNUM_VALUE(scp->sc_regs[rs]) - + FIXNUM_VALUE(scp->sc_regs[rt]); + dest = rd; + break; + + default: + dest = 32; + break; + } + break; + + case 0x8: /* ADDI */ + result = FIXNUM_VALUE(scp->sc_regs[rs]) + (immed >> 2); + dest = rt; + break; + + default: + dest = 32; + break; } if (dest < 32) { - current_dynamic_space_free_pointer = - (lispobj *) scp->sc_regs[reg_ALLOC]; + current_dynamic_space_free_pointer = + (lispobj *) scp->sc_regs[reg_ALLOC]; - scp->sc_regs[dest] = alloc_number(result); + scp->sc_regs[dest] = alloc_number(result); scp->sc_regs[reg_ALLOC] = (unsigned long) current_dynamic_space_free_pointer; - arch_skip_instruction(scp); + arch_skip_instruction(scp); - } - else - interrupt_handle_now(signal, code, scp); + } else + interrupt_handle_now(signal, code, scp); } -void arch_install_interrupt_handlers() +void +arch_install_interrupt_handlers() { - interrupt_install_low_level_handler(SIGTRAP,sigtrap_handler); - interrupt_install_low_level_handler(SIGFPE,sigfpe_handler); + interrupt_install_low_level_handler(SIGTRAP, sigtrap_handler); + interrupt_install_low_level_handler(SIGFPE, sigfpe_handler); } -extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs); +extern lispobj call_into_lisp(lispobj fun, lispobj * args, int nargs); -lispobj funcall0(lispobj function) +lispobj +funcall0(lispobj function) { lispobj *args = current_control_stack_pointer; return call_into_lisp(function, args, 0); } -lispobj funcall1(lispobj function, lispobj arg0) +lispobj +funcall1(lispobj function, lispobj arg0) { lispobj *args = current_control_stack_pointer; @@ -345,7 +364,8 @@ lispobj funcall1(lispobj function, lispobj arg0) return call_into_lisp(function, args, 1); } -lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1) +lispobj +funcall2(lispobj function, lispobj arg0, lispobj arg1) { lispobj *args = current_control_stack_pointer; @@ -356,7 +376,8 @@ lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1) return call_into_lisp(function, args, 2); } -lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) +lispobj +funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) { lispobj *args = current_control_stack_pointer; @@ -372,6 +393,7 @@ lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) /* This is apparently called by emulate_branch, but isn't defined. So */ /* just do nothing and hope it works... */ -void cacheflush(void) +void +cacheflush(void) { } diff --git a/lisp/monitor.c b/lisp/monitor.c index d04420af8..3895faab1 100644 --- a/lisp/monitor.c +++ b/lisp/monitor.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/monitor.c,v 1.19 2005/09/05 06:09:13 cshapiro Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/monitor.c,v 1.20 2005/09/15 18:26:52 rtoy Exp $ */ #include <stdio.h> #include <sys/types.h> @@ -39,8 +39,9 @@ static cmd grab_sigs_cmd; static struct cmd { char *cmd, *help; - void (*fn)(char **ptr); + void (*fn) (char **ptr); } Cmds[] = { + /* *INDENT-OFF* */ {"help", "Display this info", help}, {"?", NULL, help}, {"backtrace", "backtrace up to N frames", backtrace_cmd}, @@ -61,21 +62,24 @@ static struct cmd { {"search", "search for TYPE starting at ADDRESS for a max of COUNT words.", search_cmd}, {"s", NULL, search_cmd}, {NULL, NULL, NULL} + /* *INDENT-ON* */ }; static jmp_buf curbuf; -static int visable(unsigned char c) +static int +visable(unsigned char c) { if (c < ' ' || c > '~') - return ' '; + return ' '; else - return c; + return c; } -static void dump_cmd(char **ptr) +static void +dump_cmd(char **ptr) { static char *lastaddr = 0; static int lastcount = 20; @@ -84,77 +88,83 @@ static void dump_cmd(char **ptr) int count = lastcount, displacement; if (more_p(ptr)) { - addr = parse_addr(ptr); + addr = parse_addr(ptr); - if (more_p(ptr)) - count = parse_number(ptr); + if (more_p(ptr)) + count = parse_number(ptr); } if (count == 0) { - printf("COUNT must be non-zero.\n"); - return; + printf("COUNT must be non-zero.\n"); + return; } - + lastcount = count; if (count > 0) - displacement = 4; + displacement = 4; else { - displacement = -4; - count = -count; + displacement = -4; + count = -count; } while (count-- > 0) { #ifndef alpha - printf("0x%08lX: ", (unsigned long) addr); + printf("0x%08lX: ", (unsigned long) addr); #else - printf("0x%08X: ", (u32) addr); + printf("0x%08X: ", (u32) addr); #endif - if (valid_addr((os_vm_address_t)addr)) { + if (valid_addr((os_vm_address_t) addr)) { #ifndef alpha - unsigned long *lptr = (unsigned long *)addr; + unsigned long *lptr = (unsigned long *) addr; #else - u32 *lptr = (unsigned long *)addr; + u32 *lptr = (unsigned long *) addr; #endif - unsigned short *sptr = (unsigned short *)addr; - unsigned char *cptr = (unsigned char *)addr; - - printf("0x%08lx 0x%04x 0x%04x 0x%02x 0x%02x 0x%02x 0x%02x %c%c%c%c\n", lptr[0], sptr[0], sptr[1], cptr[0], cptr[1], cptr[2], cptr[3], visable(cptr[0]), visable(cptr[1]), visable(cptr[2]), visable(cptr[3])); - } - else - printf("invalid address\n"); - - addr += displacement; + unsigned short *sptr = (unsigned short *) addr; + unsigned char *cptr = (unsigned char *) addr; + + printf + ("0x%08lx 0x%04x 0x%04x 0x%02x 0x%02x 0x%02x 0x%02x %c%c%c%c\n", + lptr[0], sptr[0], sptr[1], cptr[0], cptr[1], cptr[2], cptr[3], + visable(cptr[0]), visable(cptr[1]), visable(cptr[2]), + visable(cptr[3])); + } else + printf("invalid address\n"); + + addr += displacement; } lastaddr = addr; } -static void print_cmd(char **ptr) +static void +print_cmd(char **ptr) { lispobj obj = parse_lispobj(ptr); - + print(obj); } -static void regs_cmd(char **ptr) +static void +regs_cmd(char **ptr) { - printf("CSP\t=\t0x%08lX\n", (unsigned long)current_control_stack_pointer); - printf("FP\t=\t0x%08lX\n", (unsigned long)current_control_frame_pointer); + printf("CSP\t=\t0x%08lX\n", (unsigned long) current_control_stack_pointer); + printf("FP\t=\t0x%08lX\n", (unsigned long) current_control_frame_pointer); #if !defined(ibmrt) && !defined(i386) && !defined(__x86_64) - printf("BSP\t=\t0x%08lX\n", (unsigned long)current_binding_stack_pointer); + printf("BSP\t=\t0x%08lX\n", (unsigned long) current_binding_stack_pointer); #endif #if defined(i386) || defined(__x86_64) printf("BSP\t=\t0x%08lX\n", SymbolValue(BINDING_STACK_POINTER)); #endif - printf("DYNAMIC\t=\t0x%08lX\n", (unsigned long)current_dynamic_space); + printf("DYNAMIC\t=\t0x%08lX\n", (unsigned long) current_dynamic_space); #if defined(ibmrt) || defined(i386) || defined(__x86_64) printf("ALLOC\t=\t0x%08lX\n", SymbolValue(ALLOCATION_POINTER)); printf("TRIGGER\t=\t0x%08lX\n", SymbolValue(INTERNAL_GC_TRIGGER)); #else - printf("ALLOC\t=\t0x%08lX\n", (unsigned long) current_dynamic_space_free_pointer); - printf("TRIGGER\t=\t0x%08lX\n", (unsigned long)current_auto_gc_trigger); + printf("ALLOC\t=\t0x%08lX\n", + (unsigned long) current_dynamic_space_free_pointer); + printf("TRIGGER\t=\t0x%08lX\n", (unsigned long) current_auto_gc_trigger); #endif printf("STATIC\t=\t0x%08lX\n", SymbolValue(STATIC_SPACE_FREE_POINTER)); printf("RDONLY\t=\t0x%08lX\n", SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); @@ -164,7 +174,8 @@ static void regs_cmd(char **ptr) #endif } -static void search_cmd(char **ptr) +static void +search_cmd(char **ptr) { static int lastval = 0, lastcount = 0; static lispobj *start = 0, *end = 0; @@ -172,99 +183,96 @@ static void search_cmd(char **ptr) lispobj *addr, obj; if (more_p(ptr)) { - val = parse_number(ptr); - if (val < 0 || val > 0xff) { - printf("Can only search for single bytes.\n"); - return; - } - if (more_p(ptr)) { - addr = (lispobj *)PTR((long)parse_addr(ptr)); - if (more_p(ptr)) { - count = parse_number(ptr); - } - else { - /* Speced value and address, but no count. Only one. */ - count = -1; - } - } - else { - /* Speced a value, but no address, so search same range. */ - addr = start; - count = lastcount; - } - } - else { - /* Speced nothing, search again for val. */ - val = lastval; - addr = end; - count = lastcount; + val = parse_number(ptr); + if (val < 0 || val > 0xff) { + printf("Can only search for single bytes.\n"); + return; + } + if (more_p(ptr)) { + addr = (lispobj *) PTR((long) parse_addr(ptr)); + if (more_p(ptr)) { + count = parse_number(ptr); + } else { + /* Speced value and address, but no count. Only one. */ + count = -1; + } + } else { + /* Speced a value, but no address, so search same range. */ + addr = start; + count = lastcount; + } + } else { + /* Speced nothing, search again for val. */ + val = lastval; + addr = end; + count = lastcount; } lastval = val; start = end = addr; lastcount = count; - printf("searching for 0x%x at 0x%08lX\n", val, (unsigned long)end); + printf("searching for 0x%x at 0x%08lX\n", val, (unsigned long) end); while (search_for_type(val, &end, &count)) { - printf("found 0x%x at 0x%08lX:\n", val, (unsigned long)end); - obj = *end; - addr = end; - end += 2; - if (TypeOf(obj) == type_FunctionHeader) - print((long)addr | type_FunctionPointer); - else if (LowtagOf(obj) == type_OtherImmediate0 || LowtagOf(obj) == type_OtherImmediate1) - print((lispobj)addr | type_OtherPointer); - else - print((lispobj)addr); - if (count == -1) - return; + printf("found 0x%x at 0x%08lX:\n", val, (unsigned long) end); + obj = *end; + addr = end; + end += 2; + if (TypeOf(obj) == type_FunctionHeader) + print((long) addr | type_FunctionPointer); + else if (LowtagOf(obj) == type_OtherImmediate0 + || LowtagOf(obj) == + type_OtherImmediate1) print((lispobj) addr | + type_OtherPointer); + else + print((lispobj) addr); + if (count == -1) + return; } } -static void call_cmd(char **ptr) +static void +call_cmd(char **ptr) { lispobj thing = parse_lispobj(ptr); lispobj function, cons, args[3]; lispobj result = NIL; - + int numargs; if (LowtagOf(thing) == type_OtherPointer) { - switch (TypeOf(*(lispobj *)(thing-type_OtherPointer))) { + switch (TypeOf(*(lispobj *) (thing - type_OtherPointer))) { case type_SymbolHeader: - for (cons = SymbolValue(INITIAL_FDEFN_OBJECTS); - cons != NIL; - cons = CONS(cons)->cdr) { - if (FDEFN(CONS(cons)->car)->name == thing) { - thing = CONS(cons)->car; - goto fdefn; - } - } - printf("symbol 0x%08lx is undefined.\n", thing); - return; + for (cons = SymbolValue(INITIAL_FDEFN_OBJECTS); + cons != NIL; cons = CONS(cons)->cdr) { + if (FDEFN(CONS(cons)->car)->name == thing) { + thing = CONS(cons)->car; + goto fdefn; + } + } + printf("symbol 0x%08lx is undefined.\n", thing); + return; case type_Fdefn: - fdefn: - function = FDEFN(thing)->function; - if (function == NIL) { - printf("fdefn 0x%08lx is undefined.\n", thing); - return; - } - break; + fdefn: + function = FDEFN(thing)->function; + if (function == NIL) { + printf("fdefn 0x%08lx is undefined.\n", thing); + return; + } + break; default: - printf( - "0x%08lx is not a function pointer, symbol, or fdefn object.\n", + printf + ("0x%08lx is not a function pointer, symbol, or fdefn object.\n", thing); - return; + return; } - } - else if (LowtagOf(thing) != type_FunctionPointer) { - printf("0x%08lx is not a function pointer, symbol, or fdefn object.\n", + } else if (LowtagOf(thing) != type_FunctionPointer) { + printf("0x%08lx is not a function pointer, symbol, or fdefn object.\n", thing); - return; - } - else + return; + } else function = thing; numargs = 0; @@ -278,28 +286,30 @@ static void call_cmd(char **ptr) switch (numargs) { case 0: - result = funcall0(function); - break; + result = funcall0(function); + break; case 1: - result = funcall1(function, args[0]); - break; + result = funcall1(function, args[0]); + break; case 2: - result = funcall2(function, args[0], args[1]); - break; + result = funcall2(function, args[0], args[1]); + break; case 3: - result = funcall3(function, args[0], args[1], args[2]); - break; + result = funcall3(function, args[0], args[1], args[2]); + break; } print(result); } -static void flush_cmd(char **ptr) +static void +flush_cmd(char **ptr) { flush_vars(); } -static void quit(char **ptr) +static void +quit(char **ptr) { char buf[10]; @@ -307,81 +317,88 @@ static void quit(char **ptr) fflush(stdout); fgets(buf, sizeof(buf), stdin); if (buf[0] == 'y' || buf[0] == 'Y' || buf[0] == '\n') - exit(0); + exit(0); } -static void help(char **ptr) +static void +help(char **ptr) { struct cmd *cmd; for (cmd = Cmds; cmd->cmd != NULL; cmd++) - if (cmd->help != NULL) - printf("%s\t%s\n", cmd->cmd, cmd->help); + if (cmd->help != NULL) + printf("%s\t%s\n", cmd->cmd, cmd->help); } static int done; -static void exit_cmd(char **ptr) +static void +exit_cmd(char **ptr) { done = TRUE; } -static void gc_cmd(char **ptr) +static void +gc_cmd(char **ptr) { collect_garbage(); } -static void purify_cmd(char **ptr) +static void +purify_cmd(char **ptr) { purify(NIL, NIL); } -static void print_context(os_context_t *context) +static void +print_context(os_context_t * context) { - int i; + int i; - for (i = 0; i < NREGS; i++) { - printf("%s:\t", lisp_register_names[i]); + for (i = 0; i < NREGS; i++) { + printf("%s:\t", lisp_register_names[i]); #if defined(i386) || defined(__x86_64) - brief_print((lispobj) SC_REG(context, i*2)); + brief_print((lispobj) SC_REG(context, i * 2)); #else - brief_print((lispobj) SC_REG(context, i)); + brief_print((lispobj) SC_REG(context, i)); #endif - } - printf("PC:\t\t 0x%08lx\n", (unsigned long) SC_PC(context)); + } + printf("PC:\t\t 0x%08lx\n", (unsigned long) SC_PC(context)); } -static void print_context_cmd(char **ptr) +static void +print_context_cmd(char **ptr) { - int free; - - free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2; - - if (more_p(ptr)) { - int index; - - index = parse_number(ptr); - - if ((index >= 0) && (index < free)) { - printf("There are %d interrupt contexts.\n", free); - printf("Printing context %d\n", index); - print_context(lisp_interrupt_contexts[index]); - } else { - printf("There aren't that many/few contexts.\n"); - printf("There are %d interrupt contexts.\n", free); - } + int free; + + free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX) >> 2; + + if (more_p(ptr)) { + int index; + + index = parse_number(ptr); + + if ((index >= 0) && (index < free)) { + printf("There are %d interrupt contexts.\n", free); + printf("Printing context %d\n", index); + print_context(lisp_interrupt_contexts[index]); } else { - if (free == 0) - printf("There are no interrupt contexts!\n"); - else { - printf("There are %d interrupt contexts.\n", free); - printf("Printing context %d\n", free - 1); - print_context(lisp_interrupt_contexts[free - 1]); - } + printf("There aren't that many/few contexts.\n"); + printf("There are %d interrupt contexts.\n", free); + } + } else { + if (free == 0) + printf("There are no interrupt contexts!\n"); + else { + printf("There are %d interrupt contexts.\n", free); + printf("Printing context %d\n", free - 1); + print_context(lisp_interrupt_contexts[free - 1]); } + } } -static void backtrace_cmd(char **ptr) +static void +backtrace_cmd(char **ptr) { void backtrace(int frames); int n; @@ -395,36 +412,39 @@ static void backtrace_cmd(char **ptr) backtrace(n); } -static void catchers_cmd(char **ptr) +static void +catchers_cmd(char **ptr) { struct catch_block *catch; - catch = (struct catch_block *)SymbolValue(CURRENT_CATCH_BLOCK); + catch = (struct catch_block *) SymbolValue(CURRENT_CATCH_BLOCK); if (catch == NULL) - printf("There are no active catchers!\n"); + printf("There are no active catchers!\n"); else { - while (catch != NULL) { + while (catch != NULL) { #if !(defined(i386) || defined(__x86_64)) - printf("0x%08lX:\n\tuwp: 0x%08lX\n\tfp: 0x%08lX\n\tcode: 0x%08lx\n\tentry: 0x%08lx\n\ttag: ", - (unsigned long)catch, (unsigned long)(catch->current_uwp), - (unsigned long)(catch->current_cont), - catch->current_code, - catch->entry_pc); + printf + ("0x%08lX:\n\tuwp: 0x%08lX\n\tfp: 0x%08lX\n\tcode: 0x%08lx\n\tentry: 0x%08lx\n\ttag: ", + (unsigned long) catch, (unsigned long) (catch->current_uwp), + (unsigned long) (catch->current_cont), catch->current_code, + catch->entry_pc); #else - printf("0x%08lX:\n\tuwp: 0x%08lX\n\tfp: 0x%08lX\n\tcode: 0x%p\n\tentry: 0x%08lx\n\ttag: ", - (unsigned long)catch, (unsigned long)(catch->current_uwp), - (unsigned long)(catch->current_cont), - component_ptr_from_pc((lispobj *)catch->entry_pc) + type_OtherPointer, - catch->entry_pc); + printf + ("0x%08lX:\n\tuwp: 0x%08lX\n\tfp: 0x%08lX\n\tcode: 0x%p\n\tentry: 0x%08lx\n\ttag: ", + (unsigned long) catch, (unsigned long) (catch->current_uwp), + (unsigned long) (catch->current_cont), + component_ptr_from_pc((lispobj *) catch->entry_pc) + + type_OtherPointer, catch->entry_pc); #endif - brief_print((lispobj)catch->tag); - catch = catch->previous_catch; - } + brief_print((lispobj) catch->tag); + catch = catch->previous_catch; + } } } -static void grab_sigs_cmd(char **ptr) +static void +grab_sigs_cmd(char **ptr) { extern void sigint_init(void); @@ -432,7 +452,8 @@ static void grab_sigs_cmd(char **ptr) sigint_init(); } -static void sub_monitor(void) +static void +sub_monitor(void) { struct cmd *cmd, *found; char buf[256]; @@ -440,49 +461,48 @@ static void sub_monitor(void) int ambig; while (!done) { - printf("ldb> "); - fflush(stdout); - line = fgets(buf, sizeof(buf), stdin); - if (line == NULL) { + printf("ldb> "); + fflush(stdout); + line = fgets(buf, sizeof(buf), stdin); + if (line == NULL) { if (isatty(0)) { putchar('\n'); - continue; - } - else { + continue; + } else { fprintf(stderr, "\nEOF on something other than a tty.\n"); exit(0); } } - ptr = line; - if ((token = parse_token(&ptr)) == NULL) - continue; - ambig = 0; - found = NULL; - for (cmd = Cmds; cmd->cmd != NULL; cmd++) { - if (strcmp(token, cmd->cmd) == 0) { - found = cmd; - ambig = 0; - break; - } - else if (strncmp(token, cmd->cmd, strlen(token)) == 0) { - if (found) - ambig = 1; - else - found = cmd; - } - } - if (ambig) - printf("``%s'' is ambiguous.\n", token); - else if (found == NULL) - printf("unknown command: ``%s''\n", token); - else { - reset_printer(); - (*found->fn)(&ptr); - } + ptr = line; + if ((token = parse_token(&ptr)) == NULL) + continue; + ambig = 0; + found = NULL; + for (cmd = Cmds; cmd->cmd != NULL; cmd++) { + if (strcmp(token, cmd->cmd) == 0) { + found = cmd; + ambig = 0; + break; + } else if (strncmp(token, cmd->cmd, strlen(token)) == 0) { + if (found) + ambig = 1; + else + found = cmd; + } + } + if (ambig) + printf("``%s'' is ambiguous.\n", token); + else if (found == NULL) + printf("unknown command: ``%s''\n", token); + else { + reset_printer(); + (*found->fn) (&ptr); + } } } -void ldb_monitor() +void +ldb_monitor() { jmp_buf oldbuf; @@ -499,7 +519,8 @@ void ldb_monitor() memcpy(curbuf, oldbuf, sizeof(jmp_buf)); } -void throw_to_monitor() +void +throw_to_monitor() { longjmp(curbuf, 1); } diff --git a/lisp/os-common.c b/lisp/os-common.c index cd5d36731..37c897568 100644 --- a/lisp/os-common.c +++ b/lisp/os-common.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os-common.c,v 1.19 2005/09/05 06:09:13 cshapiro Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os-common.c,v 1.20 2005/09/15 18:26:52 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -24,85 +24,89 @@ routines may also be replaced by os-dependent versions instead. See hpux-os.c for some useful restrictions on actual usage. */ -void os_zero(addr, length) -os_vm_address_t addr; -os_vm_size_t length; +void +os_zero(addr, length) + os_vm_address_t addr; + os_vm_size_t length; { os_vm_address_t block_start; os_vm_size_t block_size; #ifdef PRINTNOISE - fprintf(stderr,";;; os_zero: addr: 0x%08x, len: 0x%08x\n",addr,length); + fprintf(stderr, ";;; os_zero: addr: 0x%08x, len: 0x%08x\n", addr, length); #endif - block_start=os_round_up_to_page(addr); + block_start = os_round_up_to_page(addr); + + length -= block_start - addr; + block_size = os_trunc_size_to_page(length); - length-=block_start-addr; - block_size=os_trunc_size_to_page(length); + if (block_start > addr) + memset((char *) addr, 0, block_start - addr); + if (block_size < length) + memset((char *) block_start + block_size, 0, length - block_size); - if(block_start>addr) - memset((char *)addr,0,block_start-addr); - if(block_size<length) - memset((char *)block_start+block_size,0,length-block_size); - if (block_size != 0) { /* Now deallocate and allocate the block so that it */ /* faults in zero-filled. */ - os_invalidate(block_start,block_size); - addr=os_validate(block_start,block_size); + os_invalidate(block_start, block_size); + addr = os_validate(block_start, block_size); - if(addr==NULL || addr!=block_start) - fprintf(stderr,"os_zero: block moved, 0x%p ==> 0x%8p!\n", - (void*) block_start, (void*) addr); + if (addr == NULL || addr != block_start) + fprintf(stderr, "os_zero: block moved, 0x%p ==> 0x%8p!\n", + (void *) block_start, (void *) addr); } } -os_vm_address_t os_allocate(len) -os_vm_size_t len; +os_vm_address_t +os_allocate(len) + os_vm_size_t len; { - return os_validate((os_vm_address_t)NULL,len); + return os_validate((os_vm_address_t) NULL, len); } -os_vm_address_t os_allocate_at(os_vm_address_t addr, os_vm_size_t len) +os_vm_address_t +os_allocate_at(os_vm_address_t addr, os_vm_size_t len) { return os_validate(addr, len); } -void os_deallocate(addr,len) -os_vm_address_t addr; -os_vm_size_t len; +void +os_deallocate(addr, len) + os_vm_address_t addr; + os_vm_size_t len; { - os_invalidate(addr,len); + os_invalidate(addr, len); } /* This function once tried to grow the chunk by asking os_validate if the space was available, but this really only works under Mach. */ -os_vm_address_t os_reallocate(os_vm_address_t addr, os_vm_size_t old_len, - os_vm_size_t len) +os_vm_address_t +os_reallocate(os_vm_address_t addr, os_vm_size_t old_len, os_vm_size_t len) { - addr=os_trunc_to_page(addr); - len=os_round_up_size_to_page(len); - old_len=os_round_up_size_to_page(old_len); + addr = os_trunc_to_page(addr); + len = os_round_up_size_to_page(len); + old_len = os_round_up_size_to_page(old_len); - if(addr==NULL) + if (addr == NULL) return os_allocate(len); - else{ - long len_diff=len-old_len; - - if(len_diff<0) - os_invalidate(addr+len,-len_diff); - else{ - if(len_diff!=0){ - os_vm_address_t new=os_allocate(len); - - if(new!=NULL){ - memcpy((char*)new, (char*)addr, old_len); - os_invalidate(addr,old_len); + else { + long len_diff = len - old_len; + + if (len_diff < 0) + os_invalidate(addr + len, -len_diff); + else { + if (len_diff != 0) { + os_vm_address_t new = os_allocate(len); + + if (new != NULL) { + memcpy((char *) new, (char *) addr, old_len); + os_invalidate(addr, old_len); } - - addr=new; + + addr = new; } } return addr; @@ -120,50 +124,51 @@ extern void call_into_c(void); #define LINKAGE_DATA_ENTRY_SIZE 3 #endif -void os_foreign_linkage_init (void) +void +os_foreign_linkage_init(void) { #ifdef LINKAGE_TABLE - lispobj linkage_data_obj = SymbolValue(LINKAGE_TABLE_DATA); + lispobj linkage_data_obj = SymbolValue(LINKAGE_TABLE_DATA); struct array *linkage_data = 0; long table_size = 0; struct vector *data_vector = 0; long i; - - linkage_data = (struct array *)PTR(linkage_data_obj); + + linkage_data = (struct array *) PTR(linkage_data_obj); table_size = fixnum_value(linkage_data->fill_pointer); - data_vector = (struct vector *)PTR(linkage_data->data); + data_vector = (struct vector *) PTR(linkage_data->data); for (i = 0; i < table_size; i += LINKAGE_DATA_ENTRY_SIZE) { struct vector *symbol_name - = (struct vector *)PTR(data_vector->data[i]); + + = (struct vector *) PTR(data_vector->data[i]); long type = fixnum_value(data_vector->data[i + 1]); lispobj lib_list = data_vector->data[i + 2]; /* - * Verify the "known" entries. This had better match what - * init-foreign-linkage in new-genesis does! - */ + * Verify the "known" entries. This had better match what + * init-foreign-linkage in new-genesis does! + */ if (i == 0) { #if defined(sparc) - if (type != 1 || strcmp((char *)symbol_name->data, - "call_into_c")) { - fprintf(stderr, "linkage_data is %s but expected call_into_c\n", - (char*)symbol_name->data); + if (type != 1 || strcmp((char *) symbol_name->data, "call_into_c")) { + fprintf(stderr, "linkage_data is %s but expected call_into_c\n", + (char *) symbol_name->data); lose("First element of linkage_data is bogus.\n"); } arch_make_linkage_entry(i, &call_into_c, 1); #elif defined(DARWIN) - if (type != 1 || strcmp((char *)symbol_name->data, - "_call_into_c")) { - fprintf(stderr, "linkage_data is %s but expected call_into_c\n", - (char*)symbol_name->data); + if (type != 1 || strcmp((char *) symbol_name->data, "_call_into_c")) { + fprintf(stderr, "linkage_data is %s but expected call_into_c\n", + (char *) symbol_name->data); lose("First element of linkage_data is bogus.\n"); } arch_make_linkage_entry(i, &call_into_c, 1); #else - if (type != 1 || strcmp((char *)symbol_name->data, + if (type != 1 || strcmp((char *) symbol_name->data, "resolve_linkage_tramp")) { - fprintf(stderr, "linkage_data is %s but expected resolve_linkage_tramp\n", - (char*)symbol_name->data); + fprintf(stderr, + "linkage_data is %s but expected resolve_linkage_tramp\n", + (char *) symbol_name->data); lose("First element of linkage_data is bogus.\n"); } arch_make_linkage_entry(i, &resolve_linkage_tramp, 1); @@ -171,10 +176,10 @@ void os_foreign_linkage_init (void) continue; } if (type == 2 && lib_list == NIL) { - void *target_addr = os_dlsym((char *)symbol_name->data, NIL); + void *target_addr = os_dlsym((char *) symbol_name->data, NIL); if (!target_addr) { - lose("%s is not defined.\n", (char *)symbol_name->data); + lose("%s is not defined.\n", (char *) symbol_name->data); } arch_make_linkage_entry(i / LINKAGE_DATA_ENTRY_SIZE, target_addr, type); @@ -194,26 +199,27 @@ void os_resolve_data_linkage(void) { #ifdef LINKAGE_TABLE - lispobj linkage_data_obj = SymbolValue(LINKAGE_TABLE_DATA); + lispobj linkage_data_obj = SymbolValue(LINKAGE_TABLE_DATA); struct array *linkage_data = 0; long table_size = 0; struct vector *data_vector = 0; long i; - - linkage_data = (struct array *)PTR(linkage_data_obj); + + linkage_data = (struct array *) PTR(linkage_data_obj); table_size = fixnum_value(linkage_data->fill_pointer); - data_vector = (struct vector *)PTR(linkage_data->data); + data_vector = (struct vector *) PTR(linkage_data->data); for (i = 0; i < table_size; i += LINKAGE_DATA_ENTRY_SIZE) { struct vector *symbol_name - = (struct vector *)PTR(data_vector->data[i]); + + = (struct vector *) PTR(data_vector->data[i]); long type = fixnum_value(data_vector->data[i + 1]); lispobj lib_list = data_vector->data[i + 2]; - if (type == 2 && lib_list != NIL) { - void *target_addr = os_dlsym((char *)symbol_name->data, lib_list); + if (type == 2 && lib_list != NIL) { + void *target_addr = os_dlsym((char *) symbol_name->data, lib_list); if (!target_addr) { - lose("%s is not defined.\n", (char *)symbol_name->data); + lose("%s is not defined.\n", (char *) symbol_name->data); } arch_make_linkage_entry(i / LINKAGE_DATA_ENTRY_SIZE, target_addr, type); @@ -228,10 +234,11 @@ os_resolve_data_linkage(void) extern void undefined_foreign_symbol_trap(lispobj arg); #endif -unsigned long os_link_one_symbol(long entry) +unsigned long +os_link_one_symbol(long entry) { #ifdef LINKAGE_TABLE - lispobj linkage_data_obj = SymbolValue(LINKAGE_TABLE_DATA); + lispobj linkage_data_obj = SymbolValue(LINKAGE_TABLE_DATA); struct array *linkage_data = 0; long table_size = 0; struct vector *data_vector = 0; @@ -239,24 +246,24 @@ unsigned long os_link_one_symbol(long entry) long type; void *target_addr; long table_index = entry * LINKAGE_DATA_ENTRY_SIZE; - - linkage_data = (struct array *)PTR(linkage_data_obj); + + linkage_data = (struct array *) PTR(linkage_data_obj); table_size = fixnum_value(linkage_data->fill_pointer); if (table_index >= table_size - 1) { return 0; } - data_vector = (struct vector *)PTR(linkage_data->data); - symbol_name = (struct vector *)PTR(data_vector->data[table_index]); + data_vector = (struct vector *) PTR(linkage_data->data); + symbol_name = (struct vector *) PTR(data_vector->data[table_index]); type = fixnum_value(data_vector->data[table_index + 1]); - target_addr = os_dlsym((char *)symbol_name->data, + target_addr = os_dlsym((char *) symbol_name->data, data_vector->data[table_index + 2]); #if 0 fprintf(stderr, "Looked up %s symbol %s at %lx\n", - type == 1 ? "code" : "data", - (char*) symbol_name->data, (unsigned long) target_addr); + type == 1 ? "code" : "data", + (char *) symbol_name->data, (unsigned long) target_addr); #endif if (!target_addr) { - undefined_foreign_symbol_trap((lispobj)data_vector->data[table_index]); + undefined_foreign_symbol_trap((lispobj) data_vector->data[table_index]); } arch_make_linkage_entry(entry, target_addr, type); return (unsigned long) target_addr; @@ -265,11 +272,11 @@ unsigned long os_link_one_symbol(long entry) #endif /* LINKAGE_TABLE */ } -unsigned long lazy_resolve_linkage(unsigned long retaddr) +unsigned long +lazy_resolve_linkage(unsigned long retaddr) { #ifdef LINKAGE_TABLE - unsigned long target_addr - = os_link_one_symbol(arch_linkage_entry(retaddr)); + unsigned long target_addr = os_link_one_symbol(arch_linkage_entry(retaddr)); return target_addr; #else @@ -278,22 +285,24 @@ unsigned long lazy_resolve_linkage(unsigned long retaddr) } static int -os_stack_grows_down_1 (int *local_var_address) +os_stack_grows_down_1(int *local_var_address) { - int dummy; - return &dummy < local_var_address; + int dummy; + + return &dummy < local_var_address; } /* Value is true if the processor stack grows down. */ int -os_stack_grows_down (void) +os_stack_grows_down(void) { - int dummy; - return os_stack_grows_down_1 (&dummy); -} + int dummy; + return os_stack_grows_down_1(&dummy); +} + #ifdef RED_ZONE_HIT /* The end of the control stack contains two guard zones: @@ -329,31 +338,31 @@ os_stack_grows_down (void) *YELLOW_START and *RED_START. */ static void -guard_zones (char **yellow_start, char **red_start) +guard_zones(char **yellow_start, char **red_start) { #if (defined(i386) || defined(__x86_64)) - if (os_stack_grows_down ()) - { - char *end = (char *) CONTROL_STACK_START; - *red_start = end; - *yellow_start = *red_start + RED_ZONE_SIZE; - } - else - { - char *end = (char *) CONTROL_STACK_START + CONTROL_STACK_SIZE; - *red_start = end - RED_ZONE_SIZE; - *yellow_start = *red_start - YELLOW_ZONE_SIZE; + if (os_stack_grows_down()) { + char *end = (char *) CONTROL_STACK_START; + + *red_start = end; + *yellow_start = *red_start + RED_ZONE_SIZE; + } else { + char *end = (char *) CONTROL_STACK_START + CONTROL_STACK_SIZE; + + *red_start = end - RED_ZONE_SIZE; + *yellow_start = *red_start - YELLOW_ZONE_SIZE; } #else - /* - * On Solaris/sparc, the C stack grows down, but the Lisp control - * stack grows up. The stack zones begin just before the end of the - * control stack area. - */ - - char *end = (char *) CONTROL_STACK_START + CONTROL_STACK_SIZE; - *red_start = end - RED_ZONE_SIZE; - *yellow_start = *red_start - YELLOW_ZONE_SIZE; + /* + * On Solaris/sparc, the C stack grows down, but the Lisp control + * stack grows up. The stack zones begin just before the end of the + * control stack area. + */ + + char *end = (char *) CONTROL_STACK_START + CONTROL_STACK_SIZE; + + *red_start = end - RED_ZONE_SIZE; + *yellow_start = *red_start - YELLOW_ZONE_SIZE; #endif } @@ -361,45 +370,45 @@ guard_zones (char **yellow_start, char **red_start) zone. */ static int -control_stack_zone (void *fault_addr) +control_stack_zone(void *fault_addr) { - char *yellow_start, *red_start; - char *p = (char *) fault_addr; - - guard_zones (&yellow_start, &red_start); - - if (p >= yellow_start && p < yellow_start + YELLOW_ZONE_SIZE) - return YELLOW_ZONE; - else if (p >= red_start && p < red_start + RED_ZONE_SIZE) - return RED_ZONE; - else - return 0; + char *yellow_start, *red_start; + char *p = (char *) fault_addr; + + guard_zones(&yellow_start, &red_start); + + if (p >= yellow_start && p < yellow_start + YELLOW_ZONE_SIZE) + return YELLOW_ZONE; + else if (p >= red_start && p < red_start + RED_ZONE_SIZE) + return RED_ZONE; + else + return 0; } /* Protect/unprotect the guard zone ZONE of the control stack. */ void -os_guard_control_stack (int zone, int guard) +os_guard_control_stack(int zone, int guard) { - char *yellow_start, *red_start; - int flags; - - guard_zones (&yellow_start, &red_start); - - if (guard) - flags = OS_VM_PROT_READ | OS_VM_PROT_EXECUTE; - else - flags = OS_VM_PROT_ALL; - - if (zone == YELLOW_ZONE) - os_protect ((os_vm_address_t) yellow_start, YELLOW_ZONE_SIZE, flags); - else if (zone == RED_ZONE) - os_protect ((os_vm_address_t) red_start, RED_ZONE_SIZE, flags); - else - { - char *start = red_start < yellow_start ? red_start : yellow_start; - os_protect ((os_vm_address_t) start, RED_ZONE_SIZE + YELLOW_ZONE_SIZE, - flags); + char *yellow_start, *red_start; + int flags; + + guard_zones(&yellow_start, &red_start); + + if (guard) + flags = OS_VM_PROT_READ | OS_VM_PROT_EXECUTE; + else + flags = OS_VM_PROT_ALL; + + if (zone == YELLOW_ZONE) + os_protect((os_vm_address_t) yellow_start, YELLOW_ZONE_SIZE, flags); + else if (zone == RED_ZONE) + os_protect((os_vm_address_t) red_start, RED_ZONE_SIZE, flags); + else { + char *start = red_start < yellow_start ? red_start : yellow_start; + + os_protect((os_vm_address_t) start, RED_ZONE_SIZE + YELLOW_ZONE_SIZE, + flags); } } @@ -407,71 +416,73 @@ os_guard_control_stack (int zone, int guard) non-zero if FAULT_ADDR is in a guard zone. */ int -os_control_stack_overflow (void *fault_addr, os_context_t *context) +os_control_stack_overflow(void *fault_addr, os_context_t * context) { - enum stack_zone_t zone; + enum stack_zone_t zone; - zone = control_stack_zone (fault_addr); + zone = control_stack_zone(fault_addr); - if (zone == YELLOW_ZONE || zone == RED_ZONE) - { - lispobj error; + if (zone == YELLOW_ZONE || zone == RED_ZONE) { + lispobj error; #if 0 - fprintf(stderr, "hit end of control stack in zone %s\n", - (zone == YELLOW_ZONE) ? "YELLOW" : (zone == RED_ZONE) ? "RED" : "BOTH"); + fprintf(stderr, "hit end of control stack in zone %s\n", + (zone == YELLOW_ZONE) ? "YELLOW" : (zone == + RED_ZONE) ? "RED" : "BOTH"); #endif - /* Unprotect the stack, giving us some room on the stack for - error handling in Lisp. Fake a stack frame for this - interruption. */ - os_guard_control_stack (zone, 0); - - build_fake_control_stack_frame (context); - - /* The protection violation signal is delivered on a signal - stack different from the normal stack, so that we don't - trample on the guard pages of the normal stack while handling - the signal. To get a Lisp function called when the signal - handler returns, we change the return address of the signal - context to the address of the function we want to be - called. */ - if (zone == RED_ZONE) - error = SymbolFunction (RED_ZONE_HIT); - else - error = SymbolFunction (YELLOW_ZONE_HIT); + /* Unprotect the stack, giving us some room on the stack for + error handling in Lisp. Fake a stack frame for this + interruption. */ + os_guard_control_stack(zone, 0); + + build_fake_control_stack_frame(context); + + /* The protection violation signal is delivered on a signal + stack different from the normal stack, so that we don't + trample on the guard pages of the normal stack while handling + the signal. To get a Lisp function called when the signal + handler returns, we change the return address of the signal + context to the address of the function we want to be + called. */ + if (zone == RED_ZONE) + error = SymbolFunction(RED_ZONE_HIT); + else + error = SymbolFunction(YELLOW_ZONE_HIT); #ifdef i386 - /* ECX is the argument count. */ - SC_PC(context) = (int) ((struct function *) PTR (error))->code; + /* ECX is the argument count. */ + SC_PC(context) = (int) ((struct function *) PTR(error))->code; #if USE_SA_SIGINFO - context->uc_mcontext.__gregs[_REG_ECX] == 0; + context->uc_mcontext.__gregs[_REG_ECX] == 0; #else - context->sc_ecx = 0; + context->sc_ecx = 0; #endif #else #ifdef __x86_64 - /* RCX is the argument count. */ - context->sc_rip = (unsigned long) ((struct function *) PTR (error))->code; - context->sc_rcx = 0; + /* RCX is the argument count. */ + context->sc_rip = + (unsigned long) ((struct function *) PTR(error))->code; + context->sc_rcx = 0; #else #ifdef sparc - /* This part should be common to all non-x86 ports */ - SC_PC(context) = (long) ((struct function *) PTR (error))->code; - SC_NPC(context) = SC_PC(context) + 4; - SC_REG(context, reg_NARGS) = 0; - SC_REG(context, reg_LIP) = (long) ((struct function *) PTR (error))->code; - SC_REG(context, reg_CFP) = (long) current_control_frame_pointer; - /* This is sparc specific */ - SC_REG(context, reg_CODE) = ((long) PTR(error)) + type_FunctionPointer; + /* This part should be common to all non-x86 ports */ + SC_PC(context) = (long) ((struct function *) PTR(error))->code; + SC_NPC(context) = SC_PC(context) + 4; + SC_REG(context, reg_NARGS) = 0; + SC_REG(context, reg_LIP) = + (long) ((struct function *) PTR(error))->code; + SC_REG(context, reg_CFP) = (long) current_control_frame_pointer; + /* This is sparc specific */ + SC_REG(context, reg_CODE) = ((long) PTR(error)) + type_FunctionPointer; #else #error os_control_stack_overflow not implemented for this system #endif #endif #endif - return 1; + return 1; } - - return 0; + + return 0; } #else /* not RED_ZONE_HIT */ @@ -479,7 +490,7 @@ os_control_stack_overflow (void *fault_addr, os_context_t *context) /* Dummy for bootstrapping. */ void -os_guard_control_stack (int zone, int guard) +os_guard_control_stack(int zone, int guard) { } diff --git a/lisp/os.h b/lisp/os.h index dc6524035..2453515e4 100644 --- a/lisp/os.h +++ b/lisp/os.h @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os.h,v 1.15 2005/01/13 19:55:00 fgilham Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/os.h,v 1.16 2005/09/15 18:26:52 rtoy Exp $ * * Common interface for os-dependent functions. * @@ -50,7 +50,7 @@ #endif #endif -#ifndef os_context_t +#ifndef os_context_t #define os_context_t struct sigcontext #endif #ifndef HANDLER_ARGS @@ -84,8 +84,7 @@ extern void os_install_interrupt_handlers(void); extern os_vm_address_t os_allocate(os_vm_size_t len); extern os_vm_address_t os_allocate_at(os_vm_address_t addr, os_vm_size_t len); extern os_vm_address_t os_reallocate(os_vm_address_t addr, - os_vm_size_t old_len, - os_vm_size_t len); + os_vm_size_t old_len, os_vm_size_t len); extern void os_deallocate(os_vm_address_t addr, os_vm_size_t len); extern void os_zero(os_vm_address_t addr, os_vm_size_t length); @@ -95,6 +94,7 @@ extern os_vm_address_t os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len); extern void os_flush_icache(os_vm_address_t addr, os_vm_size_t len); extern void os_protect(os_vm_address_t addr, os_vm_size_t len, + os_vm_prot_t protection); extern boolean valid_addr(os_vm_address_t test); @@ -109,11 +109,11 @@ extern boolean valid_addr(os_vm_address_t test); os_trunc_size_to_page((size)+(os_vm_page_size-1)) extern void os_foreign_linkage_init(void); -extern void *os_dlsym (const char *sym_name, lispobj lib_list); +extern void *os_dlsym(const char *sym_name, lispobj lib_list); -enum stack_zone_t {BOTH_ZONES, YELLOW_ZONE, RED_ZONE}; -extern int os_stack_grows_down (void); -extern void os_guard_control_stack (int zone, int guard); -extern int os_control_stack_overflow (void *, os_context_t *); +enum stack_zone_t { BOTH_ZONES, YELLOW_ZONE, RED_ZONE }; +extern int os_stack_grows_down(void); +extern void os_guard_control_stack(int zone, int guard); +extern int os_control_stack_overflow(void *, os_context_t *); #endif /* _OS_H_ */ diff --git a/lisp/osf1-os.c b/lisp/osf1-os.c index 83093d4dd..9f12eea17 100644 --- a/lisp/osf1-os.c +++ b/lisp/osf1-os.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/osf1-os.c,v 1.1 1994/03/27 15:30:51 hallgren Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/osf1-os.c,v 1.2 2005/09/15 18:26:52 rtoy Exp $ * * OS-dependent routines. This file (along with os.h) exports an * OS-independent interface to the operating system VM facilities. @@ -28,42 +28,47 @@ vm_size_t os_vm_page_size; void os_init() { - int buf[2] = {SSIN_UACPROC, UAC_SIGBUS|UAC_NOPRINT}; - int error; - os_vm_page_size=OS_VM_DEFAULT_PAGESIZE; - if(setsysinfo(SSI_NVPAIRS,buf,1,NULL,NULL)==-1) - perror("setsysinfo"); + int buf[2] = { SSIN_UACPROC, UAC_SIGBUS | UAC_NOPRINT }; + int error; + + os_vm_page_size = OS_VM_DEFAULT_PAGESIZE; + if (setsysinfo(SSI_NVPAIRS, buf, 1, NULL, NULL) == -1) + perror("setsysinfo"); } -os_vm_address_t -os_validate(os_vm_address_t addr, os_vm_size_t len) +os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len) { - int flags = MAP_PRIVATE|MAP_ANONYMOUS; + int flags = MAP_PRIVATE | MAP_ANONYMOUS; - if(addr) flags|=MAP_FIXED; - else flags|=MAP_VARIABLE; + if (addr) + flags |= MAP_FIXED; + else + flags |= MAP_VARIABLE; - if((addr=mmap(addr,len,OS_VM_PROT_ALL,flags,-1,0)) == (os_vm_address_t) -1) - perror("mmap"); + if ((addr = mmap(addr, len, OS_VM_PROT_ALL, flags, -1, 0)) == + (os_vm_address_t) - 1) + perror("mmap"); - return addr; + return addr; } void os_invalidate(os_vm_address_t addr, os_vm_size_t len) { - if(munmap(addr,len) == -1) - perror("munmap"); + if (munmap(addr, len) == -1) + perror("munmap"); } os_vm_address_t os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len) { - if((addr=mmap(addr,len,OS_VM_PROT_ALL,MAP_PRIVATE|MAP_FILE|MAP_FIXED,fd, - (off_t) offset)) == (os_vm_address_t) -1) - perror("mmap"); - - return addr; + if ( + (addr = + mmap(addr, len, OS_VM_PROT_ALL, MAP_PRIVATE | MAP_FILE | MAP_FIXED, fd, + (off_t) offset)) == (os_vm_address_t) - 1) + perror("mmap"); + + return addr; } void @@ -74,45 +79,45 @@ os_flush_icache(os_vm_address_t address, os_vm_size_t length) void os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot) { - if(mprotect(address, length, prot) == -1) - perror("mprotect"); + if (mprotect(address, length, prot) == -1) + perror("mprotect"); } -boolean -valid_addr(os_vm_address_t addr) +boolean valid_addr(os_vm_address_t addr) { - int ret; - os_vm_address_t newaddr; - newaddr=os_trunc_to_page(addr); - if((ret=mvalid(newaddr,newaddr-addr+4,OS_VM_PROT_ALL)) == 0) - return TRUE; - else if(errno==EINVAL) - perror("mvalid"); - return FALSE; + int ret; + os_vm_address_t newaddr; + + newaddr = os_trunc_to_page(addr); + if ((ret = mvalid(newaddr, newaddr - addr + 4, OS_VM_PROT_ALL)) == 0) + return TRUE; + else if (errno == EINVAL) + perror("mvalid"); + return FALSE; } static void sigbus_handler(int signal, int code, struct sigcontext *context) { - context->sc_pc -= 4; /* pc is +4 on bus error!?!!? */ - if(arch_get_bad_addr(signal,code,context) && - context->sc_regs[reg_ALLOC] & 2) { - context->sc_regs[reg_ALLOC] -= 2; - interrupt_handle_pending(context); - } else - interrupt_handle_now(signal,code,context); + context->sc_pc -= 4; /* pc is +4 on bus error!?!!? */ + if (arch_get_bad_addr(signal, code, context) && + context->sc_regs[reg_ALLOC] & 2) { + context->sc_regs[reg_ALLOC] -= 2; + interrupt_handle_pending(context); + } else + interrupt_handle_now(signal, code, context); } static void sigsegv_handler(int signal, int code, struct sigcontext *context) { - if(!interrupt_maybe_gc(signal, code, context)) - interrupt_handle_now(signal, code, context); + if (!interrupt_maybe_gc(signal, code, context)) + interrupt_handle_now(signal, code, context); } -void +void os_install_interrupt_handlers(void) { - interrupt_install_low_level_handler(SIGSEGV,sigsegv_handler); - interrupt_install_low_level_handler(SIGBUS,sigbus_handler); + interrupt_install_low_level_handler(SIGSEGV, sigsegv_handler); + interrupt_install_low_level_handler(SIGBUS, sigbus_handler); } diff --git a/lisp/parse.c b/lisp/parse.c index ef78d7572..a2e9f3754 100644 --- a/lisp/parse.c +++ b/lisp/parse.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/parse.c,v 1.10 2005/09/05 05:56:26 cshapiro Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/parse.c,v 1.11 2005/09/15 18:26:52 rtoy Exp $ */ #include <stdio.h> #include <ctype.h> #include <signal.h> @@ -24,243 +24,244 @@ */ #if 0 -static int strcasecmp(s1,s2) -char *s1,*s2; +static int +strcasecmp(s1, s2) + char *s1, *s2; { int c1, c2; - do{ - c1=(*s1++); - if(isupper(c1)) - c1=tolower(c1); + do { + c1 = (*s1++); + if (isupper(c1)) + c1 = tolower(c1); - c2=(*s2++); - if(isupper(c2)) - c2=tolower(c2); - }while(c1==c2 && c1!=0); + c2 = (*s2++); + if (isupper(c2)) + c2 = tolower(c2); + } while (c1 == c2 && c1 != 0); - return c1-c2; + return c1 - c2; } #endif -static void skip_ws(char **ptr) +static void +skip_ws(char **ptr) { while (**ptr <= ' ' && **ptr != '\0') - (*ptr)++; + (*ptr)++; } -static boolean string_to_long(char *token, long *value) +static boolean +string_to_long(char *token, long *value) { int base, digit; long num; char *ptr; if (token == 0) - return FALSE; + return FALSE; if (token[0] == '0') - if (token[1] == 'x') { - base = 16; - token += 2; - } - else { - base = 8; - token++; - } - else if (token[0] == '#') { - switch (token[1]) { - case 'x': - case 'X': - base = 16; - token += 2; - break; - case 'o': - case 'O': - base = 8; - token += 2; - break; - default: - return FALSE; - } - } - else - base = 10; + if (token[1] == 'x') { + base = 16; + token += 2; + } else { + base = 8; + token++; + } else if (token[0] == '#') { + switch (token[1]) { + case 'x': + case 'X': + base = 16; + token += 2; + break; + case 'o': + case 'O': + base = 8; + token += 2; + break; + default: + return FALSE; + } + } else + base = 10; num = 0; ptr = token; while (*ptr != '\0') { - if (*ptr >= 'a' && *ptr <= 'f') - digit = *ptr + 10 - 'a'; - else if (*ptr >= 'A' && *ptr <= 'F') - digit = *ptr + 10 - 'A'; - else if (*ptr >= '0' && *ptr <= '9') - digit = *ptr - '0'; - else - return FALSE; - if (digit < 0 || digit >= base) - return FALSE; - - ptr++; - num = num * base + digit; + if (*ptr >= 'a' && *ptr <= 'f') + digit = *ptr + 10 - 'a'; + else if (*ptr >= 'A' && *ptr <= 'F') + digit = *ptr + 10 - 'A'; + else if (*ptr >= '0' && *ptr <= '9') + digit = *ptr - '0'; + else + return FALSE; + if (digit < 0 || digit >= base) + return FALSE; + + ptr++; + num = num * base + digit; } *value = num; return TRUE; } -static boolean lookup_variable(char *name, lispobj *result) +static boolean +lookup_variable(char *name, lispobj * result) { struct var *var = lookup_by_name(name); if (var == NULL) - return FALSE; + return FALSE; else { - *result = var_value(var); - return TRUE; + *result = var_value(var); + return TRUE; } } -boolean more_p(ptr) -char **ptr; +boolean +more_p(ptr) + char **ptr; { skip_ws(ptr); if (**ptr == '\0') - return FALSE; + return FALSE; else - return TRUE; + return TRUE; } -char *parse_token(ptr) -char **ptr; +char * +parse_token(ptr) + char **ptr; { char *token; skip_ws(ptr); - + if (**ptr == '\0') - return NULL; + return NULL; token = *ptr; while (**ptr > ' ') - (*ptr)++; + (*ptr)++; if (**ptr != '\0') { - **ptr = '\0'; - (*ptr)++; + **ptr = '\0'; + (*ptr)++; } return token; } #if 0 -static boolean number_p(token) -char *token; +static boolean +number_p(token) + char *token; { char *okay; if (token == NULL) - return FALSE; + return FALSE; okay = "abcdefABCDEF987654321d0"; if (token[0] == '0') - if (token[1] == 'x' || token[1] == 'X') - token += 2; - else { - token++; - okay += 14; - } - else if (token[0] == '#') { - switch (token[1]) { - case 'x': - case 'X': - break; - case 'o': - case 'O': - okay += 14; - break; - default: - return FALSE; - } - } - else - okay += 12; + if (token[1] == 'x' || token[1] == 'X') + token += 2; + else { + token++; + okay += 14; + } else if (token[0] == '#') { + switch (token[1]) { + case 'x': + case 'X': + break; + case 'o': + case 'O': + okay += 14; + break; + default: + return FALSE; + } + } else + okay += 12; while (*token != '\0') - if (index(okay, *token++) == NULL) - return FALSE; + if (index(okay, *token++) == NULL) + return FALSE; return TRUE; } #endif -long parse_number(ptr) -char **ptr; +long +parse_number(ptr) + char **ptr; { char *token = parse_token(ptr); long result; if (token == NULL) { - printf("Expected a number.\n"); - throw_to_monitor(); - } - else if (string_to_long(token, &result)) - return result; + printf("Expected a number.\n"); + throw_to_monitor(); + } else if (string_to_long(token, &result)) + return result; else { - printf("Invalid number: ``%s''\n", token); - throw_to_monitor(); + printf("Invalid number: ``%s''\n", token); + throw_to_monitor(); } return 0; } -char *parse_addr(ptr) -char **ptr; +char * +parse_addr(ptr) + char **ptr; { char *token = parse_token(ptr); long result; if (token == NULL) { - printf("Expected an address.\n"); - throw_to_monitor(); - } - else if (token[0] == '$') { - if (!lookup_variable(token+1, (lispobj *)&result)) { - printf("Unknown variable: ``%s''\n", token); - throw_to_monitor(); - } - result &= ~7; - } - else { - if (!string_to_long(token, &result)) { - printf("Invalid number: ``%s''\n", token); - throw_to_monitor(); - } - result &= ~3; + printf("Expected an address.\n"); + throw_to_monitor(); + } else if (token[0] == '$') { + if (!lookup_variable(token + 1, (lispobj *) & result)) { + printf("Unknown variable: ``%s''\n", token); + throw_to_monitor(); + } + result &= ~7; + } else { + if (!string_to_long(token, &result)) { + printf("Invalid number: ``%s''\n", token); + throw_to_monitor(); + } + result &= ~3; } - if (!valid_addr((os_vm_address_t)result)) { - printf("Invalid address: 0x%lx\n", result); - throw_to_monitor(); + if (!valid_addr((os_vm_address_t) result)) { + printf("Invalid address: 0x%lx\n", result); + throw_to_monitor(); } - return (char *)result; + return (char *) result; } -static boolean lookup_symbol(char *name, lispobj *result) +static boolean +lookup_symbol(char *name, lispobj * result) { int count; lispobj *headerptr; /* Search static space */ headerptr = static_space; - count = ((lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER) - - static_space); + count = ((lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER) - static_space); if (search_for_symbol(name, &headerptr, &count)) { - *result = (lispobj)headerptr | type_OtherPointer; - return TRUE; + *result = (lispobj) headerptr | type_OtherPointer; + return TRUE; } /* Search dynamic space */ @@ -268,11 +269,11 @@ static boolean lookup_symbol(char *name, lispobj *result) #if !defined(ibmrt) && !defined(i386) && !defined(__x86_64) count = current_dynamic_space_free_pointer - current_dynamic_space; #else - count = (lispobj *)SymbolValue(ALLOCATION_POINTER) - current_dynamic_space; + count = (lispobj *) SymbolValue(ALLOCATION_POINTER) - current_dynamic_space; #endif if (search_for_symbol(name, &headerptr, &count)) { - *result = (lispobj)headerptr | type_OtherPointer; - return TRUE; + *result = (lispobj) headerptr | type_OtherPointer; + return TRUE; } return FALSE; @@ -281,91 +282,90 @@ static boolean lookup_symbol(char *name, lispobj *result) static int parse_regnum(char *s) { - if ((s[1] == 'R') || (s[1] == 'r')) { - int regnum; - - if (s[2] == '\0') - return -1; - - /* skip the $R part and call atoi on the number */ - regnum = atoi(s + 2); - if ((regnum >= 0) && (regnum < NREGS)) - return regnum; - else - return -1; - } else { - int i; - - for (i = 0; i < NREGS ; i++) - if (strcasecmp(s + 1, lisp_register_names[i]) == 0) + if ((s[1] == 'R') || (s[1] == 'r')) { + int regnum; + + if (s[2] == '\0') + return -1; + + /* skip the $R part and call atoi on the number */ + regnum = atoi(s + 2); + if ((regnum >= 0) && (regnum < NREGS)) + return regnum; + else + return -1; + } else { + int i; + + for (i = 0; i < NREGS; i++) + if (strcasecmp(s + 1, lisp_register_names[i]) == 0) #ifdef i386 - return i*2; + return i * 2; #else - return i; + return i; #endif - - return -1; - } + + return -1; + } } -lispobj parse_lispobj(ptr) -char **ptr; +lispobj +parse_lispobj(ptr) + char **ptr; { char *token = parse_token(ptr); long pointer; lispobj result; if (token == NULL) { - printf("Expected an object.\n"); - throw_to_monitor(); + printf("Expected an object.\n"); + throw_to_monitor(); } else if (token[0] == '$') { if (isalpha(token[1])) { - int free; - int regnum; - os_context_t *context; - - free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)>>2; - - if (free == 0) { - printf("Variable ``%s'' is not valid -- there is no current interrupt context.\n", token); - throw_to_monitor(); - } - - context = lisp_interrupt_contexts[free - 1]; - - regnum = parse_regnum(token); - if (regnum < 0) { - printf("Bogus register: ``%s''\n", token); - throw_to_monitor(); - } - - result = SC_REG(context, regnum); - } else if (!lookup_variable(token+1, &result)) { - printf("Unknown variable: ``%s''\n", token); - throw_to_monitor(); - } + int free; + int regnum; + os_context_t *context; + + free = SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX) >> 2; + + if (free == 0) { + printf + ("Variable ``%s'' is not valid -- there is no current interrupt context.\n", + token); + throw_to_monitor(); + } + + context = lisp_interrupt_contexts[free - 1]; + + regnum = parse_regnum(token); + if (regnum < 0) { + printf("Bogus register: ``%s''\n", token); + throw_to_monitor(); + } + + result = SC_REG(context, regnum); + } else if (!lookup_variable(token + 1, &result)) { + printf("Unknown variable: ``%s''\n", token); + throw_to_monitor(); + } } else if (token[0] == '@') { - if (string_to_long(token+1, &pointer)) { - pointer &= ~3; - if (valid_addr((os_vm_address_t)pointer)) - result = *(lispobj *)pointer; - else { - printf("Invalid address: ``%s''\n", token+1); - throw_to_monitor(); - } - } - else { - printf("Invalid address: ``%s''\n", token+1); - throw_to_monitor(); - } - } - else if (string_to_long(token, (long *)&result)) - ; - else if (lookup_symbol(token, &result)) - ; + if (string_to_long(token + 1, &pointer)) { + pointer &= ~3; + if (valid_addr((os_vm_address_t) pointer)) + result = *(lispobj *) pointer; + else { + printf("Invalid address: ``%s''\n", token + 1); + throw_to_monitor(); + } + } else { + printf("Invalid address: ``%s''\n", token + 1); + throw_to_monitor(); + } + } else if (string_to_long(token, (long *) &result)); + else if (lookup_symbol(token, &result)); else { - printf("Invalid lisp object: ``%s''\n", token); - throw_to_monitor(); + printf("Invalid lisp object: ``%s''\n", token); + throw_to_monitor(); } return result; diff --git a/lisp/ppc-arch.c b/lisp/ppc-arch.c index 9aaffce5d..4faea9f63 100644 --- a/lisp/ppc-arch.c +++ b/lisp/ppc-arch.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/ppc-arch.c,v 1.4 2005/04/16 02:03:22 rtoy Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/ppc-arch.c,v 1.5 2005/09/15 18:26:52 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -30,7 +30,7 @@ Even with the patch, the DSISR may not have its 'write' bit set correctly (it tends not to be set if the fault was caused by something other than a protection violation.) - + Caveat callers. */ #ifndef PT_DAR @@ -51,241 +51,249 @@ */ #define TWLLEI_R0(code) ((3<<26) | (6 << 21) | code) -char * arch_init(void) +char * +arch_init(void) { - return "lisp.core"; + return "lisp.core"; } -os_vm_address_t -arch_get_bad_addr(HANDLER_ARGS) +os_vm_address_t arch_get_bad_addr(HANDLER_ARGS) { - unsigned long badinstr, pc = SC_PC(context); - int instclass; - os_vm_address_t addr; - - - /* Make sure it's not the pc thats bogus, and that it was lisp code */ - /* that caused the fault. */ - if ((pc & 3) != 0 || - ((pc < READ_ONLY_SPACE_START || - pc >= READ_ONLY_SPACE_START+READ_ONLY_SPACE_SIZE) && - ((lispobj *)pc < current_dynamic_space && - (lispobj *)pc >= current_dynamic_space + DYNAMIC_SPACE_SIZE))) - return 0; - - - addr = (os_vm_address_t) SC_REG(context, PT_DAR); - return addr; + unsigned long badinstr, pc = SC_PC(context); + int instclass; + os_vm_address_t addr; + + + /* Make sure it's not the pc thats bogus, and that it was lisp code */ + /* that caused the fault. */ + if ((pc & 3) != 0 || + ((pc < READ_ONLY_SPACE_START || + pc >= READ_ONLY_SPACE_START + READ_ONLY_SPACE_SIZE) && + ((lispobj *) pc < current_dynamic_space && + (lispobj *) pc >= current_dynamic_space + DYNAMIC_SPACE_SIZE))) + return 0; + + + addr = (os_vm_address_t) SC_REG(context, PT_DAR); + return addr; } - -void -arch_skip_instruction(os_context_t *context) + +void +arch_skip_instruction(os_context_t * context) { - /* Skip the offending instruction */ - SC_PC(context) += 4; + /* Skip the offending instruction */ + SC_PC(context) += 4; } unsigned char * -arch_internal_error_arguments(os_context_t *scp) +arch_internal_error_arguments(os_context_t * scp) { - return (unsigned char *)(SC_PC(scp)+4); + return (unsigned char *) (SC_PC(scp) + 4); } -boolean -arch_pseudo_atomic_atomic(os_context_t *scp) +boolean arch_pseudo_atomic_atomic(os_context_t * scp) { - return (SC_REG(scp, reg_ALLOC) & 4); + return (SC_REG(scp, reg_ALLOC) & 4); } #define PSEUDO_ATOMIC_INTERRUPTED_BIAS 0x7f000000 -void -arch_set_pseudo_atomic_interrupted(os_context_t *scp) +void +arch_set_pseudo_atomic_interrupted(os_context_t * scp) { #if 0 - SC_REG(scp, reg_NL3) += PSEUDO_ATOMIC_INTERRUPTED_BIAS; + SC_REG(scp, reg_NL3) += PSEUDO_ATOMIC_INTERRUPTED_BIAS; #else - SC_REG(scp, reg_ALLOC) |= 1; + SC_REG(scp, reg_ALLOC) |= 1; #endif } -unsigned long +unsigned long arch_install_breakpoint(void *pc) { - unsigned long *ptr = (unsigned long *)pc; - unsigned long result = *ptr; - /* - * Insert a twllei r0, trap_Breakpoint instruction. - */ - *ptr = TWLLEI_R0(trap_Breakpoint); - os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long)); - return result; + unsigned long *ptr = (unsigned long *) pc; + unsigned long result = *ptr; + + /* + * Insert a twllei r0, trap_Breakpoint instruction. + */ + *ptr = TWLLEI_R0(trap_Breakpoint); + os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long)); + + return result; } -void +void arch_remove_breakpoint(void *pc, unsigned long orig_inst) { - *(unsigned long *)pc = orig_inst; - os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long)); + *(unsigned long *) pc = orig_inst; + os_flush_icache((os_vm_address_t) pc, sizeof(unsigned long)); } static unsigned long *skipped_break_addr, displaced_after_inst; static sigset_t orig_sigmask; -void -arch_do_displaced_inst(os_context_t *scp, unsigned long orig_inst) +void +arch_do_displaced_inst(os_context_t * scp, unsigned long orig_inst) { - unsigned int *pc = (unsigned long *)SC_PC(scp); - - orig_sigmask = scp->uc_sigmask; - sigemptyset(&scp->uc_sigmask); - FILLBLOCKSET(&scp->uc_sigmask); - - /* Put the original instruction back */ - *pc = orig_inst; - os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int)); - skipped_break_addr = pc; - - /* - * Replace the next instruction with a - * twllei r0, trap_AfterBreakpoint - */ - displaced_after_inst = *++pc; - *pc = TWLLEI_R0(trap_AfterBreakpoint); - os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int)); - sigreturn(scp); + unsigned int *pc = (unsigned long *) SC_PC(scp); + + orig_sigmask = scp->uc_sigmask; + sigemptyset(&scp->uc_sigmask); + FILLBLOCKSET(&scp->uc_sigmask); + + /* Put the original instruction back */ + *pc = orig_inst; + os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int)); + + skipped_break_addr = pc; + + /* + * Replace the next instruction with a + * twllei r0, trap_AfterBreakpoint + */ + displaced_after_inst = *++pc; + *pc = TWLLEI_R0(trap_AfterBreakpoint); + os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int)); + + sigreturn(scp); } -static void +static void sigill_handler(HANDLER_ARGS) { - int badinst; - int opcode; - HANDLER_GET_CONTEXT - - SAVE_CONTEXT(); + int badinst; + int opcode; - sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0); - opcode = *((int *) SC_PC(context)); + HANDLER_GET_CONTEXT SAVE_CONTEXT(); + + sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0); + opcode = *((int *) SC_PC(context)); #if 0 - printf("SIGILL entry: opcode = 0x%08x\n", opcode); - fflush(stdout); + printf("SIGILL entry: opcode = 0x%08x\n", opcode); + fflush(stdout); #endif - if (opcode == ((3 << 26) | (0x18 << 21) | (reg_NL3 << 16))) { - /* Got a twnei reg_NL3,0 - check for deferred interrupt */ + if (opcode == ((3 << 26) | (0x18 << 21) | (reg_NL3 << 16))) { + /* Got a twnei reg_NL3,0 - check for deferred interrupt */ #if 1 - /* Clear the pseudo-atomic-interrupted bit */ - SC_REG(context, reg_ALLOC) &= ~1; + /* Clear the pseudo-atomic-interrupted bit */ + SC_REG(context, reg_ALLOC) &= ~1; #else - (SC_REG(context, reg_ALLOC) -= PSEUDO_ATOMIC_INTERRUPTED_BIAS); + (SC_REG(context, reg_ALLOC) -= PSEUDO_ATOMIC_INTERRUPTED_BIAS); #endif - arch_skip_instruction(context); - interrupt_handle_pending(context); + arch_skip_instruction(context); + interrupt_handle_pending(context); #ifdef DARWIN - /* Work around G5 bug; fix courtesy gbyers via chandler */ - sigreturn(context); + /* Work around G5 bug; fix courtesy gbyers via chandler */ + sigreturn(context); #endif - return; - } + return; + } + + if ((opcode >> 16) == ((3 << 10) | (6 << 5))) { + /* twllei reg_ZERO,N will always trap if reg_ZERO = 0 */ + int trap = opcode & 0x1f, extra = (opcode >> 5) & 0x1f; - if ((opcode >> 16) == ((3 << 10) | (6 << 5))) { - /* twllei reg_ZERO,N will always trap if reg_ZERO = 0 */ - int trap = opcode & 0x1f, extra = (opcode >> 5) & 0x1f; - #if 0 - printf("SIGILL: TWLLEI, code = %d\n", trap); - fflush(stdout); + printf("SIGILL: TWLLEI, code = %d\n", trap); + fflush(stdout); #endif - switch (trap) { - case trap_Halt: - fake_foreign_function_call(context); - lose("%%primitive halt called; the party is over.\n"); - - case trap_Error: - case trap_Cerror: - interrupt_internal_error(signal, code, context, trap == trap_Cerror); - break; - - case trap_PendingInterrupt: - arch_skip_instruction(context); - interrupt_handle_pending(context); - break; - - case trap_Breakpoint: + switch (trap) { + case trap_Halt: + fake_foreign_function_call(context); + lose("%%primitive halt called; the party is over.\n"); + + case trap_Error: + case trap_Cerror: + interrupt_internal_error(signal, code, context, + trap == trap_Cerror); + break; + + case trap_PendingInterrupt: + arch_skip_instruction(context); + interrupt_handle_pending(context); + break; + + case trap_Breakpoint: #if 0 - printf("trap_Breakpoint\n"); - fflush(stdout); + printf("trap_Breakpoint\n"); + fflush(stdout); #endif - handle_breakpoint(signal, code, context); - break; - - case trap_FunctionEndBreakpoint: + handle_breakpoint(signal, code, context); + break; + + case trap_FunctionEndBreakpoint: #if 0 - printf("trap_FunctionEndBreakpoint\n"); - fflush(stdout); + printf("trap_FunctionEndBreakpoint\n"); + fflush(stdout); #endif - SC_PC(context)=(int)handle_function_end_breakpoint(signal, code, context); - break; - - case trap_AfterBreakpoint: - /* Put our breakpoint instruction back in */ - *skipped_break_addr = TWLLEI_R0(trap_Breakpoint); - skipped_break_addr = NULL; - *(unsigned long *)SC_PC(context) = displaced_after_inst; - context->uc_sigmask = orig_sigmask; - - os_flush_icache((os_vm_address_t) SC_PC(context), - sizeof(unsigned long)); - break; - - default: - interrupt_handle_now(signal, code, context); - break; - } + SC_PC(context) = + (int) handle_function_end_breakpoint(signal, code, context); + break; + + case trap_AfterBreakpoint: + /* Put our breakpoint instruction back in */ + *skipped_break_addr = TWLLEI_R0(trap_Breakpoint); + skipped_break_addr = NULL; + *(unsigned long *) SC_PC(context) = displaced_after_inst; + context->uc_sigmask = orig_sigmask; + + os_flush_icache((os_vm_address_t) SC_PC(context), + + sizeof(unsigned long)); + break; + + default: + interrupt_handle_now(signal, code, context); + break; + } #ifdef DARWIN - /* Work around G5 bug; fix courtesy gbyers via chandler */ - sigreturn(context); + /* Work around G5 bug; fix courtesy gbyers via chandler */ + sigreturn(context); #endif - return; - } - if (((opcode >> 26) == 3) && (((opcode >> 21) & 31) == 24)) { - interrupt_internal_error(signal, code, context, 0); + return; + } + if (((opcode >> 26) == 3) && (((opcode >> 21) & 31) == 24)) { + interrupt_internal_error(signal, code, context, 0); #ifdef DARWIN - /* Work around G5 bug; fix courtesy gbyers via chandler */ - sigreturn(context); + /* Work around G5 bug; fix courtesy gbyers via chandler */ + sigreturn(context); #endif - return; - } + return; + } - interrupt_handle_now(signal, code, context); + interrupt_handle_now(signal, code, context); #ifdef DARWIN - /* Work around G5 bug; fix courtesy gbyers via chandler */ - sigreturn(context); + /* Work around G5 bug; fix courtesy gbyers via chandler */ + sigreturn(context); #endif } -void arch_install_interrupt_handlers() +void +arch_install_interrupt_handlers() { - interrupt_install_low_level_handler(SIGILL,sigill_handler); - interrupt_install_low_level_handler(SIGTRAP,sigill_handler); + interrupt_install_low_level_handler(SIGILL, sigill_handler); + interrupt_install_low_level_handler(SIGTRAP, sigill_handler); } -extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs); +extern lispobj call_into_lisp(lispobj fun, lispobj * args, int nargs); -lispobj funcall0(lispobj function) +lispobj +funcall0(lispobj function) { lispobj *args = current_control_stack_pointer; return call_into_lisp(function, args, 0); } -lispobj funcall1(lispobj function, lispobj arg0) +lispobj +funcall1(lispobj function, lispobj arg0) { lispobj *args = current_control_stack_pointer; @@ -295,7 +303,8 @@ lispobj funcall1(lispobj function, lispobj arg0) return call_into_lisp(function, args, 1); } -lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1) +lispobj +funcall2(lispobj function, lispobj arg0, lispobj arg1) { lispobj *args = current_control_stack_pointer; @@ -306,7 +315,8 @@ lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1) return call_into_lisp(function, args, 2); } -lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) +lispobj +funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) { lispobj *args = current_control_stack_pointer; @@ -321,13 +331,14 @@ lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) void ppc_flush_icache(os_vm_address_t address, os_vm_size_t length) { - os_vm_address_t end = (os_vm_address_t) ((int)(address+length+(32-1)) &~(32-1)); - extern void ppc_flush_cache_line(os_vm_address_t); + os_vm_address_t end = + (os_vm_address_t) ((int) (address + length + (32 - 1)) & ~(32 - 1)); + extern void ppc_flush_cache_line(os_vm_address_t); - while (address < end) { - ppc_flush_cache_line(address); - address += 32; - } + while (address < end) { + ppc_flush_cache_line(address); + address += 32; + } } #ifdef LINKAGE_TABLE @@ -360,104 +371,106 @@ ppc_flush_icache(os_vm_address_t address, os_vm_size_t length) * Insert the necessary jump instructions at the given address. */ void -arch_make_jump_entry(void* reloc_addr, void *target_addr) +arch_make_jump_entry(void *reloc_addr, void *target_addr) { - /* - * Make JMP to function entry. - * - * The instruction sequence is: - * - * addis temp, 0, (hi part of reloc) - * ori temp, temp, (lo part of reloc) - * addis addr, 0, (hi part of addr) - * ori addr, addr, (low part of addr) - * mtctr addr - * bctr - * - */ - int* inst_ptr; - unsigned long hi; /* Top 16 bits of address */ - unsigned long lo; /* Low 16 bits of address */ - unsigned int inst; - - inst_ptr = (int*) reloc_addr; - - /* - * Split the target address into hi and lo parts for the addis/ori - * instructions. - */ - hi = (unsigned long) reloc_addr; - lo = hi & 0xffff; - hi >>= 16; - - /* - * addis 3, 0, (hi part) - */ - inst = (15 << 26) | (LINKAGE_ADDR_REG << 21) | (0 << 16) | hi; - *inst_ptr++ = inst; - - /* - * ori 3, 3, (lo part) - */ - - inst = (24 << 26) | (LINKAGE_ADDR_REG << 21) | (LINKAGE_ADDR_REG << 16) | lo; - *inst_ptr++ = inst; - - /* - * Split the target address into hi and lo parts for the addis/ori - * instructions. - */ - - hi = (unsigned long) target_addr; - lo = hi & 0xffff; - hi >>= 16; - - /* - * addis 13, 0, (hi part) - */ - - inst = (15 << 26) | (LINKAGE_TEMP_REG << 21) | (0 << 16) | hi; - *inst_ptr++ = inst; - - /* - * ori 13, 13, (lo part) - */ - - inst = (24 << 26) | (LINKAGE_TEMP_REG << 21) | (LINKAGE_TEMP_REG << 16) | lo; - *inst_ptr++ = inst; - - /* - * mtctr 13 - */ - - inst = (31 << 26) | (LINKAGE_TEMP_REG << 21) | (9 << 16) | (467 << 1); - *inst_ptr++ = inst; - - /* - * bctr - */ - - inst = (19 << 26) | (20 << 21) | (528 << 1); - *inst_ptr++ = inst; - - - *inst_ptr++ = inst; - - os_flush_icache((os_vm_address_t) reloc_addr, (char*) inst_ptr - (char*) reloc_addr); + /* + * Make JMP to function entry. + * + * The instruction sequence is: + * + * addis temp, 0, (hi part of reloc) + * ori temp, temp, (lo part of reloc) + * addis addr, 0, (hi part of addr) + * ori addr, addr, (low part of addr) + * mtctr addr + * bctr + * + */ + int *inst_ptr; + unsigned long hi; /* Top 16 bits of address */ + unsigned long lo; /* Low 16 bits of address */ + unsigned int inst; + + inst_ptr = (int *) reloc_addr; + + /* + * Split the target address into hi and lo parts for the addis/ori + * instructions. + */ + hi = (unsigned long) reloc_addr; + lo = hi & 0xffff; + hi >>= 16; + + /* + * addis 3, 0, (hi part) + */ + inst = (15 << 26) | (LINKAGE_ADDR_REG << 21) | (0 << 16) | hi; + *inst_ptr++ = inst; + + /* + * ori 3, 3, (lo part) + */ + + inst = + (24 << 26) | (LINKAGE_ADDR_REG << 21) | (LINKAGE_ADDR_REG << 16) | lo; + *inst_ptr++ = inst; + + /* + * Split the target address into hi and lo parts for the addis/ori + * instructions. + */ + + hi = (unsigned long) target_addr; + lo = hi & 0xffff; + hi >>= 16; + + /* + * addis 13, 0, (hi part) + */ + + inst = (15 << 26) | (LINKAGE_TEMP_REG << 21) | (0 << 16) | hi; + *inst_ptr++ = inst; + + /* + * ori 13, 13, (lo part) + */ + + inst = + (24 << 26) | (LINKAGE_TEMP_REG << 21) | (LINKAGE_TEMP_REG << 16) | lo; + *inst_ptr++ = inst; + + /* + * mtctr 13 + */ + + inst = (31 << 26) | (LINKAGE_TEMP_REG << 21) | (9 << 16) | (467 << 1); + *inst_ptr++ = inst; + + /* + * bctr + */ + + inst = (19 << 26) | (20 << 21) | (528 << 1); + *inst_ptr++ = inst; + + + *inst_ptr++ = inst; + + os_flush_icache((os_vm_address_t) reloc_addr, + (char *) inst_ptr - (char *) reloc_addr); } -void arch_make_linkage_entry(long linkage_entry, void *target_addr, long type) +void +arch_make_linkage_entry(long linkage_entry, void *target_addr, long type) { - int *reloc_addr = (int *)(FOREIGN_LINKAGE_SPACE_START - + linkage_entry * LinkageEntrySize); + int *reloc_addr = (int *) (FOREIGN_LINKAGE_SPACE_START - if (type == 1) - { /* code reference */ - arch_make_jump_entry(reloc_addr, target_addr); - } - else if (type == 2) - { - *(unsigned long *)reloc_addr = (unsigned long)target_addr; + + linkage_entry * LinkageEntrySize); + + if (type == 1) { /* code reference */ + arch_make_jump_entry(reloc_addr, target_addr); + } else if (type == 2) { + *(unsigned long *) reloc_addr = (unsigned long) target_addr; } } @@ -465,18 +478,20 @@ void arch_make_linkage_entry(long linkage_entry, void *target_addr, long type) extern void resolve_linkage_tramp(void); -void arch_make_lazy_linkage(long linkage_entry) +void +arch_make_lazy_linkage(long linkage_entry) { - arch_make_linkage_entry(linkage_entry, (void*) resolve_linkage_tramp, 1); + arch_make_linkage_entry(linkage_entry, (void *) resolve_linkage_tramp, 1); } /* Get linkage entry. We're given the return address which should be the address of the jmpl instruction (2nd word) of the linkage entry. Figure out which entry this address belong to. */ -long arch_linkage_entry(unsigned long retaddr) +long +arch_linkage_entry(unsigned long retaddr) { - return (retaddr - (FOREIGN_LINKAGE_SPACE_START)) - / LinkageEntrySize; + return (retaddr - (FOREIGN_LINKAGE_SPACE_START)) + / LinkageEntrySize; } #endif diff --git a/lisp/ppc-darwin-dlshim.c b/lisp/ppc-darwin-dlshim.c index b937b5a85..0057168fc 100644 --- a/lisp/ppc-darwin-dlshim.c +++ b/lisp/ppc-darwin-dlshim.c @@ -31,43 +31,49 @@ /* For now, there is no RTLD_GLOBAL emulation either. */ -static char dl_self; /* I'm going to abuse this */ +static char dl_self; /* I'm going to abuse this */ #define RTLD_LAZY 1 #define RTLD_NOW 2 #define RTLD_GLOBAL 0x100 static int callback_count; -static struct mach_header* last_header; +static struct mach_header *last_header; -void dlshim_image_callback(struct mach_header* ptr, unsigned long phooey) +void +dlshim_image_callback(struct mach_header *ptr, unsigned long phooey) { callback_count++; last_header = ptr; } -int lib_path_count(void) +int +lib_path_count(void) { - char* libpath; + char *libpath; int i; int count; + libpath = getenv("DYLD_LIBRARY_PATH"); count = 1; if (libpath) { for (i = 0; libpath[i] != '\0'; i++) { - if (libpath[i] == ':') count++; + if (libpath[i] == ':') + count++; } } return count; } -const char* lib_path_prefixify(int index, const char* filename) +const char * +lib_path_prefixify(int index, const char *filename) { - static char* retbuf = NULL; + static char *retbuf = NULL; int fi, li, i, count; - char* libpath; + char *libpath; + if (!retbuf) { - retbuf = (char*) malloc(1024*sizeof(char)); + retbuf = (char *) malloc(1024 * sizeof(char)); } count = 0; fi = 0; @@ -76,7 +82,8 @@ const char* lib_path_prefixify(int index, const char* filename) if (libpath) { i = 0; while (count != index && libpath[i] != '\0') { - if (libpath[i] == ':') count++; + if (libpath[i] == ':') + count++; i++; } fi = i; @@ -87,9 +94,14 @@ const char* lib_path_prefixify(int index, const char* filename) } if (li - fi > 0) { if (li - fi + 1 > 1022 - strlen(filename)) { - retbuf = (char*) realloc(retbuf, (li - fi + 3 + strlen(filename))*sizeof(char)); + retbuf = + (char *) realloc(retbuf, + + (li - fi + 3 + + strlen(filename)) * sizeof(char)); } - memcpy(retbuf, libpath + fi, (li - fi + 1)*sizeof(char)); + memcpy(retbuf, libpath + fi, (li - fi + 1) * sizeof(char)); + retbuf[li - fi + 1] = '/'; memcpy(retbuf + li - fi + 2, filename, strlen(filename) + 1); return retbuf; @@ -98,49 +110,74 @@ const char* lib_path_prefixify(int index, const char* filename) } } -void* dlopen(const char* filename, int flags) +void * +dlopen(const char *filename, int flags) { static char has_callback = 0; + if (!has_callback) { _dyld_register_func_for_add_image(dlshim_image_callback); } if (!filename) { return &dl_self; } else { - struct mach_header* img = NULL; - if (!img) img = NSAddImage(filename, NSADDIMAGE_OPTION_RETURN_ON_ERROR); - if (!img) img = NSAddImage(filename, NSADDIMAGE_OPTION_RETURN_ON_ERROR | NSADDIMAGE_OPTION_WITH_SEARCHING); + struct mach_header *img = NULL; + + if (!img) + img = NSAddImage(filename, NSADDIMAGE_OPTION_RETURN_ON_ERROR); + if (!img) + img = + NSAddImage(filename, + NSADDIMAGE_OPTION_RETURN_ON_ERROR | + NSADDIMAGE_OPTION_WITH_SEARCHING); if (!img) { NSObjectFileImage fileImage; + callback_count = 0; last_header = NULL; - if (NSCreateObjectFileImageFromFile(filename, &fileImage) == NSObjectFileImageSuccess) { - NSLinkModule(fileImage, filename, NSLINKMODULE_OPTION_BINDNOW | ((flags & RTLD_GLOBAL)?NSLINKMODULE_OPTION_PRIVATE:0) | NSLINKMODULE_OPTION_RETURN_ON_ERROR); - if (callback_count && last_header) img = last_header; + if (NSCreateObjectFileImageFromFile(filename, &fileImage) == + NSObjectFileImageSuccess) { + NSLinkModule(fileImage, filename, + NSLINKMODULE_OPTION_BINDNOW | + ((flags & RTLD_GLOBAL) ? + NSLINKMODULE_OPTION_PRIVATE : 0) | + NSLINKMODULE_OPTION_RETURN_ON_ERROR); + if (callback_count && last_header) + img = last_header; } } if (!img) { NSObjectFileImage fileImage; int i, maxi; - char* prefixfilename; + char *prefixfilename; + maxi = lib_path_count(); for (i = 0; i < maxi && !img; i++) { prefixfilename = lib_path_prefixify(i, filename); callback_count = 0; last_header = NULL; - if (NSCreateObjectFileImageFromFile(prefixfilename, &fileImage) == NSObjectFileImageSuccess) { - NSLinkModule(fileImage, filename, NSLINKMODULE_OPTION_BINDNOW | ((flags & RTLD_GLOBAL)?NSLINKMODULE_OPTION_PRIVATE:0) | NSLINKMODULE_OPTION_RETURN_ON_ERROR); - if (callback_count && last_header) img = last_header; + if (NSCreateObjectFileImageFromFile(prefixfilename, &fileImage) + == NSObjectFileImageSuccess) { + NSLinkModule(fileImage, filename, + NSLINKMODULE_OPTION_BINDNOW | + ((flags & RTLD_GLOBAL) ? + NSLINKMODULE_OPTION_PRIVATE : 0) | + NSLINKMODULE_OPTION_RETURN_ON_ERROR); + if (callback_count && last_header) + img = last_header; } } } if (img) { if (flags & RTLD_NOW) { - NSLookupSymbolInImage(img, "", NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_FULLY | NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR); + NSLookupSymbolInImage(img, "", + NSLOOKUPSYMBOLINIMAGE_OPTION_BIND_FULLY | + NSLOOKUPSYMBOLINIMAGE_OPTION_RETURN_ON_ERROR); } if (NSIsSymbolNameDefinedInImage(img, "__init")) { - NSSymbol* initsymbol; + NSSymbol *initsymbol; void (*initfunc) (void); + initsymbol = NSLookupSymbolInImage(img, "__init", 0); initfunc = NSAddressOfSymbol(initsymbol); initfunc(); @@ -150,25 +187,29 @@ void* dlopen(const char* filename, int flags) } } -const char* dlerror() +const char * +dlerror() { - static char* errbuf = NULL; + static char *errbuf = NULL; NSLinkEditErrors a; int b; char *c, *d; + NSLinkEditError(&a, &b, &c, &d); if (!errbuf) { - errbuf = (char*) malloc(256*sizeof(char)); + errbuf = (char *) malloc(256 * sizeof(char)); } snprintf(errbuf, 255, "%s in %s: %d %d", c, d, a, b); return errbuf; } -void* dlsym(void* handle, char* symbol) +void * +dlsym(void *handle, char *symbol) { if (handle == &dl_self) { if (NSIsSymbolNameDefined(symbol)) { - NSSymbol* retsym; + NSSymbol *retsym; + retsym = NSLookupAndBindSymbol(symbol); return NSAddressOfSymbol(retsym); } else { @@ -176,7 +217,8 @@ void* dlsym(void* handle, char* symbol) } } else { if (NSIsSymbolNameDefinedInImage(handle, symbol)) { - NSSymbol* retsym; + NSSymbol *retsym; + retsym = NSLookupSymbolInImage(handle, symbol, 0); return NSAddressOfSymbol(retsym); } else { @@ -185,7 +227,8 @@ void* dlsym(void* handle, char* symbol) } } -int dlclose(void *handle) +int +dlclose(void *handle) { /* dlclose is not implemented, and never will be for dylibs. * return -1 to signal an error; it's not used by SBCL anyhow */ diff --git a/lisp/ppc-lispregs.h b/lisp/ppc-lispregs.h index 7e1371544..1514ab839 100644 --- a/lisp/ppc-lispregs.h +++ b/lisp/ppc-lispregs.h @@ -29,7 +29,7 @@ #define reg_NARGS REG(11) #define reg_CFUNC REG(12) /* Silly to blow a reg on FF-name */ #define reg_NFP REG(13) /* Lisp may save around FF-call */ -#define reg_BSP REG(14) /* Binding stack pointer */ +#define reg_BSP REG(14) /* Binding stack pointer */ #define reg_CFP REG(15) /* Control/value stack frame pointer */ #define reg_CSP REG(16) /* Control/value stack top */ #define reg_ALLOC REG(17) /* (Global) dynamic free pointer */ @@ -37,7 +37,7 @@ #define reg_CODE REG(19) /* Current function object */ #define reg_CNAME REG(20) /* Current function name */ #define reg_LEXENV REG(21) /* And why burn a register for this ? */ -#define reg_OCFP REG(22) /* The caller's reg_CFP */ +#define reg_OCFP REG(22) /* The caller's reg_CFP */ #define reg_LRA REG(23) /* Tagged lisp return address */ #define reg_A0 REG(24) /* First function arg/return value */ #define reg_A1 REG(25) /* Second. */ diff --git a/lisp/ppc-validate.h b/lisp/ppc-validate.h index 8c4fe2c1e..1c321c3e9 100644 --- a/lisp/ppc-validate.h +++ b/lisp/ppc-validate.h @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/ppc-validate.h,v 1.5 2005/02/06 19:43:15 rtoy Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/ppc-validate.h,v 1.6 2005/09/15 18:26:52 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -28,7 +28,7 @@ * long). Hope that's enough! Make sure this doesn't overlap the * READ_ONLY_SPACE_START! */ -#define FOREIGN_LINKAGE_SPACE_SIZE (0x00800000) /* 8 MB */ +#define FOREIGN_LINKAGE_SPACE_SIZE (0x00800000) /* 8 MB */ #endif /* @@ -38,16 +38,16 @@ * used to jump to assembly routines.) */ #define READ_ONLY_SPACE_START (0x01000000) -#define READ_ONLY_SPACE_SIZE (0x07ff8000) /* 128 MB, almost */ - +#define READ_ONLY_SPACE_SIZE (0x07ff8000) /* 128 MB, almost */ + #define STATIC_SPACE_START (0x10000000) -#define STATIC_SPACE_SIZE (0x07ff8000) /* 128 MB, almost */ +#define STATIC_SPACE_SIZE (0x07ff8000) /* 128 MB, almost */ #define CONTROL_STACK_START (0x30000000) -#define CONTROL_STACK_SIZE (0x07ff8000) /* 128 MB, almost */ +#define CONTROL_STACK_SIZE (0x07ff8000) /* 128 MB, almost */ #define BINDING_STACK_START (0x38000000) -#define BINDING_STACK_SIZE (0x07ff8000) /* 128 MB, almost */ +#define BINDING_STACK_SIZE (0x07ff8000) /* 128 MB, almost */ #if 0 #define DYNAMIC_0_SPACE_START (0x40000000) @@ -64,7 +64,7 @@ #define DEFAULT_DYNAMIC_SPACE_SIZE (0x08000000) /* 128 MB */ #define DYNAMIC_0_SPACE_START (0x40000000) #define DYNAMIC_1_SPACE_START (0x60000000) -#define DYNAMIC_SPACE_SIZE (0x1fff0000) /* 512 MB, almost */ +#define DYNAMIC_SPACE_SIZE (0x1fff0000) /* 512 MB, almost */ #if 0 #define HOLES {0x04ff8000, 0x06ff8000, 0x0aff8000, 0x1fff8000} diff --git a/lisp/print.c b/lisp/print.c index 63bf25946..8a6d48219 100644 --- a/lisp/print.c +++ b/lisp/print.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/print.c,v 1.19 2005/02/07 22:32:49 rtoy Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/print.c,v 1.20 2005/09/15 18:26:52 rtoy Exp $ */ #include <stdio.h> #include <string.h> @@ -107,131 +107,141 @@ char *subtype_Names[] = { "instance header", "fdefn" #ifdef type_ScavengerHook - ,"scavenger hook" + , "scavenger hook" #endif }; -static void indent(int in) +static void +indent(int in) { - static char *spaces = " "; + static char *spaces = + + " "; while (in > 64) { - fputs(spaces, stdout); - in -= 64; + fputs(spaces, stdout); + in -= 64; } if (in != 0) - fputs(spaces + 64 - in, stdout); + fputs(spaces + 64 - in, stdout); } -static boolean continue_p(boolean newline) +static boolean +continue_p(boolean newline) { char buffer[256]; if (cur_depth >= max_depth || dont_decend) - return FALSE; + return FALSE; if (newline) { - if (skip_newline) - skip_newline = FALSE; - else - putchar('\n'); - - if (cur_lines >= max_lines) { - printf("More? [y] "); - fflush(stdout); - - fgets(buffer, sizeof(buffer), stdin); - - if (buffer[0] == 'n' || buffer[0] == 'N') - throw_to_monitor(); - else - cur_lines = 0; - } + if (skip_newline) + skip_newline = FALSE; + else + putchar('\n'); + + if (cur_lines >= max_lines) { + printf("More? [y] "); + fflush(stdout); + + fgets(buffer, sizeof(buffer), stdin); + + if (buffer[0] == 'n' || buffer[0] == 'N') + throw_to_monitor(); + else + cur_lines = 0; + } } return TRUE; } -static void newline(char *label) +static void +newline(char *label) { cur_lines++; if (label != NULL) - fputs(label, stdout); + fputs(label, stdout); putchar('\t'); indent(cur_depth * 2); } -static void brief_fixnum(lispobj obj) +static void +brief_fixnum(lispobj obj) { #ifndef alpha - printf("%ld", ((long)obj)>>2); + printf("%ld", ((long) obj) >> 2); #else - printf("%d", ((s32)obj)>>2); + printf("%d", ((s32) obj) >> 2); #endif } -static void print_fixnum(lispobj obj) +static void +print_fixnum(lispobj obj) { #ifndef alpha - printf(": %ld", ((long)obj)>>2); + printf(": %ld", ((long) obj) >> 2); #else - printf(": %d", ((s32)obj)>>2); + printf(": %d", ((s32) obj) >> 2); #endif } -static void brief_otherimm(lispobj obj) +static void +brief_otherimm(lispobj obj) { int type, c, idx; char buffer[10]; type = TypeOf(obj); switch (type) { - case type_BaseChar: - c = (obj>>8)&0xff; - switch (c) { - case '\0': - printf("#\\Null"); - break; - case '\n': - printf("#\\Newline"); - break; - case '\b': - printf("#\\Backspace"); - break; - case '\177': - printf("#\\Delete"); - break; - default: - strcpy(buffer, "#\\"); - if (c >= 128) { - strcat(buffer, "m-"); - c -= 128; - } - if (c < 32) { - strcat(buffer, "c-"); - c += '@'; - } - printf("%s%c", buffer, c); - break; - } - break; - - case type_UnboundMarker: - printf("<unbound marker>"); - break; - - default: - idx = type >> 2; - if (idx < (sizeof(subtype_Names) / sizeof(char *))) - printf("%s", subtype_Names[idx]); - else - printf("unknown type (0x%0x)", type); - break; + case type_BaseChar: + c = (obj >> 8) & 0xff; + switch (c) { + case '\0': + printf("#\\Null"); + break; + case '\n': + printf("#\\Newline"); + break; + case '\b': + printf("#\\Backspace"); + break; + case '\177': + printf("#\\Delete"); + break; + default: + strcpy(buffer, "#\\"); + if (c >= 128) { + strcat(buffer, "m-"); + c -= 128; + } + if (c < 32) { + strcat(buffer, "c-"); + c += '@'; + } + printf("%s%c", buffer, c); + break; + } + break; + + case type_UnboundMarker: + printf("<unbound marker>"); + break; + + default: + idx = type >> 2; + if (idx < (sizeof(subtype_Names) / sizeof(char *))) + printf("%s", subtype_Names[idx]); + + else + printf("unknown type (0x%0x)", type); + break; } } -static void print_otherimm(lispobj obj) +static void +print_otherimm(lispobj obj) { int type, idx; @@ -239,94 +249,101 @@ static void print_otherimm(lispobj obj) idx = type >> 2; if (idx < (sizeof(subtype_Names) / sizeof(char *))) - printf(", %s", subtype_Names[idx]); + printf(", %s", subtype_Names[idx]); + else - printf(", unknown type (0x%0x)", type); + printf(", unknown type (0x%0x)", type); switch (TypeOf(obj)) { - case type_BaseChar: - printf(": "); - brief_otherimm(obj); - break; - - case type_Sap: - case type_UnboundMarker: - break; - - default: - printf(": data=%ld", (obj>>8)&0xffffff); - break; + case type_BaseChar: + printf(": "); + brief_otherimm(obj); + break; + + case type_Sap: + case type_UnboundMarker: + break; + + default: + printf(": data=%ld", (obj >> 8) & 0xffffff); + break; } } -static void brief_list(lispobj obj) +static void +brief_list(lispobj obj) { int space = FALSE; int length = 0; - if (!valid_addr((os_vm_address_t)obj)) - printf("(invalid address)"); + if (!valid_addr((os_vm_address_t) obj)) + printf("(invalid address)"); else if (obj == NIL) - printf("NIL"); + printf("NIL"); else { - putchar('('); - while (LowtagOf(obj) == type_ListPointer) { - struct cons *cons = (struct cons *)PTR(obj); - - if (space) - putchar(' '); - if (++length >= max_length) { - printf("..."); - obj = NIL; - break; - } - print_obj(NULL, cons->car); - obj = cons->cdr; - space = TRUE; - if (obj == NIL) - break; - } - if (obj != NIL) { - printf(" . "); - print_obj(NULL, obj); - } - putchar(')'); + putchar('('); + while (LowtagOf(obj) == type_ListPointer) { + struct cons *cons = (struct cons *) PTR(obj); + + if (space) + putchar(' '); + if (++length >= max_length) { + printf("..."); + obj = NIL; + break; + } + print_obj(NULL, cons->car); + obj = cons->cdr; + space = TRUE; + if (obj == NIL) + break; + } + if (obj != NIL) { + printf(" . "); + print_obj(NULL, obj); + } + putchar(')'); } } -static void print_list(lispobj obj) +static void +print_list(lispobj obj) { - if (!valid_addr((os_vm_address_t)obj)) - printf("(invalid address)"); + if (!valid_addr((os_vm_address_t) obj)) + printf("(invalid address)"); else if (obj == NIL) - printf(" (NIL)"); + printf(" (NIL)"); else { - struct cons *cons = (struct cons *)PTR(obj); + struct cons *cons = (struct cons *) PTR(obj); - print_obj("car: ", cons->car); - print_obj("cdr: ", cons->cdr); + print_obj("car: ", cons->car); + print_obj("cdr: ", cons->cdr); } } -static void brief_struct(lispobj obj) +static void +brief_struct(lispobj obj) { printf("#<ptr to 0x%08lx instance>", - ((struct instance *)PTR(obj))->slots[0]); + ((struct instance *) PTR(obj))->slots[0]); } -static void print_struct(lispobj obj) +static void +print_struct(lispobj obj) { - struct instance *instance = (struct instance *)PTR(obj); + struct instance *instance = (struct instance *) PTR(obj); int i; char buffer[16]; - print_obj("type: ", ((struct instance *)PTR(obj))->slots[0]); + + print_obj("type: ", ((struct instance *) PTR(obj))->slots[0]); for (i = 1; i < HeaderValue(instance->header); i++) { sprintf(buffer, "slot %d: ", i); print_obj(buffer, instance->slots[i]); } } -static void brief_otherptr(lispobj obj) +static void +brief_otherptr(lispobj obj) { lispobj *ptr, header; int type; @@ -336,108 +353,119 @@ static void brief_otherptr(lispobj obj) ptr = (lispobj *) PTR(obj); - if (!valid_addr((os_vm_address_t)obj)) { - printf("(invalid address)"); - return; + if (!valid_addr((os_vm_address_t) obj)) { + printf("(invalid address)"); + return; } header = *ptr; type = TypeOf(header); switch (type) { - case type_SymbolHeader: - symbol = (struct symbol *)ptr; - vector = (struct vector *)PTR(symbol->name); - for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) { - if (*charptr == '"') - putchar('\\'); - putchar(*charptr); - } - break; - - case type_SimpleString: - vector = (struct vector *)ptr; - putchar('"'); - for (charptr = (char *)vector->data; *charptr != '\0'; charptr++) { - if (*charptr == '"') - putchar('\\'); - putchar(*charptr); - } - putchar('"'); - break; - - default: - printf("#<ptr to "); - brief_otherimm(header); - putchar('>'); + case type_SymbolHeader: + symbol = (struct symbol *) ptr; + vector = (struct vector *) PTR(symbol->name); + for (charptr = (char *) vector->data; *charptr != '\0'; charptr++) { + if (*charptr == '"') + putchar('\\'); + putchar(*charptr); + } + break; + + case type_SimpleString: + vector = (struct vector *) ptr; + putchar('"'); + for (charptr = (char *) vector->data; *charptr != '\0'; charptr++) { + if (*charptr == '"') + putchar('\\'); + putchar(*charptr); + } + putchar('"'); + break; + + default: + printf("#<ptr to "); + brief_otherimm(header); + putchar('>'); } } -static void print_slots(char **slots, int count, lispobj *ptr) +static void +print_slots(char **slots, int count, lispobj * ptr) { while (count-- > 0) - if (*slots) - print_obj(*slots++, *ptr++); - else - print_obj("???: ", *ptr++); + if (*slots) + print_obj(*slots++, *ptr++); + else + print_obj("???: ", *ptr++); } -static char *symbol_slots[] = {"value: ", "hash: ", - "plist: ", "name: ", "package: ", NULL}; -static char *ratio_slots[] = {"numer: ", "denom: ", NULL}; -static char *complex_slots[] = {"real: ", "imag: ", NULL}; -static char *code_slots[] = {"words: ", "entry: ", "debug: ", NULL}; -static char *array_slots[] = {"fill-pointer: ", - "fill-pointer-p: ", - "elements: ", - "data: ", - "displacement: ", - "displaced-p: ", - /* Some reasonable number of dimensions */ - "dimension 1: ", - "dimension 2: ", - "dimension 3: ", - "dimension 4: ", - "dimension 5: ", - "dimension 6: ", - "dimension 7: ", - NULL}; +static char *symbol_slots[] = { "value: ", "hash: ", + "plist: ", "name: ", "package: ", NULL +}; +static char *ratio_slots[] = { "numer: ", "denom: ", NULL }; +static char *complex_slots[] = { "real: ", "imag: ", NULL }; +static char *code_slots[] = { "words: ", "entry: ", "debug: ", NULL }; +static char *array_slots[] = { "fill-pointer: ", + "fill-pointer-p: ", + "elements: ", + "data: ", + "displacement: ", + "displaced-p: ", + /* Some reasonable number of dimensions */ + "dimension 1: ", + "dimension 2: ", + "dimension 3: ", + "dimension 4: ", + "dimension 5: ", + "dimension 6: ", + "dimension 7: ", + NULL +}; #if (defined(i386) || defined(__x86_64)) -static char *fn_slots[] = {"inst start: ", "next: ", "name: ", "arglist: ", "type: ", NULL}; +static char *fn_slots[] = + { "inst start: ", "next: ", "name: ", "arglist: ", "type: ", NULL }; #else -static char *fn_slots[] = {"self: ", "next: ", "name: ", "arglist: ", "type: ", NULL}; +static char *fn_slots[] = + { "self: ", "next: ", "name: ", "arglist: ", "type: ", NULL }; #endif -static char *closure_slots[] = {"fn: ", NULL}; -static char *funcallable_instance_slots[] = {"fn: ", "lexenv: ", "layout: ", NULL}; -static char *weak_pointer_slots[] = {"value: ", "broken: ", +static char *closure_slots[] = { "fn: ", NULL }; +static char *funcallable_instance_slots[] = + { "fn: ", "lexenv: ", "layout: ", NULL }; +static char *weak_pointer_slots[] = { "value: ", "broken: ", #ifdef GENCGC - "mark-bit: ", + "mark-bit: ", #endif - NULL}; -static char *fdefn_slots[] = {"name: ", "function: ", "raw_addr: ", NULL}; -static char *value_cell_slots[] = {"value: ", NULL}; + NULL +}; +static char *fdefn_slots[] = { "name: ", "function: ", "raw_addr: ", NULL }; +static char *value_cell_slots[] = { "value: ", NULL }; + #ifdef type_ScavengerHook -static char *scavenger_hook_slots[] = {"value: ", "function: ", "next: ", NULL}; +static char *scavenger_hook_slots[] = + + { "value: ", "function: ", "next: ", NULL }; #endif -static void print_otherptr(lispobj obj) +static void +print_otherptr(lispobj obj) { - if (!valid_addr((os_vm_address_t)obj)) - printf("(invalid address)"); + if (!valid_addr((os_vm_address_t) obj)) + printf("(invalid address)"); else { #ifndef alpha - unsigned long *ptr; - unsigned long header; - unsigned long length; + unsigned long *ptr; + unsigned long header; + unsigned long length; #else - u32 *ptr; - u32 header; - u32 length; + u32 *ptr; + u32 header; + u32 length; #endif - int count, type, index; - char *cptr, buffer[16]; + int count, type, index; + char *cptr, buffer[16]; #ifndef alpha ptr = (unsigned long *) PTR(obj); @@ -446,282 +474,287 @@ static void print_otherptr(lispobj obj) ptr = (u32 *) PTR(obj); if (ptr == (u32 *) NULL) { #endif - printf(" (NULL Pointer)"); - return; + printf(" (NULL Pointer)"); + return; } header = *ptr++; length = (*ptr) >> 2; - count = header>>8; + count = header >> 8; type = TypeOf(header); - print_obj("header: ", header); - if (LowtagOf(header) != type_OtherImmediate0 && LowtagOf(header) != type_OtherImmediate1) { - NEWLINE; - printf("(invalid header object)"); - return; - } - - switch (type) { - case type_Bignum: - ptr += count; - NEWLINE; - printf("0x"); - while (count-- > 0) - printf("%08lx", *--ptr); - break; - - case type_Ratio: - print_slots(ratio_slots, count, ptr); - break; - - case type_Complex: - print_slots(complex_slots, count, ptr); - break; - - case type_SymbolHeader: - print_slots(symbol_slots, count, ptr); - break; - - case type_SingleFloat: - NEWLINE; - printf("%g", ((struct single_float *)PTR(obj))->value); - break; - - case type_DoubleFloat: - NEWLINE; - printf("%g", ((struct double_float *)PTR(obj))->value); - break; + print_obj("header: ", header); + if (LowtagOf(header) != type_OtherImmediate0 + && LowtagOf(header) != type_OtherImmediate1) { + NEWLINE; + printf("(invalid header object)"); + return; + } + + switch (type) { + case type_Bignum: + ptr += count; + NEWLINE; + printf("0x"); + while (count-- > 0) + printf("%08lx", *--ptr); + break; + + case type_Ratio: + print_slots(ratio_slots, count, ptr); + break; + + case type_Complex: + print_slots(complex_slots, count, ptr); + break; + + case type_SymbolHeader: + print_slots(symbol_slots, count, ptr); + break; + + case type_SingleFloat: + NEWLINE; + printf("%g", ((struct single_float *) PTR(obj))->value); + break; + + case type_DoubleFloat: + NEWLINE; + printf("%g", ((struct double_float *) PTR(obj))->value); + break; #ifdef type_LongFloat - case type_LongFloat: - NEWLINE; - printf("%Lg", ((struct long_float *)PTR(obj))->value); - break; + case type_LongFloat: + NEWLINE; + printf("%Lg", ((struct long_float *) PTR(obj))->value); + break; #endif #ifdef type_ComplexSingleFloat - case type_ComplexSingleFloat: - NEWLINE; - printf("%g", ((struct complex_single_float *)PTR(obj))->real); - NEWLINE; - printf("%g", ((struct complex_single_float *)PTR(obj))->imag); - break; + case type_ComplexSingleFloat: + NEWLINE; + printf("%g", ((struct complex_single_float *) PTR(obj))->real); + NEWLINE; + printf("%g", ((struct complex_single_float *) PTR(obj))->imag); + break; #endif #ifdef type_ComplexDoubleFloat - case type_ComplexDoubleFloat: - NEWLINE; - printf("%g", ((struct complex_double_float *)PTR(obj))->real); - NEWLINE; - printf("%g", ((struct complex_double_float *)PTR(obj))->imag); - break; + case type_ComplexDoubleFloat: + NEWLINE; + printf("%g", ((struct complex_double_float *) PTR(obj))->real); + NEWLINE; + printf("%g", ((struct complex_double_float *) PTR(obj))->imag); + break; #endif #ifdef type_ComplexLongFloat - case type_ComplexLongFloat: - NEWLINE; - printf("%Lg", ((struct complex_long_float *)PTR(obj))->real); - NEWLINE; - printf("%Lg", ((struct complex_long_float *)PTR(obj))->imag); - break; -#endif - - case type_SimpleString: - NEWLINE; - cptr = (char *)(ptr+1); - putchar('\"'); - while (length-- > 0) - putchar(*cptr++); - putchar('\"'); - break; - - case type_SimpleVector: - NEWLINE; - printf("length = %ld", length); - ptr++; - index = 0; - while (length-- > 0) { - sprintf(buffer, "%d: ", index++); - print_obj(buffer, *ptr++); - } - break; - - case type_InstanceHeader: - NEWLINE; - printf("length = %d", count); - index = 0; - while (count-- > 0) { - sprintf(buffer, "%d: ", index++); - print_obj(buffer, *ptr++); - } - break; - - case type_SimpleArray: - case type_SimpleBitVector: - case type_SimpleArrayUnsignedByte2: - case type_SimpleArrayUnsignedByte4: - case type_SimpleArrayUnsignedByte8: - case type_SimpleArrayUnsignedByte16: - case type_SimpleArrayUnsignedByte32: + case type_ComplexLongFloat: + NEWLINE; + printf("%Lg", ((struct complex_long_float *) PTR(obj))->real); + NEWLINE; + printf("%Lg", ((struct complex_long_float *) PTR(obj))->imag); + break; +#endif + + case type_SimpleString: + NEWLINE; + cptr = (char *) (ptr + 1); + putchar('\"'); + while (length-- > 0) + putchar(*cptr++); + putchar('\"'); + break; + + case type_SimpleVector: + NEWLINE; + printf("length = %ld", length); + ptr++; + index = 0; + while (length-- > 0) { + sprintf(buffer, "%d: ", index++); + print_obj(buffer, *ptr++); + } + break; + + case type_InstanceHeader: + NEWLINE; + printf("length = %d", count); + index = 0; + while (count-- > 0) { + sprintf(buffer, "%d: ", index++); + print_obj(buffer, *ptr++); + } + break; + + case type_SimpleArray: + case type_SimpleBitVector: + case type_SimpleArrayUnsignedByte2: + case type_SimpleArrayUnsignedByte4: + case type_SimpleArrayUnsignedByte8: + case type_SimpleArrayUnsignedByte16: + case type_SimpleArrayUnsignedByte32: #ifdef type_SimpleArraySignedByte8 - case type_SimpleArraySignedByte8: + case type_SimpleArraySignedByte8: #endif #ifdef type_SimpleArraySignedByte16 - case type_SimpleArraySignedByte16: + case type_SimpleArraySignedByte16: #endif #ifdef type_SimpleArraySignedByte30 - case type_SimpleArraySignedByte30: + case type_SimpleArraySignedByte30: #endif #ifdef type_SimpleArraySignedByte32 - case type_SimpleArraySignedByte32: + case type_SimpleArraySignedByte32: #endif - case type_SimpleArraySingleFloat: - case type_SimpleArrayDoubleFloat: + case type_SimpleArraySingleFloat: + case type_SimpleArrayDoubleFloat: #ifdef type_SimpleArrayLongFloat - case type_SimpleArrayLongFloat: + case type_SimpleArrayLongFloat: #endif #ifdef type_SimpleArrayComplexSingleFloat - case type_SimpleArrayComplexSingleFloat: + case type_SimpleArrayComplexSingleFloat: #endif #ifdef type_SimpleArrayComplexDoubleFloat - case type_SimpleArrayComplexDoubleFloat: + case type_SimpleArrayComplexDoubleFloat: #endif #ifdef type_SimpleArrayComplexLongFloat - case type_SimpleArrayComplexLongFloat: -#endif - case type_ComplexString: - case type_ComplexBitVector: - case type_ComplexVector: - case type_ComplexArray: - print_slots(array_slots, count, ptr); - break; - - case type_CodeHeader: - print_slots(code_slots, count-1, ptr); - break; - - case type_FunctionHeader: - case type_ClosureFunctionHeader: - print_slots(fn_slots, 5, ptr); - break; - - case type_ReturnPcHeader: - print_obj("code: ", obj - (count * 4)); - break; - - case type_ClosureHeader: - print_slots(closure_slots, count, ptr); - break; - - case type_FuncallableInstanceHeader: - print_slots(funcallable_instance_slots, count, ptr); - break; - - case type_ValueCellHeader: - print_slots(value_cell_slots, 1, ptr); - break; - - case type_Sap: - NEWLINE; + case type_SimpleArrayComplexLongFloat: +#endif + case type_ComplexString: + case type_ComplexBitVector: + case type_ComplexVector: + case type_ComplexArray: + print_slots(array_slots, count, ptr); + break; + + case type_CodeHeader: + print_slots(code_slots, count - 1, ptr); + break; + + case type_FunctionHeader: + case type_ClosureFunctionHeader: + print_slots(fn_slots, 5, ptr); + break; + + case type_ReturnPcHeader: + print_obj("code: ", obj - (count * 4)); + break; + + case type_ClosureHeader: + print_slots(closure_slots, count, ptr); + break; + + case type_FuncallableInstanceHeader: + print_slots(funcallable_instance_slots, count, ptr); + break; + + case type_ValueCellHeader: + print_slots(value_cell_slots, 1, ptr); + break; + + case type_Sap: + NEWLINE; #ifndef alpha - printf("0x%08lx", *ptr); + printf("0x%08lx", *ptr); #else - printf("0x%016lx", *(long*)(ptr+1)); + printf("0x%016lx", *(long *) (ptr + 1)); #endif - break; + break; - case type_WeakPointer: - print_slots(weak_pointer_slots, 3, ptr); - break; + case type_WeakPointer: + print_slots(weak_pointer_slots, 3, ptr); + break; - case type_BaseChar: - case type_UnboundMarker: - NEWLINE; - printf("pointer to an immediate?"); - break; + case type_BaseChar: + case type_UnboundMarker: + NEWLINE; + printf("pointer to an immediate?"); + break; + + case type_Fdefn: + print_slots(fdefn_slots, count, ptr); + break; - case type_Fdefn: - print_slots(fdefn_slots, count, ptr); - break; - #ifdef type_ScavengerHook - case type_ScavengerHook: - print_slots(scavenger_hook_slots, count, ptr); - break; + case type_ScavengerHook: + print_slots(scavenger_hook_slots, count, ptr); + break; #endif - default: - NEWLINE; - printf("Unknown header object?"); - break; - } + default: + NEWLINE; + printf("Unknown header object?"); + break; + } } } -static void print_obj(char *prefix, lispobj obj) +static void +print_obj(char *prefix, lispobj obj) { - static void (*verbose_fns[])(lispobj obj) - = {print_fixnum, print_otherptr, print_otherimm, print_list, - print_fixnum, print_struct, print_otherimm, print_otherptr}; - static void (*brief_fns[])(lispobj obj) - = {brief_fixnum, brief_otherptr, brief_otherimm, brief_list, - brief_fixnum, brief_struct, brief_otherimm, brief_otherptr}; + static void (*verbose_fns[]) (lispobj obj) + = { print_fixnum, print_otherptr, print_otherimm, print_list, + print_fixnum, print_struct, print_otherimm, print_otherptr + }; + static void (*brief_fns[]) (lispobj obj) + = { brief_fixnum, brief_otherptr, brief_otherimm, brief_list, + brief_fixnum, brief_struct, brief_otherimm, brief_otherptr + }; int type = LowtagOf(obj); struct var *var = lookup_by_obj(obj); char buffer[256]; boolean verbose = cur_depth < brief_depth; - + if (!continue_p(verbose)) - return; + return; if (var != NULL && var_clock(var) == cur_clock) - dont_decend = TRUE; + dont_decend = TRUE; - if (var == NULL && (obj & type_FunctionPointer & type_ListPointer & type_InstancePointer & type_OtherPointer) != 0) - var = define_var(NULL, obj, FALSE); + if (var == NULL + && (obj & type_FunctionPointer & type_ListPointer & type_InstancePointer + & type_OtherPointer) != 0) + var = define_var(NULL, obj, FALSE); if (var != NULL) - var_setclock(var, cur_clock); + var_setclock(var, cur_clock); cur_depth++; if (verbose) { - if (var != NULL) { - sprintf(buffer, "$%s=", var_name(var)); - newline(buffer); - } - else - newline(NULL); - printf("%s0x%08lx: ", prefix, obj); - if (cur_depth < brief_depth) { - fputs(lowtag_Names[type], stdout); - (*verbose_fns[type])(obj); - } - else - (*brief_fns[type])(obj); - } - else { - if (dont_decend) - printf("$%s", var_name(var)); - else { - if (var != NULL) - printf("$%s=", var_name(var)); - (*brief_fns[type])(obj); - } + if (var != NULL) { + sprintf(buffer, "$%s=", var_name(var)); + newline(buffer); + } else + newline(NULL); + printf("%s0x%08lx: ", prefix, obj); + if (cur_depth < brief_depth) { + fputs(lowtag_Names[type], stdout); + (*verbose_fns[type]) (obj); + } else + (*brief_fns[type]) (obj); + } else { + if (dont_decend) + printf("$%s", var_name(var)); + else { + if (var != NULL) + printf("$%s=", var_name(var)); + (*brief_fns[type]) (obj); + } } cur_depth--; dont_decend = FALSE; } -void reset_printer() +void +reset_printer() { cur_clock++; cur_lines = 0; dont_decend = FALSE; } -void print(lispobj obj) +void +print(lispobj obj) { skip_newline = TRUE; cur_depth = 0; @@ -733,7 +766,8 @@ void print(lispobj obj) putchar('\n'); } -void brief_print(lispobj obj) +void +brief_print(lispobj obj) { skip_newline = TRUE; cur_depth = 0; diff --git a/lisp/purify.c b/lisp/purify.c index 5721e725e..10870a6af 100644 --- a/lisp/purify.c +++ b/lisp/purify.c @@ -10,7 +10,7 @@ and x86/GENCGC stack scavenging, by Douglas Crosher, 1996, 1997, 1998. - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.33 2005/09/05 06:09:13 cshapiro Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/purify.c,v 1.34 2005/09/15 18:26:52 rtoy Exp $ */ #include <stdio.h> @@ -60,16 +60,16 @@ static lispobj *current_dynamic_space_free_pointer; lose ("readonly-space overflow! File \"%s\", line %d\n", \ __FILE__, __LINE__); \ } while (0) + - /* These hold the original end of the read_only and static spaces so we can */ /* tell what are forwarding pointers. */ static lispobj *read_only_end, *static_end; static lispobj *read_only_free, *static_free; -static lispobj *pscav(lispobj *addr, int nwords, boolean constant); +static lispobj *pscav(lispobj * addr, int nwords, boolean constant); #define LATERBLOCKSIZE 1020 #define LATERMAXCOUNT 10 @@ -77,8 +77,8 @@ static lispobj *pscav(lispobj *addr, int nwords, boolean constant); static struct later { struct later *next; union { - lispobj *ptr; - int count; + lispobj *ptr; + int count; } u[LATERBLOCKSIZE]; } *later_blocks = NULL; static int later_count = 0; @@ -92,31 +92,30 @@ static int later_count = 0; #define RAW_ADDR_OFFSET (6*sizeof(lispobj) - type_FunctionPointer) #endif -static boolean +static boolean forwarding_pointer_p(lispobj obj) { lispobj *ptr; - ptr = (lispobj *)obj; + ptr = (lispobj *) obj; return ((static_end <= ptr && ptr <= static_free) || - (read_only_end <= ptr && ptr <= read_only_free)); + (read_only_end <= ptr && ptr <= read_only_free)); } -static boolean +static boolean dynamic_pointer_p(lispobj ptr) { #if !(defined(i386) || defined(__x86_64)) - return (ptr >= (lispobj)dynamic_0_space); + return (ptr >= (lispobj) dynamic_0_space); #else /* Be more conservative, and remember, this is a maybe */ - return (ptr >= (lispobj)current_dynamic_space - && - ptr < (lispobj)current_dynamic_space_free_pointer); + return (ptr >= (lispobj) current_dynamic_space + && ptr < (lispobj) current_dynamic_space_free_pointer); #endif } - + #if (defined(i386) || defined(__x86_64)) #ifdef WANT_CGC @@ -125,101 +124,108 @@ dynamic_pointer_p(lispobj ptr) static int maybe_can_move_p(lispobj thing) { - lispobj *thingp,header; - if (dynamic_pointer_p(thing)) { /* in dynamic space */ - thingp = (lispobj*)PTR(thing); - header = *thingp; - if(Pointerp(header) && forwarding_pointer_p(header)) - return -1; /* must change it */ - if(LowtagOf(thing) == type_ListPointer) - return type_ListPointer; /* can we check this somehow */ - else if (thing & 3) { /* not fixnum */ - int kind = TypeOf(header); - /* printf(" %x %x",header,kind); */ - switch (kind) { /* something with a header */ - case type_Bignum: - case type_SingleFloat: - case type_DoubleFloat: + lispobj *thingp, header; + + if (dynamic_pointer_p(thing)) { /* in dynamic space */ + thingp = (lispobj *) PTR(thing); + header = *thingp; + if (Pointerp(header) && forwarding_pointer_p(header)) + return -1; /* must change it */ + if (LowtagOf(thing) == type_ListPointer) + return type_ListPointer; /* can we check this somehow */ + else if (thing & 3) { /* not fixnum */ + int kind = TypeOf(header); + + /* printf(" %x %x",header,kind); */ + switch (kind) { /* something with a header */ + case type_Bignum: + case type_SingleFloat: + case type_DoubleFloat: #ifdef type_LongFloat - case type_LongFloat: -#endif - case type_Sap: - case type_SimpleVector: - case type_SimpleString: - case type_SimpleBitVector: - case type_SimpleArrayUnsignedByte2: - case type_SimpleArrayUnsignedByte4: - case type_SimpleArrayUnsignedByte8: - case type_SimpleArrayUnsignedByte16: - case type_SimpleArrayUnsignedByte32: + case type_LongFloat: +#endif + case type_Sap: + case type_SimpleVector: + case type_SimpleString: + case type_SimpleBitVector: + case type_SimpleArrayUnsignedByte2: + case type_SimpleArrayUnsignedByte4: + case type_SimpleArrayUnsignedByte8: + case type_SimpleArrayUnsignedByte16: + case type_SimpleArrayUnsignedByte32: #ifdef type_SimpleArraySignedByte8 - case type_SimpleArraySignedByte8: + case type_SimpleArraySignedByte8: #endif #ifdef type_SimpleArraySignedByte16 - case type_SimpleArraySignedByte16: + case type_SimpleArraySignedByte16: #endif #ifdef type_SimpleArraySignedByte30 - case type_SimpleArraySignedByte30: + case type_SimpleArraySignedByte30: #endif #ifdef type_SimpleArraySignedByte32 - case type_SimpleArraySignedByte32: + case type_SimpleArraySignedByte32: #endif - case type_SimpleArraySingleFloat: - case type_SimpleArrayDoubleFloat: + case type_SimpleArraySingleFloat: + case type_SimpleArrayDoubleFloat: #ifdef type_SimpleArrayLongFloat - case type_SimpleArrayLongFloat: + case type_SimpleArrayLongFloat: #endif #ifdef type_SimpleArrayComplexSingleFloat - case type_SimpleArrayComplexSingleFloat: + case type_SimpleArrayComplexSingleFloat: #endif #ifdef type_SimpleArrayComplexDoubleFloat - case type_SimpleArrayComplexDoubleFloat: + case type_SimpleArrayComplexDoubleFloat: #endif #ifdef type_SimpleArrayComplexLongFloat - case type_SimpleArrayComplexLongFloat: + case type_SimpleArrayComplexLongFloat: #endif - case type_CodeHeader: - case type_FunctionHeader: - case type_ClosureFunctionHeader: - case type_ReturnPcHeader: - case type_ClosureHeader: - case type_FuncallableInstanceHeader: - case type_InstanceHeader: - case type_ValueCellHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: - case type_DylanFunctionHeader: - case type_WeakPointer: - case type_Fdefn: + case type_CodeHeader: + case type_FunctionHeader: + case type_ClosureFunctionHeader: + case type_ReturnPcHeader: + case type_ClosureHeader: + case type_FuncallableInstanceHeader: + case type_InstanceHeader: + case type_ValueCellHeader: + case type_ByteCodeFunction: + case type_ByteCodeClosure: + case type_DylanFunctionHeader: + case type_WeakPointer: + case type_Fdefn: #ifdef type_ScavengerHook - case type_ScavengerHook: + case type_ScavengerHook: #endif - return kind; - break; - default: - return 0; - }}} - return 0; + return kind; + break; + default: + return 0; + } + } + } + return 0; } -static int pverbose=0; +static int pverbose = 0; + #define PVERBOSE pverbose static void -carefully_pscav_stack(lispobj*lowaddr, lispobj*base) +carefully_pscav_stack(lispobj * lowaddr, lispobj * base) { - lispobj*sp = lowaddr; - while(sp < base) - { int k; - lispobj thing = *sp; - if((unsigned)thing & 0x3) /* may be pointer */ - { - /* need to check for valid float/double? */ - k = maybe_can_move_p(thing); - if(PVERBOSE)printf("%8x %8x %d\n",sp, thing, k); - if(k) - pscav(sp, 1, FALSE); + lispobj *sp = lowaddr; + + while (sp < base) { + int k; + lispobj thing = *sp; + + if ((unsigned) thing & 0x3) { /* may be pointer */ + /* need to check for valid float/double? */ + k = maybe_can_move_p(thing); + if (PVERBOSE) + printf("%8x %8x %d\n", sp, thing, k); + if (k) + pscav(sp, 1, FALSE); } - sp++; + sp++; } } #endif @@ -238,187 +244,200 @@ carefully_pscav_stack(lispobj*lowaddr, lispobj*base) static unsigned pointer_filter_verbose = 0; static int -valid_dynamic_space_pointer(lispobj *pointer, lispobj *start_addr) +valid_dynamic_space_pointer(lispobj * pointer, lispobj * start_addr) { - /* If it's not a return address then it needs to be a valid lisp - pointer. */ - if (!Pointerp((lispobj)pointer)) - return FALSE; - - /* Check that the object pointed to is consistent with the pointer - low tag. */ - switch (LowtagOf((lispobj)pointer)) { - case type_FunctionPointer: - /* Start_addr should be the enclosing code object, or a closure - header. */ - switch (TypeOf(*start_addr)) { - case type_CodeHeader: - /* This case is probably caught above. */ - break; - case type_ClosureHeader: - case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: - case type_DylanFunctionHeader: - if ((int)pointer != ((int)start_addr+type_FunctionPointer)) { - if (pointer_filter_verbose) - fprintf(stderr,"*Wf2: %p %p %lx\n", pointer, start_addr, *start_addr); + /* If it's not a return address then it needs to be a valid lisp + pointer. */ + if (!Pointerp((lispobj) pointer)) return FALSE; - } - break; - default: - if (pointer_filter_verbose) - fprintf(stderr,"*Wf3: %p %p %lx\n", pointer, start_addr, *start_addr); - return FALSE; - } - break; - case type_ListPointer: - if ((int)pointer != ((int)start_addr+type_ListPointer)) { - if (pointer_filter_verbose) - fprintf(stderr,"*Wl1: %p %p %lx\n", pointer, start_addr, *start_addr); - return FALSE; - } - /* Is it plausible cons? */ - if((Pointerp(start_addr[0]) - || ((start_addr[0] & 3) == 0) /* fixnum */ - || (TypeOf(start_addr[0]) == type_BaseChar) - || (TypeOf(start_addr[0]) == type_UnboundMarker)) - && (Pointerp(start_addr[1]) - || ((start_addr[1] & 3) == 0) /* fixnum */ - || (TypeOf(start_addr[1]) == type_BaseChar) - || (TypeOf(start_addr[1]) == type_UnboundMarker))) - break; - else { - if (pointer_filter_verbose) - fprintf(stderr,"*Wl2: %p %p %lx\n", pointer, start_addr, *start_addr); - return FALSE; - } - case type_InstancePointer: - if ((int)pointer != ((int)start_addr+type_InstancePointer)) { - if (pointer_filter_verbose) - fprintf(stderr,"*Wi1: %p %p %lx\n", pointer, start_addr, *start_addr); - return FALSE; - } - if (TypeOf(start_addr[0]) != type_InstanceHeader) { - if (pointer_filter_verbose) - fprintf(stderr,"*Wi2: %p %p %lx\n", pointer, start_addr, *start_addr); - return FALSE; - } - break; - case type_OtherPointer: - if ((int)pointer != ((int)start_addr+type_OtherPointer)) { - if (pointer_filter_verbose) - fprintf(stderr,"*Wo1: %p %p %lx\n", pointer, start_addr, *start_addr); - return FALSE; - } - /* Is it plausible? Not a cons. X should check the headers. */ - if(Pointerp(start_addr[0]) || ((start_addr[0] & 3) == 0)) { - if (pointer_filter_verbose) - fprintf(stderr,"*Wo2: %p %p %lx\n", pointer, start_addr, *start_addr); - return FALSE; - } - switch (TypeOf(start_addr[0])) { - case type_UnboundMarker: - case type_BaseChar: - if (pointer_filter_verbose) - fprintf(stderr,"*Wo3: %p %p %lx\n", pointer, start_addr, *start_addr); - return FALSE; - - /* Only pointed to by function pointers? */ - case type_ClosureHeader: - case type_FuncallableInstanceHeader: - case type_ByteCodeFunction: - case type_ByteCodeClosure: - case type_DylanFunctionHeader: - if (pointer_filter_verbose) - fprintf(stderr,"*Wo4: %p %p %lx\n", pointer, start_addr, *start_addr); - return FALSE; - - case type_InstanceHeader: - if (pointer_filter_verbose) - fprintf(stderr,"*Wo5: %p %p %lx\n", pointer, start_addr, *start_addr); - return FALSE; - - /* The valid other immediate pointer objects */ - case type_SimpleVector: - case type_Ratio: - case type_Complex: + + /* Check that the object pointed to is consistent with the pointer + low tag. */ + switch (LowtagOf((lispobj) pointer)) { + case type_FunctionPointer: + /* Start_addr should be the enclosing code object, or a closure + header. */ + switch (TypeOf(*start_addr)) { + case type_CodeHeader: + /* This case is probably caught above. */ + break; + case type_ClosureHeader: + case type_FuncallableInstanceHeader: + case type_ByteCodeFunction: + case type_ByteCodeClosure: + case type_DylanFunctionHeader: + if ((int) pointer != ((int) start_addr + type_FunctionPointer)) { + if (pointer_filter_verbose) + fprintf(stderr, "*Wf2: %p %p %lx\n", pointer, + start_addr, *start_addr); + return FALSE; + } + break; + default: + if (pointer_filter_verbose) + fprintf(stderr, "*Wf3: %p %p %lx\n", pointer, start_addr, + *start_addr); + return FALSE; + } + break; + case type_ListPointer: + if ((int) pointer != ((int) start_addr + type_ListPointer)) { + if (pointer_filter_verbose) + fprintf(stderr, "*Wl1: %p %p %lx\n", pointer, start_addr, + *start_addr); + return FALSE; + } + /* Is it plausible cons? */ + if ((Pointerp(start_addr[0]) + || ((start_addr[0] & 3) == 0) /* fixnum */ + ||(TypeOf(start_addr[0]) == type_BaseChar) + || (TypeOf(start_addr[0]) == type_UnboundMarker)) + && (Pointerp(start_addr[1]) + || ((start_addr[1] & 3) == 0) /* fixnum */ + ||(TypeOf(start_addr[1]) == type_BaseChar) + || (TypeOf(start_addr[1]) == type_UnboundMarker))) + break; + else { + if (pointer_filter_verbose) + fprintf(stderr, "*Wl2: %p %p %lx\n", pointer, start_addr, + *start_addr); + return FALSE; + } + case type_InstancePointer: + if ((int) pointer != ((int) start_addr + type_InstancePointer)) { + if (pointer_filter_verbose) + fprintf(stderr, "*Wi1: %p %p %lx\n", pointer, start_addr, + *start_addr); + return FALSE; + } + if (TypeOf(start_addr[0]) != type_InstanceHeader) { + if (pointer_filter_verbose) + fprintf(stderr, "*Wi2: %p %p %lx\n", pointer, start_addr, + *start_addr); + return FALSE; + } + break; + case type_OtherPointer: + if ((int) pointer != ((int) start_addr + type_OtherPointer)) { + if (pointer_filter_verbose) + fprintf(stderr, "*Wo1: %p %p %lx\n", pointer, start_addr, + *start_addr); + return FALSE; + } + /* Is it plausible? Not a cons. X should check the headers. */ + if (Pointerp(start_addr[0]) || ((start_addr[0] & 3) == 0)) { + if (pointer_filter_verbose) + fprintf(stderr, "*Wo2: %p %p %lx\n", pointer, start_addr, + *start_addr); + return FALSE; + } + switch (TypeOf(start_addr[0])) { + case type_UnboundMarker: + case type_BaseChar: + if (pointer_filter_verbose) + fprintf(stderr, "*Wo3: %p %p %lx\n", pointer, start_addr, + *start_addr); + return FALSE; + + /* Only pointed to by function pointers? */ + case type_ClosureHeader: + case type_FuncallableInstanceHeader: + case type_ByteCodeFunction: + case type_ByteCodeClosure: + case type_DylanFunctionHeader: + if (pointer_filter_verbose) + fprintf(stderr, "*Wo4: %p %p %lx\n", pointer, start_addr, + *start_addr); + return FALSE; + + case type_InstanceHeader: + if (pointer_filter_verbose) + fprintf(stderr, "*Wo5: %p %p %lx\n", pointer, start_addr, + *start_addr); + return FALSE; + + /* The valid other immediate pointer objects */ + case type_SimpleVector: + case type_Ratio: + case type_Complex: #ifdef type_ComplexSingleFloat - case type_ComplexSingleFloat: + case type_ComplexSingleFloat: #endif #ifdef type_ComplexDoubleFloat - case type_ComplexDoubleFloat: + case type_ComplexDoubleFloat: #endif #ifdef type_ComplexLongFloat - case type_ComplexLongFloat: -#endif - case type_SimpleArray: - case type_ComplexString: - case type_ComplexBitVector: - case type_ComplexVector: - case type_ComplexArray: - case type_ValueCellHeader: - case type_SymbolHeader: - case type_Fdefn: - case type_CodeHeader: - case type_Bignum: - case type_SingleFloat: - case type_DoubleFloat: + case type_ComplexLongFloat: +#endif + case type_SimpleArray: + case type_ComplexString: + case type_ComplexBitVector: + case type_ComplexVector: + case type_ComplexArray: + case type_ValueCellHeader: + case type_SymbolHeader: + case type_Fdefn: + case type_CodeHeader: + case type_Bignum: + case type_SingleFloat: + case type_DoubleFloat: #ifdef type_LongFloat - case type_LongFloat: -#endif - case type_SimpleString: - case type_SimpleBitVector: - case type_SimpleArrayUnsignedByte2: - case type_SimpleArrayUnsignedByte4: - case type_SimpleArrayUnsignedByte8: - case type_SimpleArrayUnsignedByte16: - case type_SimpleArrayUnsignedByte32: + case type_LongFloat: +#endif + case type_SimpleString: + case type_SimpleBitVector: + case type_SimpleArrayUnsignedByte2: + case type_SimpleArrayUnsignedByte4: + case type_SimpleArrayUnsignedByte8: + case type_SimpleArrayUnsignedByte16: + case type_SimpleArrayUnsignedByte32: #ifdef type_SimpleArraySignedByte8 - case type_SimpleArraySignedByte8: + case type_SimpleArraySignedByte8: #endif #ifdef type_SimpleArraySignedByte16 - case type_SimpleArraySignedByte16: + case type_SimpleArraySignedByte16: #endif #ifdef type_SimpleArraySignedByte30 - case type_SimpleArraySignedByte30: + case type_SimpleArraySignedByte30: #endif #ifdef type_SimpleArraySignedByte32 - case type_SimpleArraySignedByte32: + case type_SimpleArraySignedByte32: #endif - case type_SimpleArraySingleFloat: - case type_SimpleArrayDoubleFloat: + case type_SimpleArraySingleFloat: + case type_SimpleArrayDoubleFloat: #ifdef type_SimpleArrayLongFloat - case type_SimpleArrayLongFloat: + case type_SimpleArrayLongFloat: #endif #ifdef type_SimpleArrayComplexSingleFloat - case type_SimpleArrayComplexSingleFloat: + case type_SimpleArrayComplexSingleFloat: #endif #ifdef type_SimpleArrayComplexDoubleFloat - case type_SimpleArrayComplexDoubleFloat: + case type_SimpleArrayComplexDoubleFloat: #endif #ifdef type_SimpleArrayComplexLongFloat - case type_SimpleArrayComplexLongFloat: + case type_SimpleArrayComplexLongFloat: #endif - case type_Sap: - case type_WeakPointer: - case type_ScavengerHook: - break; + case type_Sap: + case type_WeakPointer: + case type_ScavengerHook: + break; - default: - if (pointer_filter_verbose) - fprintf(stderr,"*Wo6: %p %p %lx\n", pointer, start_addr, *start_addr); - return FALSE; + default: + if (pointer_filter_verbose) + fprintf(stderr, "*Wo6: %p %p %lx\n", pointer, start_addr, + *start_addr); + return FALSE; + } + break; + default: + if (pointer_filter_verbose) + fprintf(stderr, "*W?: %p %p %lx\n", pointer, start_addr, + *start_addr); + return FALSE; } - break; - default: - if (pointer_filter_verbose) - fprintf(stderr,"*W?: %p %p %lx\n", pointer, start_addr, *start_addr); - return FALSE; - } - - /* Looks good */ - return TRUE; + + /* Looks good */ + return TRUE; } #define MAX_STACK_POINTERS 1024 @@ -434,99 +453,107 @@ unsigned int num_valid_stack_ra_locations; * Identify valid stack slots. */ -static void setup_i386_stack_scav(lispobj *lowaddr, lispobj *base) +static void +setup_i386_stack_scav(lispobj * lowaddr, lispobj * base) { - lispobj *sp = lowaddr; - - num_valid_stack_locations = 0; - num_valid_stack_ra_locations = 0; - - for (sp = lowaddr; sp < base; sp++) { - lispobj thing = *sp; - lispobj* start_addr; - /* Find the object start address */ - if ((start_addr = search_dynamic_space((void *) thing)) != NULL) { - /* - * Need to allow raw pointers into Code objects for return - * addresses. This will also pickup pointers to functions in code - * objects. - */ - if (TypeOf(*start_addr) == type_CodeHeader) { - gc_assert(num_valid_stack_ra_locations < 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 *) ((int) start_addr + type_OtherPointer); - } else { - if (valid_dynamic_space_pointer((void *) thing, start_addr)) { - gc_assert(num_valid_stack_locations < MAX_STACK_POINTERS); - valid_stack_locations[num_valid_stack_locations++] = sp; + lispobj *sp = lowaddr; + + num_valid_stack_locations = 0; + num_valid_stack_ra_locations = 0; + + for (sp = lowaddr; sp < base; sp++) { + lispobj thing = *sp; + lispobj *start_addr; + + /* Find the object start address */ + if ((start_addr = search_dynamic_space((void *) thing)) != NULL) { + /* + * Need to allow raw pointers into Code objects for return + * addresses. This will also pickup pointers to functions in code + * objects. + */ + if (TypeOf(*start_addr) == type_CodeHeader) { + gc_assert(num_valid_stack_ra_locations < + 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 *) ((int) start_addr + type_OtherPointer); + } else { + if (valid_dynamic_space_pointer((void *) thing, start_addr)) { + gc_assert(num_valid_stack_locations < MAX_STACK_POINTERS); + valid_stack_locations[num_valid_stack_locations++] = sp; + } + } } - } } - } - if (pointer_filter_verbose) { - fprintf(stderr, "Number of valid stack pointers = %d\n", - num_valid_stack_locations); - fprintf(stderr, "Number of stack return addresses = %d\n", - num_valid_stack_ra_locations); - } + if (pointer_filter_verbose) { + fprintf(stderr, "Number of valid stack pointers = %d\n", + num_valid_stack_locations); + fprintf(stderr, "Number of stack return addresses = %d\n", + num_valid_stack_ra_locations); + } } -static void pscav_i386_stack(void) +static void +pscav_i386_stack(void) { - int i; - - for (i = 0; i < num_valid_stack_locations; i++) - pscav(valid_stack_locations[i], 1, FALSE); - - for (i = 0; i < num_valid_stack_ra_locations; i++) { - lispobj code_obj = (lispobj)(valid_stack_ra_code_objects[i]); - pscav(&code_obj, 1, FALSE); - if (pointer_filter_verbose) - fprintf(stderr, "*C moved RA %lx to %x; for code object %p to %lx\n", - *valid_stack_ra_locations[i], - (int) (*valid_stack_ra_locations[i]) - - ((int) valid_stack_ra_code_objects[i] - (int)code_obj), - valid_stack_ra_code_objects[i], code_obj); - *valid_stack_ra_locations[i] = - (lispobj)((int) (*valid_stack_ra_locations[i]) - - ((int) valid_stack_ra_code_objects[i] - (int) code_obj)); - } + int i; + + for (i = 0; i < num_valid_stack_locations; i++) + pscav(valid_stack_locations[i], 1, FALSE); + + for (i = 0; i < num_valid_stack_ra_locations; i++) { + lispobj code_obj = (lispobj) (valid_stack_ra_code_objects[i]); + + pscav(&code_obj, 1, FALSE); + if (pointer_filter_verbose) + fprintf(stderr, + "*C moved RA %lx to %x; for code object %p to %lx\n", + *valid_stack_ra_locations[i], + (int) (*valid_stack_ra_locations[i]) + - ((int) valid_stack_ra_code_objects[i] - (int) code_obj), + valid_stack_ra_code_objects[i], code_obj); + *valid_stack_ra_locations[i] = + (lispobj) ((int) (*valid_stack_ra_locations[i]) + - ((int) valid_stack_ra_code_objects[i] - + (int) code_obj)); + } } #endif #endif - -static void -pscav_later(lispobj *where, int count) + +static void +pscav_later(lispobj * where, int count) { struct later *new; if (count > LATERMAXCOUNT) { - while (count > LATERMAXCOUNT) { - pscav_later(where, LATERMAXCOUNT); - count -= LATERMAXCOUNT; - where += LATERMAXCOUNT; - } - } - else { - if (later_blocks == NULL || later_count == LATERBLOCKSIZE || - (later_count == LATERBLOCKSIZE-1 && count > 1)) { - new = (struct later *)malloc(sizeof(struct later)); - new->next = later_blocks; - if (later_blocks && later_count < LATERBLOCKSIZE) - later_blocks->u[later_count].ptr = NULL; - later_blocks = new; - later_count = 0; - } - - if (count != 1) - later_blocks->u[later_count++].count = count; - later_blocks->u[later_count++].ptr = where; + while (count > LATERMAXCOUNT) { + pscav_later(where, LATERMAXCOUNT); + count -= LATERMAXCOUNT; + where += LATERMAXCOUNT; + } + } else { + if (later_blocks == NULL || later_count == LATERBLOCKSIZE || + (later_count == LATERBLOCKSIZE - 1 && count > 1)) { + new = (struct later *) malloc(sizeof(struct later)); + + new->next = later_blocks; + if (later_blocks && later_count < LATERBLOCKSIZE) + later_blocks->u[later_count].ptr = NULL; + later_blocks = new; + later_count = 0; + } + + if (count != 1) + later_blocks->u[later_count++].count = count; + later_blocks->u[later_count++].ptr = where; } } -static lispobj ptrans_boxed(lispobj thing, lispobj header, boolean constant) +static lispobj +ptrans_boxed(lispobj thing, lispobj header, boolean constant) { int nwords; lispobj result, *new, *old; @@ -534,25 +561,24 @@ static lispobj ptrans_boxed(lispobj thing, lispobj header, boolean constant) nwords = 1 + HeaderValue(header); /* Allocate it */ - old = (lispobj *)PTR(thing); + old = (lispobj *) PTR(thing); if (constant) { - new = read_only_free; - read_only_free += CEILING(nwords, 2); - assert_readonly_space_bounds (read_only_free); - } - else { - new = static_free; - static_free += CEILING(nwords, 2); - assert_static_space_bounds (static_free); + new = read_only_free; + read_only_free += CEILING(nwords, 2); + assert_readonly_space_bounds(read_only_free); + } else { + new = static_free; + static_free += CEILING(nwords, 2); + assert_static_space_bounds(static_free); } /* Copy it. */ memmove(new, old, nwords * sizeof(lispobj)); /* Deposit forwarding pointer. */ - result = (lispobj)new | LowtagOf(thing); + result = (lispobj) new | LowtagOf(thing); *old = result; - + /* Scavenge it. */ pscav(new, nwords, constant); @@ -563,51 +589,53 @@ static lispobj ptrans_boxed(lispobj thing, lispobj header, boolean constant) only then can we transport as constant. If it is pure, we can ALWAYS transport as a constant */ -static lispobj ptrans_instance(lispobj thing, lispobj header, boolean constant) +static lispobj +ptrans_instance(lispobj thing, lispobj header, boolean constant) { - lispobj layout = ((struct instance *)PTR(thing))->slots[0]; - lispobj pure = ((struct instance *)PTR(layout))->slots[15]; + lispobj layout = ((struct instance *) PTR(thing))->slots[0]; + lispobj pure = ((struct instance *) PTR(layout))->slots[15]; switch (pure) { - case T: - return (ptrans_boxed(thing, header, 1)); - case NIL: - return (ptrans_boxed(thing, header, 0)); - case 0: { - /* Substructure: special case for the compact-info-envs, where - the instance may have a point to the dynamic 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. */ - int nwords; - lispobj result, *new, *old; - - nwords = 1 + HeaderValue(header); - - /* Allocate it */ - old = (lispobj *)PTR(thing); - new = static_free; - static_free += CEILING(nwords, 2); - assert_static_space_bounds (static_free); - - /* Copy it. */ - memmove(new, old, nwords * sizeof(lispobj)); - - /* Deposit forwarding pointer. */ - result = (lispobj)new | LowtagOf(thing); - *old = result; - - /* Scavenge it. */ - pscav(new, nwords, 1); - - return result; - } - default: - gc_abort(); - return 0; /* squelch stupid warning */ + case T: + return (ptrans_boxed(thing, header, 1)); + case NIL: + return (ptrans_boxed(thing, header, 0)); + case 0:{ + /* Substructure: special case for the compact-info-envs, where + the instance may have a point to the dynamic 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. */ + int nwords; + lispobj result, *new, *old; + + nwords = 1 + HeaderValue(header); + + /* Allocate it */ + old = (lispobj *) PTR(thing); + new = static_free; + static_free += CEILING(nwords, 2); + assert_static_space_bounds(static_free); + + /* Copy it. */ + memmove(new, old, nwords * sizeof(lispobj)); + + /* Deposit forwarding pointer. */ + result = (lispobj) new | LowtagOf(thing); + *old = result; + + /* Scavenge it. */ + pscav(new, nwords, 1); + + return result; + } + default: + gc_abort(); + return 0; /* squelch stupid warning */ } } - -static lispobj ptrans_fdefn(lispobj thing, lispobj header) + +static lispobj +ptrans_fdefn(lispobj thing, lispobj header) { int nwords; lispobj result, *new, *old, oldfn; @@ -616,29 +644,30 @@ static lispobj ptrans_fdefn(lispobj thing, lispobj header) nwords = 1 + HeaderValue(header); /* Allocate it */ - old = (lispobj *)PTR(thing); + old = (lispobj *) PTR(thing); new = static_free; static_free += CEILING(nwords, 2); - assert_static_space_bounds (static_free); + assert_static_space_bounds(static_free); /* Copy it. */ memmove(new, old, nwords * sizeof(lispobj)); /* Deposit forwarding pointer. */ - result = (lispobj)new | LowtagOf(thing); + result = (lispobj) new | LowtagOf(thing); *old = result; /* Scavenge the function. */ - fdefn = (struct fdefn *)new; + fdefn = (struct fdefn *) new; oldfn = fdefn->function; pscav(&fdefn->function, 1, FALSE); - if ((char *)oldfn + RAW_ADDR_OFFSET == fdefn->raw_addr) - fdefn->raw_addr = (char *)fdefn->function + RAW_ADDR_OFFSET; + if ((char *) oldfn + RAW_ADDR_OFFSET == fdefn->raw_addr) + fdefn->raw_addr = (char *) fdefn->function + RAW_ADDR_OFFSET; return result; } -static lispobj ptrans_unboxed(lispobj thing, lispobj header) +static lispobj +ptrans_unboxed(lispobj thing, lispobj header) { int nwords; lispobj result, *new, *old; @@ -646,53 +675,55 @@ static lispobj ptrans_unboxed(lispobj thing, lispobj header) nwords = 1 + HeaderValue(header); /* Allocate it */ - old = (lispobj *)PTR(thing); + old = (lispobj *) PTR(thing); new = read_only_free; read_only_free += CEILING(nwords, 2); - assert_readonly_space_bounds (read_only_free); + assert_readonly_space_bounds(read_only_free); /* Copy it. */ memmove(new, old, nwords * sizeof(lispobj)); /* Deposit forwarding pointer. */ - result = (lispobj)new | LowtagOf(thing); + result = (lispobj) new | LowtagOf(thing); *old = result; return result; } -static lispobj ptrans_vector(lispobj thing, int bits, int extra, - boolean boxed, boolean constant) +static lispobj +ptrans_vector(lispobj thing, int bits, int extra, + boolean boxed, boolean constant) { struct vector *vector; int nwords; lispobj result, *new; - vector = (struct vector *)PTR(thing); -#ifdef __x86_64 - nwords = 2 + (CEILING((fixnum_value(vector->length)+extra)*bits,64)>>6); + vector = (struct vector *) PTR(thing); +#ifdef __x86_64 + nwords = + 2 + (CEILING((fixnum_value(vector->length) + extra) * bits, 64) >> 6); #else - nwords = 2 + (CEILING((fixnum_value(vector->length)+extra)*bits,32)>>5); + nwords = + 2 + (CEILING((fixnum_value(vector->length) + extra) * bits, 32) >> 5); #endif if (boxed && !constant) { - new = static_free; - static_free += CEILING(nwords, 2); - assert_static_space_bounds (static_free); - } - else { - new = read_only_free; - read_only_free += CEILING(nwords, 2); - assert_readonly_space_bounds (read_only_free); + new = static_free; + static_free += CEILING(nwords, 2); + assert_static_space_bounds(static_free); + } else { + new = read_only_free; + read_only_free += CEILING(nwords, 2); + assert_readonly_space_bounds(read_only_free); } memmove(new, vector, nwords * sizeof(lispobj)); - result = (lispobj)new | LowtagOf(thing); + result = (lispobj) new | LowtagOf(thing); vector->header = result; if (boxed) - pscav(new, nwords, constant); + pscav(new, nwords, constant); return result; } @@ -701,157 +732,163 @@ static lispobj ptrans_vector(lispobj thing, int bits, int extra, static void apply_code_fixups_during_purify(struct code *old_code, struct code *new_code) { - int nheader_words, ncode_words, nwords; - void *code_start_addr; - lispobj fixups = NIL; - unsigned displacement = (unsigned)new_code - (unsigned)old_code; - struct vector *fixups_vector; - - /* Byte compiled code has no fixups. The trace table offset will be - a fixnum if it's x86 compiled code - check. */ - if (new_code->trace_table_offset & 0x3) - return; - - /* Else it's x86 machine code. */ - ncode_words = fixnum_value(new_code->code_size); - nheader_words = HeaderValue(*(lispobj *)new_code); - nwords = ncode_words + nheader_words; - - code_start_addr = (void *)new_code + nheader_words*sizeof(lispobj); - - /* The first constant should be a pointer to the fixups for this - code objects. Check. */ - fixups = new_code->constants[0]; - - /* It will be 0 or the unbound-marker if there are no fixups, and - will be an other-pointer to a vector if it is valid. */ - if ((fixups==0) || (fixups==type_UnboundMarker) || !Pointerp(fixups)) { + int nheader_words, ncode_words, nwords; + void *code_start_addr; + lispobj fixups = NIL; + unsigned displacement = (unsigned) new_code - (unsigned) old_code; + struct vector *fixups_vector; + + /* Byte compiled code has no fixups. The trace table offset will be + a fixnum if it's x86 compiled code - check. */ + if (new_code->trace_table_offset & 0x3) + return; + + /* Else it's x86 machine code. */ + ncode_words = fixnum_value(new_code->code_size); + nheader_words = HeaderValue(*(lispobj *) new_code); + nwords = ncode_words + nheader_words; + + code_start_addr = (void *) new_code + nheader_words * sizeof(lispobj); + + /* The first constant should be a pointer to the fixups for this + code objects. Check. */ + fixups = new_code->constants[0]; + + /* It will be 0 or the unbound-marker if there are no fixups, and + will be an other-pointer to a vector if it is valid. */ + if ((fixups == 0) || (fixups == type_UnboundMarker) || !Pointerp(fixups)) { #if defined(GENCGC) && (defined(i386) || defined(__x86_64)) - /* Check for a possible errors. */ - sniff_code_object(new_code,displacement); -#endif - return; - } - - fixups_vector = (struct vector *)PTR(fixups); - - /* Could be pointing to a forwarding pointer. */ - if (Pointerp(fixups) && (dynamic_pointer_p(fixups)) - && forwarding_pointer_p(*(lispobj *)fixups_vector)) { - /* If so then follow it. */ - fixups_vector = (struct vector *)PTR(*(lispobj *)fixups_vector); - } - - if (TypeOf(fixups_vector->header) == type_SimpleArrayUnsignedByte32) { - /* Got the fixups for the code block. Now work through the vector, - and apply a fixup at each address. */ - int length = fixnum_value(fixups_vector->length); - /* offset_vector still has 32-bit elements on amd64. - Eventually we will make this consistent with internals.h */ - unsigned int *offset_vector = fixups_vector->data; - int i; - for (i=0; i<length; i++) { - unsigned offset = offset_vector[i]; - /* Now check the current value of offset. */ - unsigned old_value = *(unsigned *)((unsigned)code_start_addr + offset); - - /* 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*sizeof(lispobj)))) - /* So add the dispacement. */ - *(unsigned *)((unsigned)code_start_addr + offset) = old_value - + displacement; - else - /* It is outside the old code object so it must be a relative - fixup (absolute fixups are not saved). So subtract the - displacement. */ - *(unsigned *)((unsigned)code_start_addr + offset) = old_value - - displacement; + /* Check for a possible errors. */ + sniff_code_object(new_code, displacement); +#endif + return; + } + + fixups_vector = (struct vector *) PTR(fixups); + + /* Could be pointing to a forwarding pointer. */ + if (Pointerp(fixups) && (dynamic_pointer_p(fixups)) + && forwarding_pointer_p(*(lispobj *) fixups_vector)) { + /* If so then follow it. */ + fixups_vector = (struct vector *) PTR(*(lispobj *) fixups_vector); + } + + if (TypeOf(fixups_vector->header) == type_SimpleArrayUnsignedByte32) { + /* Got the fixups for the code block. Now work through the vector, + and apply a fixup at each address. */ + int length = fixnum_value(fixups_vector->length); + + /* offset_vector still has 32-bit elements on amd64. + Eventually we will make this consistent with internals.h */ + unsigned int *offset_vector = fixups_vector->data; + int i; + + for (i = 0; i < length; i++) { + unsigned offset = offset_vector[i]; + + /* Now check the current value of offset. */ + unsigned old_value = + + *(unsigned *) ((unsigned) code_start_addr + offset); + + /* 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 * sizeof(lispobj)))) + /* So add the dispacement. */ + *(unsigned *) ((unsigned) code_start_addr + offset) = old_value + + displacement; + else + /* It is outside the old code object so it must be a relative + fixup (absolute fixups are not saved). So subtract the + displacement. */ + *(unsigned *) ((unsigned) code_start_addr + offset) = old_value + - displacement; + } } - } - /* No longer need the fixups. */ - new_code->constants[0] = 0; - + /* No longer need the fixups. */ + new_code->constants[0] = 0; + #if defined(GENCGC) && (defined(i386) || defined(__x86_64)) - /* Check for possible errors. */ - sniff_code_object(new_code,displacement); + /* Check for possible errors. */ + sniff_code_object(new_code, displacement); #endif } #endif -static lispobj ptrans_code(lispobj thing) +static lispobj +ptrans_code(lispobj thing) { struct code *code, *new; int nwords; lispobj func, result; - code = (struct code *)PTR(thing); + code = (struct code *) PTR(thing); nwords = HeaderValue(code->header) + fixnum_value(code->code_size); - new = (struct code *)read_only_free; + new = (struct code *) read_only_free; read_only_free += CEILING(nwords, 2); - assert_readonly_space_bounds (read_only_free); + assert_readonly_space_bounds(read_only_free); memmove(new, code, nwords * sizeof(lispobj)); #if (defined(i386) || defined(__x86_64)) - apply_code_fixups_during_purify(code,new); + apply_code_fixups_during_purify(code, new); #endif - result = (lispobj)new | type_OtherPointer; + result = (lispobj) new | type_OtherPointer; /* Stick in a forwarding pointer for the code object. */ - *(lispobj *)code = result; + *(lispobj *) code = result; /* Put in forwarding pointers for all the functions. */ for (func = code->entry_points; - func != NIL; - func = ((struct function *)PTR(func))->next) { + func != NIL; func = ((struct function *) PTR(func))->next) { - gc_assert(LowtagOf(func) == type_FunctionPointer); + gc_assert(LowtagOf(func) == type_FunctionPointer); - *(lispobj *)PTR(func) = result + (func - thing); + *(lispobj *) PTR(func) = result + (func - thing); } /* Arrange to scavenge the debug info later. */ pscav_later(&new->debug_info, 1); - if(new->trace_table_offset & 0x3) + if (new->trace_table_offset & 0x3) #if 0 - pscav(&new->trace_table_offset, 1, FALSE); + pscav(&new->trace_table_offset, 1, FALSE); #else - new->trace_table_offset = NIL; /* limit lifetime */ + new->trace_table_offset = NIL; /* limit lifetime */ #endif /* Scavenge the constants. */ - pscav(new->constants, HeaderValue(new->header)-5, TRUE); + pscav(new->constants, HeaderValue(new->header) - 5, TRUE); /* Scavenge all the functions. */ pscav(&new->entry_points, 1, TRUE); for (func = new->entry_points; - func != NIL; - func = ((struct function *)PTR(func))->next) { - gc_assert(LowtagOf(func) == type_FunctionPointer); - gc_assert(!dynamic_pointer_p(func)); + func != NIL; func = ((struct function *) PTR(func))->next) { + gc_assert(LowtagOf(func) == type_FunctionPointer); + gc_assert(!dynamic_pointer_p(func)); #if (defined(i386) || defined(__x86_64)) /* Temporarily convert the self pointer to a real function - pointer. */ - ((struct function *)PTR(func))->self -= RAW_ADDR_OFFSET; + pointer. */ + ((struct function *) PTR(func))->self -= RAW_ADDR_OFFSET; #endif - pscav(&((struct function *)PTR(func))->self, 2, TRUE); + pscav(&((struct function *) PTR(func))->self, 2, TRUE); #if (defined(i386) || defined(__x86_64)) - ((struct function *)PTR(func))->self += RAW_ADDR_OFFSET; + ((struct function *) PTR(func))->self += RAW_ADDR_OFFSET; #endif - pscav_later(&((struct function *)PTR(func))->name, 3); + pscav_later(&((struct function *) PTR(func))->name, 3); } return result; } -static lispobj ptrans_func(lispobj thing, lispobj header) +static lispobj +ptrans_func(lispobj thing, lispobj header) { int nwords; lispobj code, *new, *old, result; @@ -864,68 +901,69 @@ static lispobj ptrans_func(lispobj thing, lispobj header) /* a code object. */ if (TypeOf(header) == type_FunctionHeader || - TypeOf(header) == type_ClosureFunctionHeader) { + TypeOf(header) == type_ClosureFunctionHeader) { /* We can only end up here if the code object has not been */ - /* scavenged, because if it had been scavenged, forwarding pointers */ - /* would have been left behind for all the entry points. */ - - function = (struct function *)PTR(thing); - code = (PTR(thing)-(HeaderValue(function->header)*sizeof(lispobj))) | - type_OtherPointer; - - /* This will cause the function's header to be replaced with a */ - /* forwarding pointer. */ - ptrans_code(code); - - /* So we can just return that. */ - return function->header; - } - else { + /* scavenged, because if it had been scavenged, forwarding pointers */ + /* would have been left behind for all the entry points. */ + + function = (struct function *) PTR(thing); + code = + (PTR(thing) - + (HeaderValue(function->header) * + sizeof(lispobj))) | type_OtherPointer; + + /* This will cause the function's header to be replaced with a */ + /* forwarding pointer. */ + ptrans_code(code); + + /* So we can just return that. */ + return function->header; + } else { /* It's some kind of closure-like thing. */ - nwords = 1 + HeaderValue(header); - old = (lispobj *)PTR(thing); + nwords = 1 + HeaderValue(header); + old = (lispobj *) PTR(thing); /* Allocate the new one. */ if (TypeOf(header) == type_FuncallableInstanceHeader) { /* FINs *must* not go in read_only space. */ new = static_free; static_free += CEILING(nwords, 2); - assert_static_space_bounds (static_free); - } - else { + assert_static_space_bounds(static_free); + } else { /* Closures can always go in read-only space, 'caues */ /* they never change. */ new = read_only_free; read_only_free += CEILING(nwords, 2); - assert_readonly_space_bounds (read_only_free); + assert_readonly_space_bounds(read_only_free); } - /* Copy it. */ - memmove(new, old, nwords * sizeof(lispobj)); + /* Copy it. */ + memmove(new, old, nwords * sizeof(lispobj)); - /* Deposit forwarding pointer. */ - result = (lispobj)new | LowtagOf(thing); - *old = result; + /* Deposit forwarding pointer. */ + result = (lispobj) new | LowtagOf(thing); + *old = result; - /* Scavenge it. */ - pscav(new, nwords, FALSE); + /* Scavenge it. */ + pscav(new, nwords, FALSE); - return result; + return result; } } -static lispobj ptrans_returnpc(lispobj thing, lispobj header) +static lispobj +ptrans_returnpc(lispobj thing, lispobj header) { lispobj code, new; /* Find the corresponding code object. */ - code = thing - HeaderValue(header)*sizeof(lispobj); + code = thing - HeaderValue(header) * sizeof(lispobj); /* Make sure it's been transported. */ - new = *(lispobj *)PTR(code); + new = *(lispobj *) PTR(code); if (!forwarding_pointer_p(new)) - new = ptrans_code(code); + new = ptrans_code(code); /* Maintain the offset: */ return new + (thing - code); @@ -933,51 +971,52 @@ static lispobj ptrans_returnpc(lispobj thing, lispobj header) #define WORDS_PER_CONS CEILING(sizeof(struct cons) / sizeof(lispobj), 2) -static lispobj ptrans_list(lispobj thing, boolean constant) +static lispobj +ptrans_list(lispobj thing, boolean constant) { struct cons *old, *new, *orig; int length; if (constant) - orig = (struct cons *)read_only_free; + orig = (struct cons *) read_only_free; else - orig = (struct cons *)static_free; + orig = (struct cons *) static_free; length = 0; do { - /* Allocate a new cons cell. */ - old = (struct cons *)PTR(thing); - if (constant) { - new = (struct cons *)read_only_free; - read_only_free += WORDS_PER_CONS; - assert_readonly_space_bounds (read_only_free); - } - else { - new = (struct cons *)static_free; - static_free += WORDS_PER_CONS; - assert_static_space_bounds (static_free); - } - - /* Copy the cons cell and keep a pointer to the cdr. */ - new->car = old->car; - thing = new->cdr = old->cdr; - - /* Set up the forwarding pointer. */ - *(lispobj *)old = ((lispobj)new) | type_ListPointer; - - /* And count this cell. */ - length++; + /* Allocate a new cons cell. */ + old = (struct cons *) PTR(thing); + if (constant) { + new = (struct cons *) read_only_free; + read_only_free += WORDS_PER_CONS; + assert_readonly_space_bounds(read_only_free); + } else { + new = (struct cons *) static_free; + static_free += WORDS_PER_CONS; + assert_static_space_bounds(static_free); + } + + /* Copy the cons cell and keep a pointer to the cdr. */ + new->car = old->car; + thing = new->cdr = old->cdr; + + /* Set up the forwarding pointer. */ + *(lispobj *) old = ((lispobj) new) | type_ListPointer; + + /* And count this cell. */ + length++; } while (LowtagOf(thing) == type_ListPointer && - dynamic_pointer_p(thing) && - !(forwarding_pointer_p(*(lispobj *)PTR(thing)))); + dynamic_pointer_p(thing) && + !(forwarding_pointer_p(*(lispobj *) PTR(thing)))); /* Scavenge the list we just copied. */ - pscav((lispobj *)orig, length * WORDS_PER_CONS, constant); + pscav((lispobj *) orig, length * WORDS_PER_CONS, constant); - return ((lispobj)orig) | type_ListPointer; + return ((lispobj) orig) | type_ListPointer; } -static lispobj ptrans_otherptr(lispobj thing, lispobj header, boolean constant) +static lispobj +ptrans_otherptr(lispobj thing, lispobj header, boolean constant) { switch (TypeOf(header)) { case type_Bignum: @@ -996,7 +1035,7 @@ static lispobj ptrans_otherptr(lispobj thing, lispobj header, boolean constant) case type_ComplexLongFloat: #endif case type_Sap: - return ptrans_unboxed(thing, header); + return ptrans_unboxed(thing, header); case type_Ratio: case type_Complex: @@ -1004,48 +1043,48 @@ static lispobj ptrans_otherptr(lispobj thing, lispobj header, boolean constant) case type_ComplexString: case type_ComplexVector: case type_ComplexArray: - return ptrans_boxed(thing, header, constant); - + return ptrans_boxed(thing, header, constant); + case type_ValueCellHeader: case type_WeakPointer: #ifdef type_ScavengerHook case type_ScavengerHook: #endif - return ptrans_boxed(thing, header, FALSE); + return ptrans_boxed(thing, header, FALSE); case type_SymbolHeader: - return ptrans_boxed(thing, header, FALSE); + return ptrans_boxed(thing, header, FALSE); case type_SimpleString: - return ptrans_vector(thing, 8, 1, FALSE, constant); + return ptrans_vector(thing, 8, 1, FALSE, constant); case type_SimpleBitVector: - return ptrans_vector(thing, 1, 0, FALSE, constant); + return ptrans_vector(thing, 1, 0, FALSE, constant); case type_SimpleVector: -#ifdef __x86_64 - return ptrans_vector(thing, 64, 0, TRUE, constant); +#ifdef __x86_64 + return ptrans_vector(thing, 64, 0, TRUE, constant); #else - return ptrans_vector(thing, 32, 0, TRUE, constant); + return ptrans_vector(thing, 32, 0, TRUE, constant); #endif case type_SimpleArrayUnsignedByte2: - return ptrans_vector(thing, 2, 0, FALSE, constant); + return ptrans_vector(thing, 2, 0, FALSE, constant); case type_SimpleArrayUnsignedByte4: - return ptrans_vector(thing, 4, 0, FALSE, constant); + return ptrans_vector(thing, 4, 0, FALSE, constant); case type_SimpleArrayUnsignedByte8: #ifdef type_SimpleArraySignedByte8 case type_SimpleArraySignedByte8: #endif - return ptrans_vector(thing, 8, 0, FALSE, constant); + return ptrans_vector(thing, 8, 0, FALSE, constant); case type_SimpleArrayUnsignedByte16: #ifdef type_SimpleArraySignedByte16 case type_SimpleArraySignedByte16: #endif - return ptrans_vector(thing, 16, 0, FALSE, constant); + return ptrans_vector(thing, 16, 0, FALSE, constant); case type_SimpleArrayUnsignedByte32: #ifdef type_SimpleArraySignedByte30 @@ -1054,79 +1093,82 @@ static lispobj ptrans_otherptr(lispobj thing, lispobj header, boolean constant) #ifdef type_SimpleArraySignedByte32 case type_SimpleArraySignedByte32: #endif - return ptrans_vector(thing, 32, 0, FALSE, constant); + return ptrans_vector(thing, 32, 0, FALSE, constant); case type_SimpleArraySingleFloat: - return ptrans_vector(thing, 32, 0, FALSE, constant); + return ptrans_vector(thing, 32, 0, FALSE, constant); case type_SimpleArrayDoubleFloat: - return ptrans_vector(thing, 64, 0, FALSE, constant); + return ptrans_vector(thing, 64, 0, FALSE, constant); #ifdef type_SimpleArrayLongFloat case type_SimpleArrayLongFloat: #if (defined(i386) || defined(__x86_64)) - return ptrans_vector(thing, 96, 0, FALSE, constant); + return ptrans_vector(thing, 96, 0, FALSE, constant); #endif #ifdef sparc - return ptrans_vector(thing, 128, 0, FALSE, constant); + return ptrans_vector(thing, 128, 0, FALSE, constant); #endif #endif #ifdef type_SimpleArrayComplexSingleFloat case type_SimpleArrayComplexSingleFloat: - return ptrans_vector(thing, 64, 0, FALSE, constant); + return ptrans_vector(thing, 64, 0, FALSE, constant); #endif #ifdef type_SimpleArrayComplexDoubleFloat case type_SimpleArrayComplexDoubleFloat: - return ptrans_vector(thing, 128, 0, FALSE, constant); + return ptrans_vector(thing, 128, 0, FALSE, constant); #endif #ifdef type_SimpleArrayComplexLongFloat case type_SimpleArrayComplexLongFloat: #if (defined(i386) || defined(__x86_64)) - return ptrans_vector(thing, 192, 0, FALSE, constant); + return ptrans_vector(thing, 192, 0, FALSE, constant); #endif #ifdef sparc - return ptrans_vector(thing, 256, 0, FALSE, constant); + return ptrans_vector(thing, 256, 0, FALSE, constant); #endif #endif case type_CodeHeader: - return ptrans_code(thing); + return ptrans_code(thing); case type_ReturnPcHeader: - return ptrans_returnpc(thing, header); + return ptrans_returnpc(thing, header); case type_Fdefn: - return ptrans_fdefn(thing, header); + return ptrans_fdefn(thing, header); default: - /* Should only come across other pointers to the above stuff. */ - gc_abort(); - return NIL; + /* Should only come across other pointers to the above stuff. */ + gc_abort(); + return NIL; } } -static int pscav_fdefn(struct fdefn *fdefn) +static int +pscav_fdefn(struct fdefn *fdefn) { boolean fix_func; - fix_func = ((char *)(fdefn->function+RAW_ADDR_OFFSET) == fdefn->raw_addr); + fix_func = + ((char *) (fdefn->function + RAW_ADDR_OFFSET) == fdefn->raw_addr); pscav(&fdefn->name, 1, TRUE); pscav(&fdefn->function, 1, FALSE); if (fix_func) - fdefn->raw_addr = (char *)(fdefn->function + RAW_ADDR_OFFSET); + fdefn->raw_addr = (char *) (fdefn->function + RAW_ADDR_OFFSET); return sizeof(struct fdefn) / sizeof(lispobj); } #if (defined(i386) || defined(__x86_64)) /* now putting code objects in static space */ static int -pscav_code(struct code*code) +pscav_code(struct code *code) { int nwords; lispobj func; + nwords = HeaderValue(code->header) + fixnum_value(code->code_size); /* pw--The trace_table_offset slot can contain a list pointer. This @@ -1136,287 +1178,305 @@ pscav_code(struct code*code) * normally become unreachable after the loader calls them and * won't be seen by purify at all!! */ - if(code->trace_table_offset & 0x3) + if (code->trace_table_offset & 0x3) #if 0 - pscav(&code->trace_table_offset, 1, FALSE); + pscav(&code->trace_table_offset, 1, FALSE); #else - code->trace_table_offset = NIL; /* limit lifetime */ + code->trace_table_offset = NIL; /* limit lifetime */ #endif /* Arrange to scavenge the debug info later. */ pscav_later(&code->debug_info, 1); /* Scavenge the constants. */ - pscav(code->constants, HeaderValue(code->header)-5, TRUE); + pscav(code->constants, HeaderValue(code->header) - 5, TRUE); /* Scavenge all the functions. */ pscav(&code->entry_points, 1, TRUE); for (func = code->entry_points; - func != NIL; - func = ((struct function *)PTR(func))->next) { - gc_assert(LowtagOf(func) == type_FunctionPointer); - gc_assert(!dynamic_pointer_p(func)); + func != NIL; func = ((struct function *) PTR(func))->next) { + gc_assert(LowtagOf(func) == type_FunctionPointer); + gc_assert(!dynamic_pointer_p(func)); /* Temporarly convert the self pointer to a real function - pointer. */ - ((struct function *)PTR(func))->self -= RAW_ADDR_OFFSET; - pscav(&((struct function *)PTR(func))->self, 2, TRUE); - ((struct function *)PTR(func))->self += RAW_ADDR_OFFSET; - pscav_later(&((struct function *)PTR(func))->name, 3); + pointer. */ + ((struct function *) PTR(func))->self -= RAW_ADDR_OFFSET; + pscav(&((struct function *) PTR(func))->self, 2, TRUE); + ((struct function *) PTR(func))->self += RAW_ADDR_OFFSET; + pscav_later(&((struct function *) PTR(func))->name, 3); } - return CEILING(nwords,2); + return CEILING(nwords, 2); } #endif #ifdef type_ScavengerHook -static struct scavenger_hook *scavenger_hooks=(void*)NIL; +static struct scavenger_hook *scavenger_hooks = (void *) NIL; -static int pscav_scavenger_hook(struct scavenger_hook *scav_hook) +static int +pscav_scavenger_hook(struct scavenger_hook *scav_hook) { - lispobj old_value = scav_hook->value; - - /* Scavenge the value */ - pscav((lispobj *)scav_hook+1, 1, FALSE); - - /* Did the value object move? */ - if (scav_hook->value != old_value) { - /* Check if this hook is already noted. */ - if (scav_hook->next == NULL) { - scav_hook->next = scavenger_hooks; - scavenger_hooks = (struct scavenger_hook*) ((unsigned long)scav_hook | type_OtherPointer); + lispobj old_value = scav_hook->value; + + /* Scavenge the value */ + pscav((lispobj *) scav_hook + 1, 1, FALSE); + + /* Did the value object move? */ + if (scav_hook->value != old_value) { + /* Check if this hook is already noted. */ + if (scav_hook->next == NULL) { + scav_hook->next = scavenger_hooks; + scavenger_hooks = + (struct scavenger_hook *) ((unsigned long) scav_hook | + type_OtherPointer); + } } - } - - /* Scavenge the function */ - pscav((lispobj *)scav_hook+2, 1, FALSE); - return 4; + /* Scavenge the function */ + pscav((lispobj *) scav_hook + 2, 1, FALSE); + + return 4; } #endif -static lispobj *pscav(lispobj *addr, int nwords, boolean constant) +static lispobj * +pscav(lispobj * addr, int nwords, boolean constant) { lispobj thing, *thingp, header; int count = 0; struct vector *vector; while (nwords > 0) { - thing = *addr; - if (Pointerp(thing)) { - /* It's a pointer. Is it something we might have to move? */ - if (dynamic_pointer_p(thing)) { - /* Maybe. Have we already moved it? */ - thingp = (lispobj *)PTR(thing); - header = *thingp; - if (Pointerp(header) && forwarding_pointer_p(header)) - /* Yep, so just copy the forwarding pointer. */ - thing = header; - else { - /* Nope, copy the object. */ - switch (LowtagOf(thing)) { - case type_FunctionPointer: - thing = ptrans_func(thing, header); - break; - - case type_ListPointer: - thing = ptrans_list(thing, constant); - break; - - case type_InstancePointer: - thing = ptrans_instance(thing, header, constant); - break; - - case type_OtherPointer: - thing = ptrans_otherptr(thing, header, constant); - break; - - default: - /* It was a pointer, but not one of them? */ - gc_abort(); - } - } - *addr = thing; - } - count = 1; - } - else if (thing & 3) { - /* It's an other immediate. Maybe the header for an unboxed */ - /* object. */ - switch (TypeOf(thing)) { - case type_Bignum: - case type_SingleFloat: - case type_DoubleFloat: + thing = *addr; + if (Pointerp(thing)) { + /* It's a pointer. Is it something we might have to move? */ + if (dynamic_pointer_p(thing)) { + /* Maybe. Have we already moved it? */ + thingp = (lispobj *) PTR(thing); + header = *thingp; + if (Pointerp(header) && forwarding_pointer_p(header)) + /* Yep, so just copy the forwarding pointer. */ + thing = header; + else { + /* Nope, copy the object. */ + switch (LowtagOf(thing)) { + case type_FunctionPointer: + thing = ptrans_func(thing, header); + break; + + case type_ListPointer: + thing = ptrans_list(thing, constant); + break; + + case type_InstancePointer: + thing = ptrans_instance(thing, header, constant); + break; + + case type_OtherPointer: + thing = ptrans_otherptr(thing, header, constant); + break; + + default: + /* It was a pointer, but not one of them? */ + gc_abort(); + } + } + *addr = thing; + } + count = 1; + } else if (thing & 3) { + /* It's an other immediate. Maybe the header for an unboxed */ + /* object. */ + switch (TypeOf(thing)) { + case type_Bignum: + case type_SingleFloat: + case type_DoubleFloat: #ifdef type_LongFloat - case type_LongFloat: -#endif - case type_Sap: - /* It's an unboxed simple object. */ - count = HeaderValue(thing)+1; - break; - - case type_SimpleVector: - if (HeaderValue(thing) == subtype_VectorValidHashing) - *addr = (subtype_VectorMustRehash<<type_Bits) | - type_SimpleVector; - count = 1; - break; - - case type_SimpleString: - vector = (struct vector *)addr; + case type_LongFloat: +#endif + case type_Sap: + /* It's an unboxed simple object. */ + count = HeaderValue(thing) + 1; + break; + + case type_SimpleVector: + if (HeaderValue(thing) == subtype_VectorValidHashing) + *addr = (subtype_VectorMustRehash << type_Bits) | + type_SimpleVector; + count = 1; + break; + + case type_SimpleString: + vector = (struct vector *) addr; #ifdef __x86_64 - count = CEILING(NWORDS(fixnum_value(vector->length)+1,8)+2,2); + count = + CEILING(NWORDS(fixnum_value(vector->length) + 1, 8) + 2, + 2); #else - count = CEILING(NWORDS(fixnum_value(vector->length)+1,4)+2,2); + count = + CEILING(NWORDS(fixnum_value(vector->length) + 1, 4) + 2, + 2); #endif - break; + break; - case type_SimpleBitVector: - vector = (struct vector *)addr; + case type_SimpleBitVector: + vector = (struct vector *) addr; #ifdef __x86_64 - count = CEILING(NWORDS(fixnum_value(vector->length),64)+2,2); + count = + CEILING(NWORDS(fixnum_value(vector->length), 64) + 2, 2); #else - count = CEILING(NWORDS(fixnum_value(vector->length),32)+2,2); + count = + CEILING(NWORDS(fixnum_value(vector->length), 32) + 2, 2); #endif - break; + break; - case type_SimpleArrayUnsignedByte2: - vector = (struct vector *)addr; + case type_SimpleArrayUnsignedByte2: + vector = (struct vector *) addr; #ifdef __x86_64 - count = CEILING(NWORDS(fixnum_value(vector->length),32)+2,2); + count = + CEILING(NWORDS(fixnum_value(vector->length), 32) + 2, 2); #else - count = CEILING(NWORDS(fixnum_value(vector->length),16)+2,2); + count = + CEILING(NWORDS(fixnum_value(vector->length), 16) + 2, 2); #endif - break; + break; - case type_SimpleArrayUnsignedByte4: - vector = (struct vector *)addr; + case type_SimpleArrayUnsignedByte4: + vector = (struct vector *) addr; #ifdef __x86_64 - count = CEILING(NWORDS(fixnum_value(vector->length),16)+2,2); + count = + CEILING(NWORDS(fixnum_value(vector->length), 16) + 2, 2); #else - count = CEILING(NWORDS(fixnum_value(vector->length),8)+2,2); + count = + CEILING(NWORDS(fixnum_value(vector->length), 8) + 2, 2); #endif - break; + break; - case type_SimpleArrayUnsignedByte8: + case type_SimpleArrayUnsignedByte8: #ifdef type_SimpleArraySignedByte8 - case type_SimpleArraySignedByte8: + case type_SimpleArraySignedByte8: #endif - vector = (struct vector *)addr; + vector = (struct vector *) addr; #ifdef __x86_64 - count = CEILING(NWORDS(fixnum_value(vector->length),8)+2,2); + count = + CEILING(NWORDS(fixnum_value(vector->length), 8) + 2, 2); #else - count = CEILING(NWORDS(fixnum_value(vector->length),4)+2,2); + count = + CEILING(NWORDS(fixnum_value(vector->length), 4) + 2, 2); #endif - break; + break; - case type_SimpleArrayUnsignedByte16: + case type_SimpleArrayUnsignedByte16: #ifdef type_SimpleArraySignedByte16 - case type_SimpleArraySignedByte16: + case type_SimpleArraySignedByte16: #endif - vector = (struct vector *)addr; + vector = (struct vector *) addr; #ifdef __x86_64 - count = CEILING(NWORDS(fixnum_value(vector->length),4)+2,2); + count = + CEILING(NWORDS(fixnum_value(vector->length), 4) + 2, 2); #else - count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2); + count = + CEILING(NWORDS(fixnum_value(vector->length), 2) + 2, 2); #endif - break; + break; - case type_SimpleArrayUnsignedByte32: + case type_SimpleArrayUnsignedByte32: #ifdef type_SimpleArraySignedByte30 - case type_SimpleArraySignedByte30: + case type_SimpleArraySignedByte30: #endif #ifdef type_SimpleArraySignedByte32 - case type_SimpleArraySignedByte32: + case type_SimpleArraySignedByte32: #endif - vector = (struct vector *)addr; + vector = (struct vector *) addr; #ifdef __x86_64 - count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2); + count = + CEILING(NWORDS(fixnum_value(vector->length), 2) + 2, 2); #else - count = CEILING(fixnum_value(vector->length)+2,2); + count = CEILING(fixnum_value(vector->length) + 2, 2); #endif - break; + break; - case type_SimpleArraySingleFloat: - vector = (struct vector *)addr; + case type_SimpleArraySingleFloat: + vector = (struct vector *) addr; #ifdef __x86_64 - count = CEILING(NWORDS(fixnum_value(vector->length),2)+2,2); + count = + CEILING(NWORDS(fixnum_value(vector->length), 2) + 2, 2); #else - count = CEILING(fixnum_value(vector->length)+2,2); + count = CEILING(fixnum_value(vector->length) + 2, 2); #endif - break; + break; - case type_SimpleArrayDoubleFloat: + case type_SimpleArrayDoubleFloat: #ifdef type_SimpleArrayComplexSingleFloat - case type_SimpleArrayComplexSingleFloat: + case type_SimpleArrayComplexSingleFloat: #endif - vector = (struct vector *)addr; + vector = (struct vector *) addr; #ifdef __x86_64 - count = CEILING(fixnum_value(vector->length)+2,2); + count = CEILING(fixnum_value(vector->length) + 2, 2); #else - count = fixnum_value(vector->length)*2+2; + count = fixnum_value(vector->length) * 2 + 2; #endif - break; + break; #ifdef type_SimpleArrayLongFloat - case type_SimpleArrayLongFloat: - vector = (struct vector *)addr; + case type_SimpleArrayLongFloat: + vector = (struct vector *) addr; #ifdef i386 - count = fixnum_value(vector->length)*3+2; + count = fixnum_value(vector->length) * 3 + 2; #endif #ifdef __x86_64 - count = fixnum_value(vector->length)*2+2; + count = fixnum_value(vector->length) * 2 + 2; #endif #ifdef sparc - count = fixnum_value(vector->length)*4+2; + count = fixnum_value(vector->length) * 4 + 2; #endif - break; + break; #endif #ifdef type_SimpleArrayComplexDoubleFloat - case type_SimpleArrayComplexDoubleFloat: - vector = (struct vector *)addr; + case type_SimpleArrayComplexDoubleFloat: + vector = (struct vector *) addr; #ifdef __x86_64 - count = fixnum_value(vector->length)*2+2; + count = fixnum_value(vector->length) * 2 + 2; #else - count = fixnum_value(vector->length)*4+2; + count = fixnum_value(vector->length) * 4 + 2; #endif - break; + break; #endif #ifdef type_SimpleArrayComplexLongFloat - case type_SimpleArrayComplexLongFloat: - vector = (struct vector *)addr; + case type_SimpleArrayComplexLongFloat: + vector = (struct vector *) addr; #ifdef i386 - count = fixnum_value(vector->length)*6+2; + count = fixnum_value(vector->length) * 6 + 2; #endif #ifdef __x86_64 - count = fixnum_value(vector->length)*4+2; + count = fixnum_value(vector->length) * 4 + 2; #endif #ifdef sparc - count = fixnum_value(vector->length)*8+2; + count = fixnum_value(vector->length) * 8 + 2; #endif - break; + break; #endif - case type_CodeHeader: + case type_CodeHeader: #if !(defined(i386) || defined(__x86_64)) - gc_abort(); /* No code headers in static space */ + gc_abort(); /* No code headers in static space */ #else - count = pscav_code((struct code*)addr); + count = pscav_code((struct code *) addr); #endif - break; + break; - case type_FunctionHeader: - case type_ClosureFunctionHeader: - case type_ReturnPcHeader: - /* We should never hit any of these, 'cause they occur */ - /* buried in the middle of code objects. */ + case type_FunctionHeader: + case type_ClosureFunctionHeader: + case type_ReturnPcHeader: + /* We should never hit any of these, 'cause they occur */ + /* buried in the middle of code objects. */ - gc_abort(); + gc_abort(); - - break; + + break; #if (defined(i386) || defined(__x86_64)) case type_ClosureHeader: @@ -1424,55 +1484,56 @@ static lispobj *pscav(lispobj *addr, int nwords, boolean constant) case type_ByteCodeFunction: case type_ByteCodeClosure: case type_DylanFunctionHeader: - /* The function self pointer needs special care on the - x86 because it is the real entry point. */ - { - lispobj fun = ((struct closure *)addr)->function - - RAW_ADDR_OFFSET; - pscav(&fun, 1, constant); - ((struct closure *)addr)->function = fun + RAW_ADDR_OFFSET; - } - count = 2; - break; -#endif - - case type_WeakPointer: - /* Weak pointers get preserved during purify, 'cause I don't */ - /* feel like figuring out how to break them. */ - pscav(addr+1, 2, constant); - count = 4; - break; + /* The function self pointer needs special care on the + x86 because it is the real entry point. */ + { + lispobj fun = ((struct closure *) addr)->function + + - RAW_ADDR_OFFSET; + pscav(&fun, 1, constant); + ((struct closure *) addr)->function = fun + RAW_ADDR_OFFSET; + } + count = 2; + break; +#endif + + case type_WeakPointer: + /* Weak pointers get preserved during purify, 'cause I don't */ + /* feel like figuring out how to break them. */ + pscav(addr + 1, 2, constant); + count = 4; + break; case type_Fdefn: - /* We have to handle fdefn objects specially, so we can fix */ - /* up the raw function address. */ - count = pscav_fdefn((struct fdefn *)addr); - break; + /* We have to handle fdefn objects specially, so we can fix */ + /* up the raw function address. */ + count = pscav_fdefn((struct fdefn *) addr); + break; #ifdef type_ScavengerHook - case type_ScavengerHook: - count = pscav_scavenger_hook((struct scavenger_hook *)addr); - break; -#endif - - default: - count = 1; - break; - } - } - else { - /* It's a fixnum. */ - count = 1; - } - - addr += count; - nwords -= count; + case type_ScavengerHook: + count = pscav_scavenger_hook((struct scavenger_hook *) addr); + break; +#endif + + default: + count = 1; + break; + } + } else { + /* It's a fixnum. */ + count = 1; + } + + addr += count; + nwords -= count; } return addr; } -int purify(lispobj static_roots, lispobj read_only_roots) +int +purify(lispobj static_roots, lispobj read_only_roots) { lispobj *clean; int count, i; @@ -1484,20 +1545,19 @@ int purify(lispobj static_roots, lispobj read_only_roots) #endif if (fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX)) != 0) { - printf(" Ack! Can't purify interrupt contexts. "); - fflush(stdout); - return 0; + printf(" Ack! Can't purify interrupt contexts. "); + fflush(stdout); + return 0; } - #if defined(ibmrt) || defined(i386) || defined(__x86_64) - current_dynamic_space_free_pointer = - (lispobj*)SymbolValue(ALLOCATION_POINTER); + current_dynamic_space_free_pointer = + (lispobj *) SymbolValue(ALLOCATION_POINTER); #endif read_only_end = read_only_free = - (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER); + (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER); static_end = static_free = - (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER); + (lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER); #ifdef PRINTNOISE printf(" roots"); @@ -1506,10 +1566,10 @@ int purify(lispobj static_roots, lispobj read_only_roots) #ifdef GENCGC #if (defined(i386) || defined(__x86_64)) - gc_assert(control_stack_end > ((&read_only_roots)+1)); - setup_i386_stack_scav(((&static_roots)-2), control_stack_end); + gc_assert(control_stack_end > ((&read_only_roots) + 1)); + setup_i386_stack_scav(((&static_roots) - 2), control_stack_end); #elif defined(sparc) -#endif +#endif #endif pscav(&static_roots, 1, FALSE); @@ -1520,8 +1580,7 @@ int purify(lispobj static_roots, lispobj read_only_roots) fflush(stdout); #endif pscav((lispobj *) interrupt_handlers, - sizeof(interrupt_handlers) / sizeof(lispobj), - FALSE); + sizeof(interrupt_handlers) / sizeof(lispobj), FALSE); #ifdef PRINTNOISE printf(" stack"); @@ -1534,8 +1593,8 @@ int purify(lispobj static_roots, lispobj read_only_roots) pscav_i386_stack(); #endif #ifdef WANT_CGC - gc_assert(control_stack_end > ((&read_only_roots)+1)); - carefully_pscav_stack(((&read_only_roots)+1), control_stack_end); + gc_assert(control_stack_end > ((&read_only_roots) + 1)); + carefully_pscav_stack(((&read_only_roots) + 1), control_stack_end); #endif #endif @@ -1546,17 +1605,21 @@ int purify(lispobj static_roots, lispobj read_only_roots) #if !defined(ibmrt) && !defined(i386) && !defined(__x86_64) pscav(binding_stack, current_binding_stack_pointer - binding_stack, FALSE); #else - pscav(binding_stack, (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack, FALSE); + pscav(binding_stack, + (lispobj *) SymbolValue(BINDING_STACK_POINTER) - binding_stack, + FALSE); #endif #ifdef SCAVENGE_READ_ONLY_SPACE if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != type_UnboundMarker && SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) { - unsigned read_only_space_size = - (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER) - read_only_space; - fprintf(stderr,"Scavenge read only space: %d bytes\n", - read_only_space_size * sizeof(lispobj)); - pscav(read_only_space, read_only_space_size, FALSE); + unsigned read_only_space_size = + (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER) - + + read_only_space; + fprintf(stderr, "Scavenge read only space: %d bytes\n", + read_only_space_size * sizeof(lispobj)); + pscav(read_only_space, read_only_space_size, FALSE); } #endif @@ -1566,28 +1629,26 @@ int purify(lispobj static_roots, lispobj read_only_roots) #endif clean = static_space; do { - while (clean != static_free) - clean = pscav(clean, static_free - clean, FALSE); - laters = later_blocks; - count = later_count; - later_blocks = NULL; - later_count = 0; - while (laters != NULL) { - for (i = 0; i < count; i++) { - if (laters->u[i].count == 0) - ; - else if (laters->u[i].count <= LATERMAXCOUNT) { - pscav(laters->u[i+1].ptr, laters->u[i].count, TRUE); - i++; - } - else - pscav(laters->u[i].ptr, 1, TRUE); - } - next = laters->next; - free(laters); - laters = next; - count = LATERBLOCKSIZE; - } + while (clean != static_free) + clean = pscav(clean, static_free - clean, FALSE); + laters = later_blocks; + count = later_count; + later_blocks = NULL; + later_count = 0; + while (laters != NULL) { + for (i = 0; i < count; i++) { + if (laters->u[i].count == 0); + else if (laters->u[i].count <= LATERMAXCOUNT) { + pscav(laters->u[i + 1].ptr, laters->u[i].count, TRUE); + i++; + } else + pscav(laters->u[i].ptr, 1, TRUE); + } + next = laters->next; + free(laters); + laters = next; + count = LATERBLOCKSIZE; + } } while (clean != static_free || later_blocks != NULL); @@ -1598,13 +1659,13 @@ int purify(lispobj static_roots, lispobj read_only_roots) #endif #if defined(WANT_CGC) && defined(X86_CGC_ACTIVE_P) - if(SymbolValue(X86_CGC_ACTIVE_P) != T) - os_zero((os_vm_address_t) current_dynamic_space, - (os_vm_size_t) dynamic_space_size); + if (SymbolValue(X86_CGC_ACTIVE_P) != T) + os_zero((os_vm_address_t) current_dynamic_space, + (os_vm_size_t) dynamic_space_size); #else #if !defined(GENCGC) os_zero((os_vm_address_t) current_dynamic_space, - (os_vm_size_t) dynamic_space_size); + (os_vm_size_t) dynamic_space_size); #endif #endif @@ -1614,25 +1675,26 @@ int purify(lispobj static_roots, lispobj read_only_roots) */ #if !(defined(i386) || defined(__x86_64)) os_zero((os_vm_address_t) current_control_stack_pointer, - (os_vm_size_t) (CONTROL_STACK_SIZE - - ((current_control_stack_pointer - control_stack) * - sizeof(lispobj)))); + (os_vm_size_t) (CONTROL_STACK_SIZE - + ((current_control_stack_pointer - control_stack) * + sizeof(lispobj)))); #endif #if defined(WANT_CGC) && defined(STATIC_BLUE_BAG) { - lispobj bag = SymbolValue(STATIC_BLUE_BAG); - struct cons*cons = (struct cons*) static_free; - struct cons*pair = cons + 1; - static_free += 2 * WORDS_PER_CONS; - if(bag == type_UnboundMarker) - bag = NIL; - cons->cdr = bag; - cons->car = (lispobj) pair | type_ListPointer; - pair->car = (lispobj) static_end; - pair->cdr = (lispobj) static_free; - bag = (lispobj)cons | type_ListPointer; - SetSymbolValue(STATIC_BLUE_BAG, bag); + lispobj bag = SymbolValue(STATIC_BLUE_BAG); + struct cons *cons = (struct cons *) static_free; + struct cons *pair = cons + 1; + + static_free += 2 * WORDS_PER_CONS; + if (bag == type_UnboundMarker) + bag = NIL; + cons->cdr = bag; + cons->car = (lispobj) pair | type_ListPointer; + pair->car = (lispobj) static_end; + pair->cdr = (lispobj) static_free; + bag = (lispobj) cons | type_ListPointer; + SetSymbolValue(STATIC_BLUE_BAG, bag); } #endif @@ -1648,10 +1710,10 @@ int purify(lispobj static_roots, lispobj read_only_roots) #else #if defined(WANT_CGC) && defined(X86_CGC_ACTIVE_P) /* X86 using CGC */ - if(SymbolValue(X86_CGC_ACTIVE_P) != T) - SetSymbolValue(ALLOCATION_POINTER, (lispobj) current_dynamic_space); + if (SymbolValue(X86_CGC_ACTIVE_P) != T) + SetSymbolValue(ALLOCATION_POINTER, (lispobj) current_dynamic_space); else - cgc_free_heap(); + cgc_free_heap(); #else #ifdef GENCGC gc_free_heap(); @@ -1663,19 +1725,23 @@ int purify(lispobj static_roots, lispobj read_only_roots) #endif #ifdef type_ScavengerHook - /* Call the scavenger hook functions */ - { - struct scavenger_hook *sh; - for (sh = (struct scavenger_hook*) PTR((int)scavenger_hooks); (lispobj)sh != PTR(NIL);) { - struct scavenger_hook *sh_next = (struct scavenger_hook*) PTR((unsigned long) sh->next); - funcall0(sh->function); - sh->next = NULL; - sh = sh_next; + /* Call the scavenger hook functions */ + { + struct scavenger_hook *sh; + + for (sh = (struct scavenger_hook *) PTR((int) scavenger_hooks); + (lispobj) sh != PTR(NIL);) { + struct scavenger_hook *sh_next = + (struct scavenger_hook *) PTR((unsigned long) sh->next); + + funcall0(sh->function); + sh->next = NULL; + sh = sh_next; + } + scavenger_hooks = (struct scavenger_hook *) NIL; } - scavenger_hooks = (struct scavenger_hook*) NIL; - } #endif - + #ifdef PRINTNOISE printf(" Done.]\n"); fflush(stdout); diff --git a/lisp/runprog.c b/lisp/runprog.c index e716d7998..ad5d00c7d 100644 --- a/lisp/runprog.c +++ b/lisp/runprog.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/runprog.c,v 1.6 2005/09/07 07:05:23 cshapiro Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/runprog.c,v 1.7 2005/09/15 18:26:52 rtoy Rel $ * * Support for run-program. * @@ -13,8 +13,9 @@ #include <termios.h> #include <unistd.h> -pid_t spawn(char *program, char *argv[], char *envp[], char *pty_name, - int stdin, int stdout, int stderr) +pid_t +spawn(char *program, char *argv[], char *envp[], char *pty_name, + int stdin, int stdout, int stderr) { pid_t pid; sigset_t set; @@ -66,7 +67,7 @@ pid_t spawn(char *program, char *argv[], char *envp[], char *pty_name, /* It didn't work, so try /bin/sh. */ argv[0] = program; argv[-1] = "sh"; - execve("/bin/sh", argv-1, envp); + execve("/bin/sh", argv - 1, envp); /* The exec didn't work, flame out. */ exit(1); diff --git a/lisp/save.c b/lisp/save.c index b6c6ecd82..8a61d6dfa 100644 --- a/lisp/save.c +++ b/lisp/save.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/save.c,v 1.12 2005/09/06 01:26:41 cshapiro Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/save.c,v 1.13 2005/09/15 18:26:52 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -28,38 +28,39 @@ extern int version; -static long write_bytes(FILE *file, char *addr, long bytes) +static long +write_bytes(FILE * file, char *addr, long bytes) { long count, here, data; - bytes = (bytes+CORE_PAGESIZE-1)&~(CORE_PAGESIZE-1); + bytes = (bytes + CORE_PAGESIZE - 1) & ~(CORE_PAGESIZE - 1); fflush(file); here = ftell(file); fseek(file, 0, 2); - data = (ftell(file)+CORE_PAGESIZE-1)&~(CORE_PAGESIZE-1); + data = (ftell(file) + CORE_PAGESIZE - 1) & ~(CORE_PAGESIZE - 1); fseek(file, data, 0); while (bytes > 0) { - count = fwrite(addr, 1, bytes, file); - if (count > 0) { - bytes -= count; - addr += count; - } - else { - perror("Error writing to save file"); - bytes = 0; - } + count = fwrite(addr, 1, bytes, file); + if (count > 0) { + bytes -= count; + addr += count; + } else { + perror("Error writing to save file"); + bytes = 0; + } } fflush(file); fseek(file, here, 0); - return data/CORE_PAGESIZE - 1; + return data / CORE_PAGESIZE - 1; } -static void output_space(FILE *file, int id, lispobj *addr, lispobj *end) +static void +output_space(FILE * file, int id, lispobj * addr, lispobj * end) { int words, bytes, data; - static char *names[] = {NULL, "Dynamic", "Static", "Read-Only"}; + static char *names[] = { NULL, "Dynamic", "Static", "Read-Only" }; putw(id, file); words = end - addr; @@ -68,48 +69,51 @@ static void output_space(FILE *file, int id, lispobj *addr, lispobj *end) bytes = words * sizeof(lispobj); printf("Writing %d bytes from the %s space at 0x%08lX.\n", - bytes, names[id], (unsigned long)addr); + bytes, names[id], (unsigned long) addr); - data = write_bytes(file, (char *)addr, bytes); + data = write_bytes(file, (char *) addr, bytes); putw(data, file); putw((long) addr / CORE_PAGESIZE, file); putw((bytes + CORE_PAGESIZE - 1) / CORE_PAGESIZE, file); } -boolean save(char *filename, lispobj init_function) +boolean +save(char *filename, lispobj init_function) { FILE *file; + #if defined WANT_CGC - volatile lispobj*func_ptr = &init_function; + volatile lispobj *func_ptr = &init_function; char sbuf[128]; - strcpy(sbuf,filename); - filename=sbuf; + + strcpy(sbuf, filename); + filename = sbuf; /* Get rid of remnant stuff. This is a MUST so that * the memory manager can get started correctly when * we restart after this save. Purify is going to * maybe move the args so we need to consider them volatile, * especially if the gcc optimizer is working!! */ - purify(NIL,NIL); + purify(NIL, NIL); init_function = *func_ptr; /* Set dynamic space pointer to base value so we don't write out * MBs of just cleared heap. */ - if(SymbolValue(X86_CGC_ACTIVE_P) != NIL) - SetSymbolValue(ALLOCATION_POINTER,DYNAMIC_0_SPACE_START); + if (SymbolValue(X86_CGC_ACTIVE_P) != NIL) + SetSymbolValue(ALLOCATION_POINTER, DYNAMIC_0_SPACE_START); #endif /* Open the file: */ remove(filename); file = fopen(filename, "w"); if (file == NULL) { - perror(filename); - return TRUE; + perror(filename); + return TRUE; } printf("[Undoing binding stack... "); fflush(stdout); - unbind_to_here((lispobj *)BINDING_STACK_START); + unbind_to_here((lispobj *) BINDING_STACK_START); SetSymbolValue(CURRENT_CATCH_BLOCK, 0); SetSymbolValue(CURRENT_UNWIND_PROTECT_BLOCK, 0); SetSymbolValue(EVAL_STACK_TOP, 0); @@ -126,16 +130,16 @@ boolean save(char *filename, lispobj init_function) putw(version, file); putw(CORE_NDIRECTORY, file); - putw((5*3)+2, file); + putw((5 * 3) + 2, file); output_space(file, READ_ONLY_SPACE_ID, read_only_space, - (lispobj *)SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); + (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER)); output_space(file, STATIC_SPACE_ID, static_space, - (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER)); + (lispobj *) SymbolValue(STATIC_SPACE_FREE_POINTER)); #ifdef GENCGC /* Flush the current_region updating the tables. */ - gc_alloc_update_page_tables(0,&boxed_region); - gc_alloc_update_page_tables(1,&unboxed_region); + gc_alloc_update_page_tables(0, &boxed_region); + gc_alloc_update_page_tables(1, &unboxed_region); update_dynamic_space_free_pointer(); #endif @@ -144,7 +148,7 @@ boolean save(char *filename, lispobj init_function) current_dynamic_space_free_pointer); #else output_space(file, DYNAMIC_SPACE_ID, current_dynamic_space, - (lispobj *)SymbolValue(ALLOCATION_POINTER)); + (lispobj *) SymbolValue(ALLOCATION_POINTER)); #endif putw(CORE_INITIAL_FUNCTION, file); diff --git a/lisp/search.c b/lisp/search.c index cd15664fa..a97c756da 100644 --- a/lisp/search.c +++ b/lisp/search.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/search.c,v 1.3 2004/07/07 22:22:59 rtoy Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/search.c,v 1.4 2005/09/15 18:26:52 rtoy Rel $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -13,41 +13,43 @@ #include "os.h" #include "search.h" -boolean search_for_type(int type, lispobj **start, int *count) +boolean +search_for_type(int type, lispobj ** start, int *count) { lispobj obj, *addr; while ((*count == -1 || (*count > 0)) && - valid_addr((os_vm_address_t)*start)) { - obj = **start; - addr = *start; - if (*count != -1) - *count -= 2; + valid_addr((os_vm_address_t) * start)) { + obj = **start; + addr = *start; + if (*count != -1) + *count -= 2; - if (TypeOf(obj) == type) - return TRUE; + if (TypeOf(obj) == type) + return TRUE; - (*start) += 2; + (*start) += 2; } return FALSE; } -boolean search_for_symbol(char *name, lispobj **start, int *count) +boolean +search_for_symbol(char *name, lispobj ** start, int *count) { struct symbol *symbol; struct vector *symbol_name; while (search_for_type(type_SymbolHeader, start, count)) { - symbol = (struct symbol *)PTR((lispobj)*start); + symbol = (struct symbol *) PTR((lispobj) * start); if (LowtagOf(symbol->name) == type_OtherPointer) { - symbol_name = (struct vector *)PTR(symbol->name); - if (valid_addr((os_vm_address_t)symbol_name) && + symbol_name = (struct vector *) PTR(symbol->name); + if (valid_addr((os_vm_address_t) symbol_name) && TypeOf(symbol_name->header) == type_SimpleString && - strcmp((char *)symbol_name->data, name) == 0) - return TRUE; + strcmp((char *) symbol_name->data, name) == 0) + return TRUE; } - (*start) += 2; + (*start) += 2; } return FALSE; } diff --git a/lisp/search.h b/lisp/search.h index 0b51b09f0..e67b89ace 100644 --- a/lisp/search.h +++ b/lisp/search.h @@ -1,11 +1,11 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/search.h,v 1.1 1992/07/28 20:15:32 wlott Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/search.h,v 1.2 2005/09/15 18:26:52 rtoy Rel $ */ #ifndef _SEARCH_H_ #define _SEARCH_H_ -extern boolean search_for_type(int type, lispobj **start, int *count); -extern boolean search_for_symbol(char *name, lispobj **start, int *count); +extern boolean search_for_type(int type, lispobj ** start, int *count); +extern boolean search_for_symbol(char *name, lispobj ** start, int *count); #endif diff --git a/lisp/socket.c b/lisp/socket.c index afba8385d..c834dd224 100644 --- a/lisp/socket.c +++ b/lisp/socket.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Attic/socket.c,v 1.5 2005/09/05 06:09:13 cshapiro Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/Attic/socket.c,v 1.6 2005/09/15 18:26:52 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -24,7 +24,7 @@ #include <errno.h> #include <netinet/in.h> #include <sys/ioctl.h> -#include <netdb.h> +#include <netdb.h> #include <sys/socket.h> #include <arpa/inet.h> #ifndef hpux @@ -50,100 +50,99 @@ * descriptor (network socket) or 0 if connection fails. */ -int connect_to_server (char *host, int display) +int +connect_to_server(char *host, int display) { - struct sockaddr_in inaddr; /* INET socket address. */ - struct sockaddr *addr; /* address to connect to */ - struct hostent *host_ptr; - int addrlen; /* length of address */ + struct sockaddr_in inaddr; /* INET socket address. */ + struct sockaddr *addr; /* address to connect to */ + struct hostent *host_ptr; + int addrlen; /* length of address */ + #ifdef UNIXCONN - struct sockaddr_un unaddr; /* UNIX socket address. */ + struct sockaddr_un unaddr; /* UNIX socket address. */ #endif - int fd; /* Network socket */ - { + int fd; /* Network socket */ + + { #ifdef UNIXCONN - if ((host[0] == '\0') || (strcmp("unix", host) == 0)) { - /* Connect locally using Unix domain. */ - unaddr.sun_family = AF_UNIX; - (void) strcpy(unaddr.sun_path, X_UNIX_PATH); - sprintf(&unaddr.sun_path[strlen(unaddr.sun_path)], "%d", display); - addr = (struct sockaddr *) &unaddr; - addrlen = strlen(unaddr.sun_path) + 2; - /* - * Open the network connection. - */ - if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0) { -#ifdef hpux /* this is disgusting */ /* cribbed from X11R4 xlib source */ - if (errno == ENOENT) { /* No such file or directory */ - sprintf(unaddr.sun_path, "%s%d", OLD_UNIX_PATH, display); - addrlen = strlen(unaddr.sun_path) + 2; - if ((fd = socket ((int) addr->sa_family, SOCK_STREAM, 0)) < 0) - return(-1); /* errno set by most recent system call. */ - } else + if ((host[0] == '\0') || (strcmp("unix", host) == 0)) { + /* Connect locally using Unix domain. */ + unaddr.sun_family = AF_UNIX; + (void) strcpy(unaddr.sun_path, X_UNIX_PATH); + sprintf(&unaddr.sun_path[strlen(unaddr.sun_path)], "%d", display); + addr = (struct sockaddr *) &unaddr; + addrlen = strlen(unaddr.sun_path) + 2; + /* + * Open the network connection. + */ + if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0) { +#ifdef hpux /* this is disgusting */ /* cribbed from X11R4 xlib source */ + if (errno == ENOENT) { /* No such file or directory */ + sprintf(unaddr.sun_path, "%s%d", OLD_UNIX_PATH, display); + addrlen = strlen(unaddr.sun_path) + 2; + if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < + 0) return (-1); /* errno set by most recent system call. */ + } else #endif /* hpux */ - return(-1); /* errno set by system call. */ - } - } else + return (-1); /* errno set by system call. */ + } + } else #endif /* UNIXCONN */ - { - /* Get the statistics on the specified host. */ - if ((inaddr.sin_addr.s_addr = inet_addr(host)) == -1) { - if ((host_ptr = gethostbyname(host)) == NULL) - { - /* No such host! */ - errno = EINVAL; - return(-1); + /* Get the statistics on the specified host. */ + if ((inaddr.sin_addr.s_addr = inet_addr(host)) == -1) { + if ((host_ptr = gethostbyname(host)) == NULL) { + /* No such host! */ + errno = EINVAL; + return (-1); + } + /* Check the address type for an internet host. */ + if (host_ptr->h_addrtype != AF_INET) { + /* Not an Internet host! */ + errno = EPROTOTYPE; + return (-1); + } + /* Set up the socket data. */ + inaddr.sin_family = host_ptr->h_addrtype; + memcpy((char *) &inaddr.sin_addr, + (char *) host_ptr->h_addr, sizeof(inaddr.sin_addr)); + } else { + inaddr.sin_family = AF_INET; } - /* Check the address type for an internet host. */ - if (host_ptr->h_addrtype != AF_INET) - { - /* Not an Internet host! */ - errno = EPROTOTYPE; - return(-1); + addr = (struct sockaddr *) &inaddr; + addrlen = sizeof(struct sockaddr_in); + + inaddr.sin_port = display + X_TCP_PORT; + inaddr.sin_port = htons(inaddr.sin_port); + /* + * Open the network connection. + */ + if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0) { + return (-1); /* errno set by system call. */ } - /* Set up the socket data. */ - inaddr.sin_family = host_ptr->h_addrtype; - memcpy((char *)&inaddr.sin_addr, - (char *)host_ptr->h_addr, - sizeof(inaddr.sin_addr)); - } - else - { - inaddr.sin_family = AF_INET; - } - addr = (struct sockaddr *) &inaddr; - addrlen = sizeof (struct sockaddr_in); - inaddr.sin_port = display + X_TCP_PORT; - inaddr.sin_port = htons(inaddr.sin_port); - /* - * Open the network connection. - */ - if ((fd = socket((int) addr->sa_family, SOCK_STREAM, 0)) < 0){ - return(-1); /* errno set by system call. */} - /* make sure to turn off TCP coalescence */ + /* make sure to turn off TCP coalescence */ #ifdef TCP_NODELAY - { - int mi = 1; - setsockopt (fd, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof (int)); - } + { + int mi = 1; + setsockopt(fd, IPPROTO_TCP, TCP_NODELAY, &mi, sizeof(int)); + } #endif - } + } + /* + * Changed 9/89 to retry connection if system call was interrupted. This + * is necessary for multiprocessing implementations that use timers, + * since the timer results in a SIGALRM. -- jdi + */ + while (connect(fd, addr, addrlen) == -1) { + if (errno != EINTR) { + (void) close(fd); + return (-1); /* errno set by system call. */ + } + } + } /* - * Changed 9/89 to retry connection if system call was interrupted. This - * is necessary for multiprocessing implementations that use timers, - * since the timer results in a SIGALRM. -- jdi + * Return the id if the connection succeeded. */ - while (connect(fd, addr, addrlen) == -1) { - if (errno != EINTR) { - (void) close (fd); - return(-1); /* errno set by system call. */ - } - } - } - /* - * Return the id if the connection succeeded. - */ - return(fd); + return (fd); } diff --git a/lisp/solaris-os.c b/lisp/solaris-os.c index 8aea1bb1b..e29e0884e 100644 --- a/lisp/solaris-os.c +++ b/lisp/solaris-os.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/solaris-os.c,v 1.15 2004/07/07 18:07:53 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/solaris-os.c,v 1.16 2005/09/15 18:26:52 rtoy Exp $ * * OS-dependent routines. This file (along with os.h) exports an * OS-independent interface to the operating system VM facilities. @@ -68,18 +68,19 @@ extern char *getenv(); #define ADJ_OFFSET(off,adj) (((off)==OFFSET_NONE) ? OFFSET_NONE : ((off)+(adj))) -long os_vm_page_size=(-1); -static long os_real_page_size=(-1); +long os_vm_page_size = (-1); +static long os_real_page_size = (-1); -static int zero_fd=(-1); +static int zero_fd = (-1); -static os_vm_size_t real_page_size_difference=0; +static os_vm_size_t real_page_size_difference = 0; static void -os_init_bailout(char* arg) +os_init_bailout(char *arg) { char buf[500]; - sprintf(buf,"os_init: %s",arg); + + sprintf(buf, "os_init: %s", arg); perror(buf); exit(1); } @@ -87,17 +88,17 @@ os_init_bailout(char* arg) void os_init(void) { - zero_fd=open(ZEROFILE,O_RDONLY); - if(zero_fd<0) + zero_fd = open(ZEROFILE, O_RDONLY); + if (zero_fd < 0) os_init_bailout(ZEROFILE); os_vm_page_size = os_real_page_size = sysconf(_SC_PAGESIZE); - if(os_vm_page_size>OS_VM_DEFAULT_PAGESIZE){ - fprintf(stderr,"os_init: Pagesize too large (%ld > %d)\n", - os_vm_page_size,OS_VM_DEFAULT_PAGESIZE); + if (os_vm_page_size > OS_VM_DEFAULT_PAGESIZE) { + fprintf(stderr, "os_init: Pagesize too large (%ld > %d)\n", + os_vm_page_size, OS_VM_DEFAULT_PAGESIZE); exit(1); - }else{ + } else { /* * we do this because there are apparently dependencies on * the pagesize being OS_VM_DEFAULT_PAGESIZE somewhere... @@ -105,101 +106,108 @@ os_init(void) * we have to grovel around a bit to enforce it, thus anything * that uses real_page_size_difference. */ - real_page_size_difference=OS_VM_DEFAULT_PAGESIZE-os_vm_page_size; - os_vm_page_size=OS_VM_DEFAULT_PAGESIZE; + real_page_size_difference = OS_VM_DEFAULT_PAGESIZE - os_vm_page_size; + os_vm_page_size = OS_VM_DEFAULT_PAGESIZE; } } /* ---------------------------------------------------------------- */ -os_vm_address_t -os_validate(os_vm_address_t addr, os_vm_size_t len) +os_vm_address_t os_validate(os_vm_address_t addr, os_vm_size_t len) { - int flags = MAP_PRIVATE|MAP_NORESERVE; + int flags = MAP_PRIVATE | MAP_NORESERVE; - if(addr) flags|=MAP_FIXED; + if (addr) + flags |= MAP_FIXED; - if((addr = (os_vm_address_t) mmap((void*)addr, len, OS_VM_PROT_ALL, flags, zero_fd, 0)) - == (os_vm_address_t) -1) - perror("mmap"); + if ( + (addr = + (os_vm_address_t) mmap((void *) addr, len, OS_VM_PROT_ALL, flags, + zero_fd, 0)) == (os_vm_address_t) - 1) + perror("mmap"); - return addr; + return addr; } void os_invalidate(os_vm_address_t addr, os_vm_size_t len) { - if(munmap((void*) addr, len) == -1) - perror("munmap"); + if (munmap((void *) addr, len) == -1) + perror("munmap"); } os_vm_address_t os_map(int fd, int offset, os_vm_address_t addr, os_vm_size_t len) { - if((addr = (os_vm_address_t) mmap((void*) addr, len, OS_VM_PROT_ALL, MAP_PRIVATE|MAP_FIXED, fd, - (off_t) offset)) == (os_vm_address_t) -1) - perror("mmap"); - - return addr; + if ( + (addr = + (os_vm_address_t) mmap((void *) addr, len, OS_VM_PROT_ALL, + MAP_PRIVATE | MAP_FIXED, fd, + (off_t) offset)) == (os_vm_address_t) - 1) + perror("mmap"); + + return addr; } void os_flush_icache(os_vm_address_t address, os_vm_size_t length) { - static int flushit = -1; - - /* - * On some systems, iflush needs to be emulated in the kernel - * On those systems, it isn't necessary - * Call getenv() only once. - */ - if (flushit == -1) - flushit = getenv("CMUCL_NO_SPARC_IFLUSH") == 0; - - if (flushit) { - static int traceit = -1; - if (traceit == -1) - traceit = getenv("CMUCL_TRACE_SPARC_IFLUSH") != 0; - - if (traceit) - fprintf(stderr,";;;iflush %p - %lx\n", (void*)address, length); - flush_icache((unsigned int*) address, length); - } + static int flushit = -1; + + /* + * On some systems, iflush needs to be emulated in the kernel + * On those systems, it isn't necessary + * Call getenv() only once. + */ + if (flushit == -1) + flushit = getenv("CMUCL_NO_SPARC_IFLUSH") == 0; + + if (flushit) { + static int traceit = -1; + + if (traceit == -1) + traceit = getenv("CMUCL_TRACE_SPARC_IFLUSH") != 0; + + if (traceit) + fprintf(stderr, ";;;iflush %p - %lx\n", (void *) address, length); + flush_icache((unsigned int *) address, length); + } } void os_protect(os_vm_address_t address, os_vm_size_t length, os_vm_prot_t prot) { - if(mprotect((void*)address, length, prot) == -1) - perror("mprotect"); + if (mprotect((void *) address, length, prot) == -1) + perror("mprotect"); } static boolean in_range_p(os_vm_address_t a, lispobj sbeg, size_t slen) { - char* beg = (char*) sbeg; - char* end = (char*) sbeg + slen; - char* adr = (char*) a; - return (adr >= beg && adr < end); + char *beg = (char *) sbeg; + char *end = (char *) sbeg + slen; + char *adr = (char *) a; + + return (adr >= beg && adr < end); } -boolean -valid_addr(os_vm_address_t addr) +boolean valid_addr(os_vm_address_t addr) { - /* Stolen from Linux-os.c */ - os_vm_address_t newaddr; - newaddr = os_trunc_to_page(addr); - - /* Just assume address is valid if it lies within one of the known - spaces. (Unlike sunos-os which keeps track of every valid page.) */ - 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_0_SPACE_START, dynamic_space_size ) + /* Stolen from Linux-os.c */ + os_vm_address_t newaddr; + + newaddr = os_trunc_to_page(addr); + + /* Just assume address is valid if it lies within one of the known + spaces. (Unlike sunos-os which keeps track of every valid page.) */ + 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_0_SPACE_START, dynamic_space_size) #ifndef GENCGC - || in_range_p(addr, DYNAMIC_1_SPACE_START, dynamic_space_size ) + || in_range_p(addr, DYNAMIC_1_SPACE_START, dynamic_space_size) #endif - || in_range_p(addr, CONTROL_STACK_START , CONTROL_STACK_SIZE ) - || in_range_p(addr, BINDING_STACK_START , BINDING_STACK_SIZE )); + || in_range_p(addr, CONTROL_STACK_START, CONTROL_STACK_SIZE) + || in_range_p(addr, BINDING_STACK_START, BINDING_STACK_SIZE)); } /* ---------------------------------------------------------------- */ @@ -209,108 +217,108 @@ valid_addr(os_vm_address_t addr) */ #if defined(GENCGC) -void segv_handle_now(HANDLER_ARGS) +void +segv_handle_now(HANDLER_ARGS) { - interrupt_handle_now(signal, code, context); + interrupt_handle_now(signal, code, context); } -void segv_handler(HANDLER_ARGS) +void +segv_handler(HANDLER_ARGS) { - caddr_t addr = code->si_addr; - int page_index; - - SAVE_CONTEXT(); + caddr_t addr = code->si_addr; + int page_index; - page_index = find_page_index((void *) addr); + SAVE_CONTEXT(); + + page_index = find_page_index((void *) addr); #ifdef RED_ZONE_HIT - if (os_control_stack_overflow (addr, context)) - return; + if (os_control_stack_overflow(addr, context)) + return; #endif - /* check if the fault is within the dynamic space. */ - if (page_index != -1) { - /* Un-protect the page */ + /* check if the fault is within the dynamic space. */ + if (page_index != -1) { + /* Un-protect the page */ - /* The page should have been marked write protected */ - if (!PAGE_WRITE_PROTECTED(page_index)) - fprintf(stderr, "*** Sigsegv in page not marked as write protected\n"); - os_protect((os_vm_address_t)page_address(page_index), PAGE_SIZE, OS_VM_PROT_ALL); - page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK; - page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK; + /* The page should have been marked write protected */ + if (!PAGE_WRITE_PROTECTED(page_index)) + fprintf(stderr, + "*** Sigsegv in page not marked as write protected\n"); + os_protect((os_vm_address_t) page_address(page_index), PAGE_SIZE, + OS_VM_PROT_ALL); + page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK; + page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK; - return; - } + return; + } - /* - * Could be a C stack overflow. Let's check - */ - - { - struct rlimit rlimit; - - if (getrlimit(RLIMIT_STACK, &rlimit) == 0) - { - /* The stack top here is based on the notes in sparc-validate.h */ - char* stack_top = (char*) 0xffbf0000; - char* stack_bottom; - - stack_bottom = stack_top - rlimit.rlim_cur; - - /* - * Add a fudge factor. Don't know why, but we get the signal - * sometime after the bottom of the stack, as computed above, - * has been reached. (It seems to be 8K, so we use something - * larger.) - */ - - stack_bottom -= 16384; - - if ((stack_bottom <= addr) && (addr <= stack_top)) - { - fprintf(stderr, "\nsegv_handler: C stack overflow. Try increasing stack limit (%ld).\n", - rlimit.rlim_cur); - - interrupt_handle_now(signal, code, context); - } - } - else - { - perror("getrlimit"); - } - } - - /* a *real* protection fault */ - fprintf(stderr, "segv_handler: Real protection violation: %p\n", - addr); - segv_handle_now(signal, code, context); + /* + * Could be a C stack overflow. Let's check + */ + + { + struct rlimit rlimit; + + if (getrlimit(RLIMIT_STACK, &rlimit) == 0) { + /* The stack top here is based on the notes in sparc-validate.h */ + char *stack_top = (char *) 0xffbf0000; + char *stack_bottom; + + stack_bottom = stack_top - rlimit.rlim_cur; + + /* + * Add a fudge factor. Don't know why, but we get the signal + * sometime after the bottom of the stack, as computed above, + * has been reached. (It seems to be 8K, so we use something + * larger.) + */ + + stack_bottom -= 16384; + + if ((stack_bottom <= addr) && (addr <= stack_top)) { + fprintf(stderr, + "\nsegv_handler: C stack overflow. Try increasing stack limit (%ld).\n", + rlimit.rlim_cur); + + interrupt_handle_now(signal, code, context); + } + } else { + perror("getrlimit"); + } + } + + /* a *real* protection fault */ + fprintf(stderr, "segv_handler: Real protection violation: %p\n", addr); + segv_handle_now(signal, code, context); } #else void segv_handler(HANDLER_ARGS) { - caddr_t addr = code->si_addr; + caddr_t addr = code->si_addr; - SAVE_CONTEXT(); + SAVE_CONTEXT(); #ifdef RED_ZONE_HIT - if (os_control_stack_overflow (addr, context)) - return; + if (os_control_stack_overflow(addr, context)) + return; #endif - if (!interrupt_maybe_gc(signal, code, context)) { - /* a *real* protection fault */ - fprintf(stderr, "segv_handler: Real protection violation: 0x%08x\n", - addr); - interrupt_handle_now(signal,code,context); - } + if (!interrupt_maybe_gc(signal, code, context)) { + /* a *real* protection fault */ + fprintf(stderr, "segv_handler: Real protection violation: 0x%08x\n", + addr); + interrupt_handle_now(signal, code, context); + } } #endif void os_install_interrupt_handlers() { - interrupt_install_low_level_handler(SIGSEGV,segv_handler); + interrupt_install_low_level_handler(SIGSEGV, segv_handler); } @@ -326,13 +334,15 @@ solaris_register_address(struct ucontext *context, int reg) return &zero; } else if (reg < 16) { - return &context->uc_mcontext.gregs[reg+3]; + return &context->uc_mcontext.gregs[reg + 3]; } else if (reg < 32) { - int *sp = (int*) context->uc_mcontext.gregs[REG_SP]; - return &sp[reg-16]; + int *sp = (int *) context->uc_mcontext.gregs[REG_SP]; + + return &sp[reg - 16]; } else return 0; } + /* function defintions for backward compatibilty and static linking */ /* For now we put in some porting functions */ @@ -359,24 +369,24 @@ getpagesize(void) #include <sys/procfs.h> /* Old rusage definition */ -struct rusage { - struct timeval ru_utime; /* user time used */ - struct timeval ru_stime; /* system time used */ - long ru_maxrss; +struct rusage { + struct timeval ru_utime; /* user time used */ + struct timeval ru_stime; /* system time used */ + long ru_maxrss; #define ru_first ru_ixrss - long ru_ixrss; /* XXX: 0 */ - long ru_idrss; /* XXX: sum of rm_asrss */ - long ru_isrss; /* XXX: 0 */ - long ru_minflt; /* any page faults not requiring I/O */ - long ru_majflt; /* any page faults requiring I/O */ - long ru_nswap; /* swaps */ - long ru_inblock; /* block input operations */ - long ru_oublock; /* block output operations */ - long ru_msgsnd; /* messages sent */ - long ru_msgrcv; /* messages received */ - long ru_nsignals; /* signals received */ - long ru_nvcsw; /* voluntary context switches */ - long ru_nivcsw; /* involuntary " */ + long ru_ixrss; /* XXX: 0 */ + long ru_idrss; /* XXX: sum of rm_asrss */ + long ru_isrss; /* XXX: 0 */ + long ru_minflt; /* any page faults not requiring I/O */ + long ru_majflt; /* any page faults requiring I/O */ + long ru_nswap; /* swaps */ + long ru_inblock; /* block input operations */ + long ru_oublock; /* block output operations */ + long ru_msgsnd; /* messages sent */ + long ru_msgrcv; /* messages received */ + long ru_nsignals; /* signals received */ + long ru_nvcsw; /* voluntary context switches */ + long ru_nivcsw; /* involuntary " */ #define ru_last ru_nivcsw }; @@ -385,13 +395,14 @@ int getrusage(int who, struct rusage *rp) { memset(rp, 0, sizeof(struct rusage)); + return 0; } int setreuid() { - fprintf(stderr,"setreuid unimplemented\n"); + fprintf(stderr, "setreuid unimplemented\n"); errno = ENOSYS; return -1; } @@ -399,7 +410,7 @@ setreuid() int setregid() { - fprintf(stderr,"setregid unimplemented\n"); + fprintf(stderr, "setregid unimplemented\n"); errno = ENOSYS; return -1; } @@ -407,7 +418,7 @@ setregid() int gethostid() { - fprintf(stderr,"gethostid unimplemented\n"); + fprintf(stderr, "gethostid unimplemented\n"); errno = ENOSYS; return -1; } @@ -442,6 +453,7 @@ wait3(int *status, int options, struct rusage *rp) { if (rp) memset(rp, 0, sizeof(struct rusage)); + return waitpid(-1, status, options); } #endif @@ -460,10 +472,9 @@ sigsetmask(int mask) } -os_vm_address_t -round_up_sparse_size(os_vm_address_t addr) +os_vm_address_t round_up_sparse_size(os_vm_address_t addr) { - return (addr + SPARSE_BLOCK_SIZE - 1) & ~SPARSE_SIZE_MASK; + return (addr + SPARSE_BLOCK_SIZE - 1) & ~SPARSE_SIZE_MASK; } /* @@ -471,10 +482,9 @@ round_up_sparse_size(os_vm_address_t addr) * after them. Must not include the dynamic spaces because the size * of the dynamic space can be controlled from the command line. */ -static os_vm_address_t spaces[] = -{ - READ_ONLY_SPACE_START, STATIC_SPACE_START, - BINDING_STACK_START, CONTROL_STACK_START +static os_vm_address_t spaces[] = { + READ_ONLY_SPACE_START, STATIC_SPACE_START, + BINDING_STACK_START, CONTROL_STACK_START }; /* @@ -484,10 +494,9 @@ static os_vm_address_t spaces[] = * SPARSE_BLOCK_SIZE boundaries. */ -static unsigned long space_size[] = -{ - READ_ONLY_SPACE_SIZE, STATIC_SPACE_SIZE, - BINDING_STACK_SIZE, CONTROL_STACK_SIZE +static unsigned long space_size[] = { + READ_ONLY_SPACE_SIZE, STATIC_SPACE_SIZE, + BINDING_STACK_SIZE, CONTROL_STACK_SIZE }; /* @@ -497,76 +506,71 @@ static unsigned long space_size[] = #define HOLE_SIZE 0x2000 -void make_holes(void) +void +make_holes(void) { - int k; - os_vm_address_t hole; - - /* Make holes of the appropriate size for desired spaces */ - - for (k = 0; k < sizeof(spaces)/sizeof(spaces[0]); ++k) - { + int k; + os_vm_address_t hole; + + /* Make holes of the appropriate size for desired spaces */ + + for (k = 0; k < sizeof(spaces) / sizeof(spaces[0]); ++k) { - hole = spaces[k] + space_size[k]; - - if (os_validate(hole, HOLE_SIZE) == NULL) { - fprintf(stderr, - "ensure_space: Failed to validate hole of %d bytes at 0x%08lX\n", - HOLE_SIZE, - (unsigned long)hole); - exit(1); - } - /* Make it inaccessible */ - os_protect(hole, HOLE_SIZE, 0); + hole = spaces[k] + space_size[k]; + + if (os_validate(hole, HOLE_SIZE) == NULL) { + fprintf(stderr, + "ensure_space: Failed to validate hole of %d bytes at 0x%08lX\n", + HOLE_SIZE, (unsigned long) hole); + exit(1); + } + /* Make it inaccessible */ + os_protect(hole, HOLE_SIZE, 0); } - /* Round up the dynamic_space_size to the nearest SPARSE_BLOCK_SIZE */ - dynamic_space_size = round_up_sparse_size(dynamic_space_size); - - /* Now make a hole for the dynamic spaces */ - hole = dynamic_space_size + (os_vm_address_t) dynamic_0_space; - - if (os_validate(hole, HOLE_SIZE) == NULL) - { - fprintf(stderr, - "ensure_space: Failed to validate hold of %d bytes at 0x%08lX\n", - HOLE_SIZE, - (unsigned long)hole); - exit(1); + /* Round up the dynamic_space_size to the nearest SPARSE_BLOCK_SIZE */ + dynamic_space_size = round_up_sparse_size(dynamic_space_size); + + /* Now make a hole for the dynamic spaces */ + hole = dynamic_space_size + (os_vm_address_t) dynamic_0_space; + + if (os_validate(hole, HOLE_SIZE) == NULL) { + fprintf(stderr, + "ensure_space: Failed to validate hold of %d bytes at 0x%08lX\n", + HOLE_SIZE, (unsigned long) hole); + exit(1); } - os_protect(hole, HOLE_SIZE, 0); + os_protect(hole, HOLE_SIZE, 0); #ifndef GENCGC - hole = dynamic_space_size + (os_vm_address_t) dynamic_1_space; - if (os_validate(hole, HOLE_SIZE) == NULL) - { - fprintf(stderr, - "ensure_space: Failed to validate hole of %ld bytes at 0x%08X\n", - HOLE_SIZE, - (unsigned long)hole); - exit(1); + hole = dynamic_space_size + (os_vm_address_t) dynamic_1_space; + if (os_validate(hole, HOLE_SIZE) == NULL) { + fprintf(stderr, + "ensure_space: Failed to validate hole of %ld bytes at 0x%08X\n", + HOLE_SIZE, (unsigned long) hole); + exit(1); } - os_protect(hole, HOLE_SIZE, 0); + os_protect(hole, HOLE_SIZE, 0); #endif } -void *os_dlsym(const char *sym_name, lispobj lib_list) +void * +os_dlsym(const char *sym_name, lispobj lib_list) { static void *program_handle; void *sym_addr = 0; if (!program_handle) - program_handle = dlopen((void *)0, RTLD_LAZY | RTLD_GLOBAL); + program_handle = dlopen((void *) 0, RTLD_LAZY | RTLD_GLOBAL); if (lib_list != NIL) { lispobj lib_list_head; for (lib_list_head = lib_list; - lib_list_head != NIL; - lib_list_head = (CONS(lib_list_head))->cdr) { + lib_list_head != NIL; lib_list_head = (CONS(lib_list_head))->cdr) { struct cons *lib_cons = CONS(CONS(lib_list_head)->car); - struct sap *dlhandle = (struct sap *)PTR(lib_cons->car); + struct sap *dlhandle = (struct sap *) PTR(lib_cons->car); - sym_addr = dlsym((void *)dlhandle->pointer, sym_name); + sym_addr = dlsym((void *) dlhandle->pointer, sym_name); if (sym_addr) return sym_addr; } diff --git a/lisp/sparc-arch.c b/lisp/sparc-arch.c index 858dcb7d8..af4c9bfdf 100644 --- a/lisp/sparc-arch.c +++ b/lisp/sparc-arch.c @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sparc-arch.c,v 1.26 2004/09/24 13:17:00 rtoy Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sparc-arch.c,v 1.27 2005/09/15 18:26:52 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -27,12 +27,14 @@ #include "breakpoint.h" #include "interr.h" -char *arch_init() +char * +arch_init() { return 0; } -os_vm_address_t arch_get_bad_addr(HANDLER_ARGS) +os_vm_address_t +arch_get_bad_addr(HANDLER_ARGS) { unsigned int badinst; int rs1; @@ -43,88 +45,95 @@ os_vm_address_t arch_get_bad_addr(HANDLER_ARGS) /* that caused the fault. */ if ((SC_PC(context) & 3) != 0 || ((SC_PC(context) < READ_ONLY_SPACE_START || - SC_PC(context) >= READ_ONLY_SPACE_START+READ_ONLY_SPACE_SIZE) && - ((lispobj *)SC_PC(context) < current_dynamic_space && - (lispobj *)SC_PC(context) >= - current_dynamic_space + dynamic_space_size))) - return 0; + SC_PC(context) >= READ_ONLY_SPACE_START + READ_ONLY_SPACE_SIZE) && + ((lispobj *) SC_PC(context) < current_dynamic_space && + (lispobj *) SC_PC(context) >= + current_dynamic_space + dynamic_space_size))) return 0; - badinst = *(unsigned int *)SC_PC(context); + badinst = *(unsigned int *) SC_PC(context); if ((badinst >> 30) != 3) /* All load/store instructions have op = 11 (binary) */ return 0; - rs1 = (badinst>>14)&0x1f; + rs1 = (badinst >> 14) & 0x1f; - if (badinst & (1<<13)) { + if (badinst & (1 << 13)) { /* r[rs1] + simm(13) */ int simm13 = badinst & 0x1fff; - if (simm13 & (1<<12)) - simm13 |= -1<<13; + if (simm13 & (1 << 12)) + simm13 |= -1 << 13; - return (os_vm_address_t)(SC_REG(context, rs1) + simm13); - } - else { + return (os_vm_address_t) (SC_REG(context, rs1) + simm13); + } else { /* r[rs1] + r[rs2] */ int rs2 = badinst & 0x1f; - return (os_vm_address_t)(SC_REG(context, rs1) + SC_REG(context, rs2)); + return (os_vm_address_t) (SC_REG(context, rs1) + SC_REG(context, rs2)); } } -void arch_skip_instruction(context) -struct sigcontext *context; +void +arch_skip_instruction(context) + struct sigcontext *context; { /* Skip the offending instruction */ SC_PC(context) = SC_NPC(context); SC_NPC(context) += 4; } -unsigned char *arch_internal_error_arguments(struct sigcontext *scp) +unsigned char * +arch_internal_error_arguments(struct sigcontext *scp) { - return (unsigned char *)(SC_PC(scp)+4); + return (unsigned char *) (SC_PC(scp) + 4); } -boolean arch_pseudo_atomic_atomic(struct sigcontext *scp) +boolean +arch_pseudo_atomic_atomic(struct sigcontext *scp) { return (SC_REG(scp, reg_ALLOC) & pseudo_atomic_Value); } -void arch_set_pseudo_atomic_interrupted(struct sigcontext *scp) +void +arch_set_pseudo_atomic_interrupted(struct sigcontext *scp) { SC_REG(scp, reg_ALLOC) |= pseudo_atomic_InterruptedValue; } -unsigned long arch_install_breakpoint(void *pc) +unsigned long +arch_install_breakpoint(void *pc) { - unsigned int *ptr = (unsigned int *)pc; + unsigned int *ptr = (unsigned int *) pc; unsigned int result = *ptr; + *ptr = trap_Breakpoint; os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int)); + return result; } -void arch_remove_breakpoint(void *pc, unsigned long orig_inst) +void +arch_remove_breakpoint(void *pc, unsigned long orig_inst) { - *(unsigned int *)pc = (unsigned int) orig_inst; - os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int)); + *(unsigned int *) pc = (unsigned int) orig_inst; + os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int)); } static unsigned int *skipped_break_addr, displaced_after_inst; + #ifdef POSIX_SIGS static sigset_t orig_sigmask; #else static int orig_sigmask; #endif -void arch_do_displaced_inst(struct sigcontext *scp, - unsigned long orig_inst) +void +arch_do_displaced_inst(struct sigcontext *scp, unsigned long orig_inst) { - unsigned int *pc = (unsigned int *)SC_PC(scp); - unsigned int *npc = (unsigned int *)SC_NPC(scp); + unsigned int *pc = (unsigned int *) SC_PC(scp); + unsigned int *npc = (unsigned int *) SC_NPC(scp); #ifdef POSIX_SIGS orig_sigmask = scp->uc_sigmask; @@ -137,6 +146,7 @@ void arch_do_displaced_inst(struct sigcontext *scp, *pc = orig_inst; os_flush_icache((os_vm_address_t) pc, sizeof(unsigned int)); + skipped_break_addr = pc; displaced_after_inst = *npc; *npc = trap_AfterBreakpoint; @@ -156,72 +166,69 @@ void arch_do_displaced_inst(struct sigcontext *scp, * number, and return non-zero. If it's not a trap instruction, * return 0. */ -boolean trap_inst_p(unsigned int* pc, int* trapno) +boolean +trap_inst_p(unsigned int *pc, int *trapno) { - unsigned int trap_inst; - - trap_inst = *pc; - - if (((trap_inst >> 30) == 2) - && (((trap_inst >> 19) & 0x3f) == 0x3a) - && (((trap_inst >> 14) & 0x1f) == reg_ZERO) - && (((trap_inst >> 13) & 1) == 1)) - { - /* - * Got a trap instruction with immediate trap value. - * Get the value and return. - */ - *trapno = (trap_inst & 0x3f); - - return 1; - } - else - { - *trapno = -1; - return 0; + unsigned int trap_inst; + + trap_inst = *pc; + + if (((trap_inst >> 30) == 2) + && (((trap_inst >> 19) & 0x3f) == 0x3a) + && (((trap_inst >> 14) & 0x1f) == reg_ZERO) + && (((trap_inst >> 13) & 1) == 1)) { + /* + * Got a trap instruction with immediate trap value. + * Get the value and return. + */ + *trapno = (trap_inst & 0x3f); + + return 1; + } else { + *trapno = -1; + return 0; } } -static int pseudo_atomic_trap_p(struct sigcontext *context) +static int +pseudo_atomic_trap_p(struct sigcontext *context) { - unsigned int* pc; - unsigned int badinst; - int trapno; - int result; - - - pc = (unsigned int*) SC_PC(context); - badinst = *pc; - result = 0; - - /* - * Check to see if the current instruction is a trap #16. We check - * to make sure this instruction was a trap instruction with rs1 = 0 - * and a software trap number (immediate value) of 16. - */ - if (trap_inst_p(pc, &trapno) && (trapno == trap_PseudoAtomic)) - { - unsigned int previnst; - previnst = pc[-1]; - /* - * Check to see if the previous instruction was an andcc alloc-tn, - * pseudo_atomic_InterruptedValue, zero-tn instruction. - */ - if (((previnst >> 30) == 2) && (((previnst >> 19) & 0x3f) == 0x11) - && (((previnst >> 14) & 0x1f) == reg_ALLOC) - && (((previnst >> 25) & 0x1f) == reg_ZERO) - && (((previnst >> 13) & 1) == 1) - && ((previnst & 0x1fff) == pseudo_atomic_InterruptedValue)) - { - result = 1; - } - else - { - fprintf(stderr, "Oops! Got a pseudo atomic trap without a preceeding andcc!\n"); - } + unsigned int *pc; + unsigned int badinst; + int trapno; + int result; + + + pc = (unsigned int *) SC_PC(context); + badinst = *pc; + result = 0; + + /* + * Check to see if the current instruction is a trap #16. We check + * to make sure this instruction was a trap instruction with rs1 = 0 + * and a software trap number (immediate value) of 16. + */ + if (trap_inst_p(pc, &trapno) && (trapno == trap_PseudoAtomic)) { + unsigned int previnst; + + previnst = pc[-1]; + /* + * Check to see if the previous instruction was an andcc alloc-tn, + * pseudo_atomic_InterruptedValue, zero-tn instruction. + */ + if (((previnst >> 30) == 2) && (((previnst >> 19) & 0x3f) == 0x11) + && (((previnst >> 14) & 0x1f) == reg_ALLOC) + && (((previnst >> 25) & 0x1f) == reg_ZERO) + && (((previnst >> 13) & 1) == 1) + && ((previnst & 0x1fff) == pseudo_atomic_InterruptedValue)) { + result = 1; + } else { + fprintf(stderr, + "Oops! Got a pseudo atomic trap without a preceeding andcc!\n"); + } } - return result; + return result; } #ifdef GENCGC @@ -229,52 +236,51 @@ static int pseudo_atomic_trap_p(struct sigcontext *context) * Return non-zero if the instruction is a trap 31 instruction */ -boolean allocation_trap_p(struct sigcontext *context) +boolean +allocation_trap_p(struct sigcontext * context) { - int result; - unsigned int* pc; - unsigned int or_inst; - int trapno; - - result = 0; - - /* - * Make sure this is a trap 31 instruction preceeded by an OR - * instruction. - */ - - pc = (unsigned int*) SC_PC(context); - - if (trap_inst_p(pc, &trapno) && (trapno == trap_Allocation)) - { - /* Got the trap. Is it preceeded by an OR instruction or SUB - instruction? */ - or_inst = pc[-1]; - if ((((or_inst >> 30) == 2) && (((or_inst >> 19) & 0x1f) == 2)) || - (((or_inst >> 30) == 2) && (((or_inst >> 19) & 0x1f) == 4))) - { - result = 1; - } - else - { - fprintf(stderr, "Whoa!!! Got an allocation trap not preceeded by an OR inst: 0x%08x!\n", - or_inst); - } + int result; + unsigned int *pc; + unsigned int or_inst; + int trapno; + + result = 0; + + /* + * Make sure this is a trap 31 instruction preceeded by an OR + * instruction. + */ + + pc = (unsigned int *) SC_PC(context); + + if (trap_inst_p(pc, &trapno) && (trapno == trap_Allocation)) { + /* Got the trap. Is it preceeded by an OR instruction or SUB + instruction? */ + or_inst = pc[-1]; + if ((((or_inst >> 30) == 2) && (((or_inst >> 19) & 0x1f) == 2)) || + (((or_inst >> 30) == 2) && (((or_inst >> 19) & 0x1f) == 4))) { + result = 1; + } else { + fprintf(stderr, + "Whoa!!! Got an allocation trap not preceeded by an OR inst: 0x%08x!\n", + or_inst); + } } - return result; + return result; } #endif #if 0 /* Pop the stack frame that build_fake_control_stack_frame makes */ -static void pop_fake_control_stack_frame(struct sigcontext *context) +static void +pop_fake_control_stack_frame(struct sigcontext *context) { - current_control_frame_pointer = (lispobj*) SC_REG(context, reg_CFP); - SC_REG(context, reg_OCFP) = current_control_frame_pointer[0]; - SC_REG(context, reg_CODE) = current_control_frame_pointer[1]; - SC_REG(context, reg_CSP) = SC_REG(context, reg_CFP); - SC_REG(context, reg_CFP) = SC_REG(context, reg_OCFP); + current_control_frame_pointer = (lispobj *) SC_REG(context, reg_CFP); + SC_REG(context, reg_OCFP) = current_control_frame_pointer[0]; + SC_REG(context, reg_CODE) = current_control_frame_pointer[1]; + SC_REG(context, reg_CSP) = SC_REG(context, reg_CFP); + SC_REG(context, reg_CFP) = SC_REG(context, reg_OCFP); } #endif @@ -284,141 +290,132 @@ static void pop_fake_control_stack_frame(struct sigcontext *context) * consing to work with gencgc, we need to be able to trap the SIGILL * signal to perform allocation. */ -void enable_some_signals() +void +enable_some_signals() { #ifdef GENCGC - sigset_t sigs; - - sigemptyset(&sigs); - sigaddset(&sigs, SIGILL); - sigprocmask(SIG_UNBLOCK, &sigs, NULL); + sigset_t sigs; + + sigemptyset(&sigs); + sigaddset(&sigs, SIGILL); + sigprocmask(SIG_UNBLOCK, &sigs, NULL); #endif } #ifdef GENCGC -void handle_allocation_trap(struct sigcontext *context) +void +handle_allocation_trap(struct sigcontext *context) { - unsigned int* pc; - unsigned int or_inst; - int target; - int size; - int immed; - boolean were_in_lisp; - char* memory; - sigset_t block; - - target = 0; - size = 0; - + unsigned int *pc; + unsigned int or_inst; + int target; + int size; + int immed; + boolean were_in_lisp; + char *memory; + sigset_t block; + + target = 0; + size = 0; + #if 0 - /* - * Block all blockable signals. Need to do this because - * sigill_handler enables the signals. When the handler returns, - * signals should be enabled again, automatically. - */ - - sigemptyset(&block); - FILLBLOCKSET(&block); - sigprocmask(SIG_BLOCK, &block, 0); + /* + * Block all blockable signals. Need to do this because + * sigill_handler enables the signals. When the handler returns, + * signals should be enabled again, automatically. + */ + + sigemptyset(&block); + FILLBLOCKSET(&block); + sigprocmask(SIG_BLOCK, &block, 0); #else - /* - * Well, maybe not. sigill_handler probably shouldn't be unblocking - * all signals. So, let's enable just the signals we need. Since - * alloc might call GC, we need to have SIGILL enabled so we can do - * allocation. Do we need more? - */ - enable_some_signals(); + /* + * Well, maybe not. sigill_handler probably shouldn't be unblocking + * all signals. So, let's enable just the signals we need. Since + * alloc might call GC, we need to have SIGILL enabled so we can do + * allocation. Do we need more? + */ + enable_some_signals(); #endif - - pc = (unsigned int*) SC_PC(context); - or_inst = pc[-1]; - - /* - * The instruction before this trap instruction had better be an OR - * instruction or SUB instruction! - */ - - if (((or_inst >> 30) == 2) && (((or_inst >> 19) & 0x1f) == 2)) - { - /* - * An OR instruction. RS1 is the register we want to allocate - * to. RS2 (or an immediate) is the size. - */ - - target = (or_inst >> 14) & 0x1f; - - immed = (or_inst >> 13) & 1; - - if (immed == 1) - { - size = or_inst & 0x1fff; - } - else - { - size = or_inst & 0x1f; - size = SC_REG(context, size); - } - } - else if (((or_inst >> 30) == 2) && (((or_inst >> 19) & 0x1f) == 4)) - { - /* - * A SUB instruction. RD is the register to allocate to, RS2 - * (or an immediate) is the size. - */ - - target = (or_inst >> 25) & 0x1f; - immed = (or_inst >> 13) & 1; - if (immed == 1) - { - size = or_inst & 0x1fff; - } - else - { - size = or_inst & 0x1f; - size = SC_REG(context, size); - } - } - - - /* - * I don't think it's possible for us NOT to be in lisp when we get - * here. Remove this later? - */ - were_in_lisp = !foreign_function_call_active; - - if (were_in_lisp) - { - fake_foreign_function_call(context); + + pc = (unsigned int *) SC_PC(context); + or_inst = pc[-1]; + + /* + * The instruction before this trap instruction had better be an OR + * instruction or SUB instruction! + */ + + if (((or_inst >> 30) == 2) && (((or_inst >> 19) & 0x1f) == 2)) { + /* + * An OR instruction. RS1 is the register we want to allocate + * to. RS2 (or an immediate) is the size. + */ + + target = (or_inst >> 14) & 0x1f; + + immed = (or_inst >> 13) & 1; + + if (immed == 1) { + size = or_inst & 0x1fff; + } else { + size = or_inst & 0x1f; + size = SC_REG(context, size); + } + } else if (((or_inst >> 30) == 2) && (((or_inst >> 19) & 0x1f) == 4)) { + /* + * A SUB instruction. RD is the register to allocate to, RS2 + * (or an immediate) is the size. + */ + + target = (or_inst >> 25) & 0x1f; + immed = (or_inst >> 13) & 1; + if (immed == 1) { + size = or_inst & 0x1fff; + } else { + size = or_inst & 0x1f; + size = SC_REG(context, size); + } } - else - { - fprintf(stderr, "**** Whoa! allocation trap and we weren't in lisp!\n"); + + + /* + * I don't think it's possible for us NOT to be in lisp when we get + * here. Remove this later? + */ + were_in_lisp = !foreign_function_call_active; + + if (were_in_lisp) { + fake_foreign_function_call(context); + } else { + fprintf(stderr, "**** Whoa! allocation trap and we weren't in lisp!\n"); } - /* - * alloc-tn was incremented by size. If we get here, we need to - * decrement it by size to restore it's original value. - */ - /* current_dynamic_space_free_pointer = (lispobj *) SC_REG(context, reg_ALLOC);*/ - current_dynamic_space_free_pointer = (lispobj*) ((long)current_dynamic_space_free_pointer - size); - - /* - * Allocate some memory, store the memory address in target. - */ + /* + * alloc-tn was incremented by size. If we get here, we need to + * decrement it by size to restore it's original value. + */ + /* current_dynamic_space_free_pointer = (lispobj *) SC_REG(context, reg_ALLOC); */ + current_dynamic_space_free_pointer = + (lispobj *) ((long) current_dynamic_space_free_pointer - size); + + /* + * Allocate some memory, store the memory address in target. + */ #if 0 - fprintf(stderr, "Alloc %d to %s\n", size, lisp_register_names[target]); + fprintf(stderr, "Alloc %d to %s\n", size, lisp_register_names[target]); #endif - memory = (char *) alloc(size); - SC_REG(context, target) = (unsigned long) memory; - SC_REG(context, reg_ALLOC) = (unsigned long) current_dynamic_space_free_pointer; + memory = (char *) alloc(size); + SC_REG(context, target) = (unsigned long) memory; + SC_REG(context, reg_ALLOC) = + (unsigned long) current_dynamic_space_free_pointer; - if (were_in_lisp) - { - undo_fake_foreign_function_call(context); + if (were_in_lisp) { + undo_fake_foreign_function_call(context); } - + } #endif @@ -434,7 +431,8 @@ void handle_allocation_trap(struct sigcontext *context) #define TRAP_INST(code) ((CODE(code) >= T_SOFTWARE_TRAP + 16) && (CODE(code) < T_SOFTWARE_TRAP + 32)) #endif -static void sigill_handler(HANDLER_ARGS) +static void +sigill_handler(HANDLER_ARGS) { SAVE_CONTEXT(); @@ -459,11 +457,10 @@ static void sigill_handler(HANDLER_ARGS) sigsetmask(context->sc_mask); #endif - if (CODE(code) == ILLTRAP_INST) - { + if (CODE(code) == ILLTRAP_INST) { int illtrap_code; unsigned int inst; - unsigned int* pc = (unsigned int *)(SC_PC(context)); + unsigned int *pc = (unsigned int *) (SC_PC(context)); inst = *pc; @@ -471,112 +468,114 @@ static void sigill_handler(HANDLER_ARGS) switch (illtrap_code) { case trap_PendingInterrupt: - arch_skip_instruction(context); - interrupt_handle_pending(context); - break; + arch_skip_instruction(context); + interrupt_handle_pending(context); + break; case trap_Halt: - fake_foreign_function_call(context); - lose("%%primitive halt called; the party is over.\n"); + fake_foreign_function_call(context); + lose("%%primitive halt called; the party is over.\n"); case trap_Error: case trap_Cerror: - interrupt_internal_error(signal, code, context, illtrap_code == trap_Cerror); - break; + interrupt_internal_error(signal, code, context, + illtrap_code == trap_Cerror); + break; case trap_Breakpoint: - enable_some_signals(); - handle_breakpoint(signal, CODE(code), context); - break; + enable_some_signals(); + handle_breakpoint(signal, CODE(code), context); + break; case trap_FunctionEndBreakpoint: - enable_some_signals(); - SC_PC(context)=(long)handle_function_end_breakpoint(signal, CODE(code), context); - SC_NPC(context)=SC_PC(context) + 4; - break; + enable_some_signals(); + SC_PC(context) = + (long) handle_function_end_breakpoint(signal, CODE(code), + context); + SC_NPC(context) = SC_PC(context) + 4; + break; case trap_AfterBreakpoint: - *skipped_break_addr = trap_Breakpoint; - skipped_break_addr = NULL; - *(unsigned long *)SC_PC(context) = displaced_after_inst; + *skipped_break_addr = trap_Breakpoint; + skipped_break_addr = NULL; + *(unsigned long *) SC_PC(context) = displaced_after_inst; #ifdef POSIX_SIGS - context->uc_sigmask = orig_sigmask; + context->uc_sigmask = orig_sigmask; #else - context->sc_mask = orig_sigmask; + context->sc_mask = orig_sigmask; #endif - os_flush_icache((os_vm_address_t) SC_PC(context), - sizeof(unsigned long)); - break; + os_flush_icache((os_vm_address_t) SC_PC(context), + + sizeof(unsigned long)); + break; #ifdef trap_DynamicSpaceOverflowWarning - case trap_DynamicSpaceOverflowWarning: - arch_skip_instruction(context); - enable_some_signals(); - interrupt_handle_space_overflow(SymbolFunction(DYNAMIC_SPACE_OVERFLOW_WARNING_HIT), - context); - break; + case trap_DynamicSpaceOverflowWarning: + arch_skip_instruction(context); + enable_some_signals(); + interrupt_handle_space_overflow(SymbolFunction + (DYNAMIC_SPACE_OVERFLOW_WARNING_HIT), + context); + break; #endif #ifdef trap_DynamicSpaceOverflowError - case trap_DynamicSpaceOverflowError: - arch_skip_instruction(context); - enable_some_signals(); - interrupt_handle_space_overflow(SymbolFunction(DYNAMIC_SPACE_OVERFLOW_ERROR_HIT), - context); - break; + case trap_DynamicSpaceOverflowError: + arch_skip_instruction(context); + enable_some_signals(); + interrupt_handle_space_overflow(SymbolFunction + (DYNAMIC_SPACE_OVERFLOW_ERROR_HIT), + context); + break; #endif default: - interrupt_handle_now(signal, code, context); - break; + interrupt_handle_now(signal, code, context); + break; + } + } else if (TRAP_INST(code)) { + if (pseudo_atomic_trap_p(context)) { + /* A trap instruction from a pseudo-atomic. We just need + to fixup up alloc-tn to remove the interrupted flag, + skip over the trap instruction, and then handle the + pending interrupt(s). */ + SC_REG(context, reg_ALLOC) &= ~lowtag_Mask; + arch_skip_instruction(context); + interrupt_handle_pending(context); } - } - else if (TRAP_INST(code)) - { - if (pseudo_atomic_trap_p(context)) - { - /* A trap instruction from a pseudo-atomic. We just need - to fixup up alloc-tn to remove the interrupted flag, - skip over the trap instruction, and then handle the - pending interrupt(s). */ - SC_REG(context, reg_ALLOC) &= ~lowtag_Mask; - arch_skip_instruction(context); - interrupt_handle_pending(context); - } #ifdef GENCGC - else if (allocation_trap_p(context)) - { - /* An allocation trap. Call the trap handler and then skip - this instruction */ - handle_allocation_trap(context); - arch_skip_instruction(context); - } + else if (allocation_trap_p(context)) { + /* An allocation trap. Call the trap handler and then skip + this instruction */ + handle_allocation_trap(context); + arch_skip_instruction(context); + } #endif - else - { - interrupt_internal_error(signal, code, context, FALSE); - } - } - else - { + else { + interrupt_internal_error(signal, code, context, FALSE); + } + } else { interrupt_handle_now(signal, code, context); - } + } } -void arch_install_interrupt_handlers() +void +arch_install_interrupt_handlers() { - interrupt_install_low_level_handler(SIGILL,sigill_handler); + interrupt_install_low_level_handler(SIGILL, sigill_handler); } -extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs); +extern lispobj call_into_lisp(lispobj fun, lispobj * args, int nargs); -lispobj funcall0(lispobj function) +lispobj +funcall0(lispobj function) { lispobj *args = current_control_stack_pointer; return call_into_lisp(function, args, 0); } -lispobj funcall1(lispobj function, lispobj arg0) +lispobj +funcall1(lispobj function, lispobj arg0) { lispobj *args = current_control_stack_pointer; @@ -586,7 +585,8 @@ lispobj funcall1(lispobj function, lispobj arg0) return call_into_lisp(function, args, 1); } -lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1) +lispobj +funcall2(lispobj function, lispobj arg0, lispobj arg1) { lispobj *args = current_control_stack_pointer; @@ -597,7 +597,8 @@ lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1) return call_into_lisp(function, args, 2); } -lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) +lispobj +funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) { lispobj *args = current_control_stack_pointer; @@ -659,73 +660,74 @@ lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) * Insert the necessary jump instructions at the given address. * Return the address of the next word */ -void* arch_make_jump_entry(void* reloc_addr, void *target_addr) +void * +arch_make_jump_entry(void *reloc_addr, void *target_addr) { - - /* - * Make JMP to function entry. - * - * The instruction sequence is: - * - * sethi %hi(addr), temp_reg - * jmpl %temp_reg + %lo(addr), %addr_reg - * nop - * nop - * - */ - int* inst_ptr; - unsigned long hi; /* Top 22 bits of address */ - unsigned long lo; /* Low 10 bits of address */ - unsigned int inst; - - inst_ptr = (int*) reloc_addr; - - /* - * Split the target address into hi and lo parts for the sethi - * instruction. hi is the top 22 bits. lo is the low 10 bits. - */ - hi = (unsigned long) target_addr; - lo = hi & 0x3ff; - hi >>= 10; - - /* - * sethi %hi(addr), temp_reg - */ - - inst = (0 << 30) | (LINKAGE_TEMP_REG << 25) | (4 << 22) | hi; - *inst_ptr++ = inst; - - /* - * jmpl [temp_reg + %lo(addr)], addr_reg - */ - - inst = (2U << 30) | (LINKAGE_ADDR_REG << 25) | (0x38 << 19) - | (LINKAGE_TEMP_REG << 14) | (1 << 13) | lo; - *inst_ptr++ = inst; - - /* nop (really sethi 0, %g0) */ - - inst = (0 << 30) | (0 << 25) | (4 << 22) | 0; - - *inst_ptr++ = inst; - *inst_ptr++ = inst; - - os_flush_icache((os_vm_address_t) reloc_addr, (char*) inst_ptr - (char*) reloc_addr); - return reloc_addr; + + /* + * Make JMP to function entry. + * + * The instruction sequence is: + * + * sethi %hi(addr), temp_reg + * jmpl %temp_reg + %lo(addr), %addr_reg + * nop + * nop + * + */ + int *inst_ptr; + unsigned long hi; /* Top 22 bits of address */ + unsigned long lo; /* Low 10 bits of address */ + unsigned int inst; + + inst_ptr = (int *) reloc_addr; + + /* + * Split the target address into hi and lo parts for the sethi + * instruction. hi is the top 22 bits. lo is the low 10 bits. + */ + hi = (unsigned long) target_addr; + lo = hi & 0x3ff; + hi >>= 10; + + /* + * sethi %hi(addr), temp_reg + */ + + inst = (0 << 30) | (LINKAGE_TEMP_REG << 25) | (4 << 22) | hi; + *inst_ptr++ = inst; + + /* + * jmpl [temp_reg + %lo(addr)], addr_reg + */ + + inst = (2U << 30) | (LINKAGE_ADDR_REG << 25) | (0x38 << 19) + | (LINKAGE_TEMP_REG << 14) | (1 << 13) | lo; + *inst_ptr++ = inst; + + /* nop (really sethi 0, %g0) */ + + inst = (0 << 30) | (0 << 25) | (4 << 22) | 0; + + *inst_ptr++ = inst; + *inst_ptr++ = inst; + + os_flush_icache((os_vm_address_t) reloc_addr, + (char *) inst_ptr - (char *) reloc_addr); + return reloc_addr; } -void arch_make_linkage_entry(long linkage_entry, void *target_addr, long type) +void +arch_make_linkage_entry(long linkage_entry, void *target_addr, long type) { - int *reloc_addr = (int *)(FOREIGN_LINKAGE_SPACE_START - + linkage_entry * LinkageEntrySize); + int *reloc_addr = (int *) (FOREIGN_LINKAGE_SPACE_START - if (type == 1) - { /* code reference */ - arch_make_jump_entry(reloc_addr, target_addr); - } - else if (type == 2) - { - *(unsigned long *)reloc_addr = (unsigned long)target_addr; + + linkage_entry * LinkageEntrySize); + + if (type == 1) { /* code reference */ + arch_make_jump_entry(reloc_addr, target_addr); + } else if (type == 2) { + *(unsigned long *) reloc_addr = (unsigned long) target_addr; } } @@ -733,18 +735,20 @@ void arch_make_linkage_entry(long linkage_entry, void *target_addr, long type) extern void resolve_linkage_tramp(void); -void arch_make_lazy_linkage(long linkage_entry) +void +arch_make_lazy_linkage(long linkage_entry) { - arch_make_linkage_entry(linkage_entry, (void*) resolve_linkage_tramp, 1); + arch_make_linkage_entry(linkage_entry, (void *) resolve_linkage_tramp, 1); } /* Get linkage entry. We're given the return address which should be the address of the jmpl instruction (2nd word) of the linkage entry. Figure out which entry this address belong to. */ -long arch_linkage_entry(unsigned long retaddr) +long +arch_linkage_entry(unsigned long retaddr) { - return (retaddr - (FOREIGN_LINKAGE_SPACE_START)) - / LinkageEntrySize; + return (retaddr - (FOREIGN_LINKAGE_SPACE_START)) + / LinkageEntrySize; } #endif /* LINKAGE_TABLE */ diff --git a/lisp/sparc-lispregs.h b/lisp/sparc-lispregs.h index 752255720..e74547acc 100644 --- a/lisp/sparc-lispregs.h +++ b/lisp/sparc-lispregs.h @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sparc-lispregs.h,v 1.9 2005/02/18 15:42:20 rtoy Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sparc-lispregs.h,v 1.10 2005/09/15 18:26:52 rtoy Rel $ */ #ifndef _SPARC_LISPREGS_H_ #define _SPARC_LISPREGS_H_ @@ -129,7 +129,7 @@ #include <ucontext.h> -extern int * solaris_register_address(struct ucontext *, int); +extern int *solaris_register_address(struct ucontext *, int); #define SC_REG(sc, reg) (*solaris_register_address(sc,reg)) diff --git a/lisp/sparc-validate.h b/lisp/sparc-validate.h index 293fb8364..a326c2296 100644 --- a/lisp/sparc-validate.h +++ b/lisp/sparc-validate.h @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sparc-validate.h,v 1.20 2005/02/03 15:08:41 rtoy Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sparc-validate.h,v 1.21 2005/09/15 18:26:52 rtoy Rel $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -87,21 +87,21 @@ * long). Hope that's enough! Make sure this doesn't overlap the * READ_ONLY_SPACE_START! */ -#define FOREIGN_LINKAGE_SPACE_SIZE (0x00800000 - SPARSE_BLOCK_SIZE) /* 8 MB - 32 KB */ +#define FOREIGN_LINKAGE_SPACE_SIZE (0x00800000 - SPARSE_BLOCK_SIZE) /* 8 MB - 32 KB */ #endif #define READ_ONLY_SPACE_START (SpaceStart_TargetReadOnly) -#define READ_ONLY_SPACE_SIZE ((2*MB_128) - SPARSE_BLOCK_SIZE) /* 256 MB - 32 KB, 256 MB max */ - +#define READ_ONLY_SPACE_SIZE ((2*MB_128) - SPARSE_BLOCK_SIZE) /* 256 MB - 32 KB, 256 MB max */ + #define BINDING_STACK_START (0x20000000) -#define BINDING_STACK_SIZE (MB_128 - SPARSE_BLOCK_SIZE) /* 128 MB - 32 KB, 128 MB max */ +#define BINDING_STACK_SIZE (MB_128 - SPARSE_BLOCK_SIZE) /* 128 MB - 32 KB, 128 MB max */ #define STATIC_SPACE_START (SpaceStart_TargetStatic) -#define STATIC_SPACE_SIZE ((2*MB_128) - SPARSE_BLOCK_SIZE) /* 256 MB - 32 KB, 256 MB max */ +#define STATIC_SPACE_SIZE ((2*MB_128) - SPARSE_BLOCK_SIZE) /* 256 MB - 32 KB, 256 MB max */ #define CONTROL_STACK_START (0x38000000) -#define CONTROL_STACK_SIZE (MB_128 - SPARSE_BLOCK_SIZE) /* 128 MB - 32 KB, 128 MB max */ +#define CONTROL_STACK_SIZE (MB_128 - SPARSE_BLOCK_SIZE) /* 128 MB - 32 KB, 128 MB max */ #define CONTROL_STACK_END (CONTROL_STACK_START + CONTROL_STACK_SIZE) #define DYNAMIC_0_SPACE_START (SpaceStart_TargetDynamic) @@ -117,9 +117,9 @@ * how that can be, but we lets not subtract it off. */ #if 0 -#define DEFAULT_DYNAMIC_SPACE_SIZE (0x10000000 - SPARSE_BLOCK_SIZE) /* 256 MB - 32 KB */ +#define DEFAULT_DYNAMIC_SPACE_SIZE (0x10000000 - SPARSE_BLOCK_SIZE) /* 256 MB - 32 KB */ #else -#define DEFAULT_DYNAMIC_SPACE_SIZE (0x10000000) /* 256 MB */ +#define DEFAULT_DYNAMIC_SPACE_SIZE (0x10000000) /* 256 MB */ #endif /* The maximum dynamic space that we can allocate */ @@ -128,9 +128,9 @@ * For GENCGC, we can use both dynamic spaces, so we get at least * double the heap size. */ -#define DYNAMIC_SPACE_SIZE (0xB0000000 - SPARSE_BLOCK_SIZE) /* 2816 MB - 32 KB max */ +#define DYNAMIC_SPACE_SIZE (0xB0000000 - SPARSE_BLOCK_SIZE) /* 2816 MB - 32 KB max */ #else -#define DYNAMIC_SPACE_SIZE (0x40000000 - SPARSE_BLOCK_SIZE) /* 1GB - 32 KB max */ +#define DYNAMIC_SPACE_SIZE (0x40000000 - SPARSE_BLOCK_SIZE) /* 1GB - 32 KB max */ #endif #endif /* _SPARC_VALIDATE_H_ */ diff --git a/lisp/sunos-os.c b/lisp/sunos-os.c index 00f212919..e7aaa2f03 100644 --- a/lisp/sunos-os.c +++ b/lisp/sunos-os.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sunos-os.c,v 1.6 2000/10/27 19:33:05 dtc Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sunos-os.c,v 1.7 2005/09/15 18:26:52 rtoy Exp $ * * OS-dependent routines. This file (along with os.h) exports an * OS-independent interface to the operating system VM facilities. @@ -61,47 +61,50 @@ extern char *getenv(); #define ADJ_OFFSET(off,adj) (((off)==OFFSET_NONE) ? OFFSET_NONE : ((off)+(adj))) -long os_vm_page_size=(-1); -static long os_real_page_size=(-1); +long os_vm_page_size = (-1); +static long os_real_page_size = (-1); static struct segment { os_vm_address_t start; /* note: start & length are expected to be on page */ - os_vm_size_t length; /* boundaries */ + os_vm_size_t length; /* boundaries */ long file_offset; short mapped_fd; short protection; } *segments; -static int n_segments=0, max_segments=0; +static int n_segments = 0, max_segments = 0; -static int zero_fd=(-1), empty_fd=(-1); +static int zero_fd = (-1), empty_fd = (-1); -static os_vm_address_t last_fault=0; -static os_vm_size_t real_page_size_difference=0; +static os_vm_address_t last_fault = 0; +static os_vm_size_t real_page_size_difference = 0; -static void os_init_bailout(arg) -char *arg; +static void +os_init_bailout(arg) + char *arg; { char buf[500]; - sprintf(buf,"os_init: %s",arg); + + sprintf(buf, "os_init: %s", arg); perror(buf); exit(1); } -void os_init() +void +os_init() { - char *empty_file=getenv("CMUCL_EMPTYFILE"); + char *empty_file = getenv("CMUCL_EMPTYFILE"); - if(empty_file==NULL) - empty_file=EMPTYFILE; + if (empty_file == NULL) + empty_file = EMPTYFILE; - empty_fd=open(empty_file,O_RDONLY|O_CREAT); - if(empty_fd<0) + empty_fd = open(empty_file, O_RDONLY | O_CREAT); + if (empty_fd < 0) os_init_bailout(empty_file); unlink(empty_file); - zero_fd=open(ZEROFILE,O_RDONLY); - if(zero_fd<0) + zero_fd = open(ZEROFILE, O_RDONLY); + if (zero_fd < 0) os_init_bailout(ZEROFILE); @@ -111,19 +114,20 @@ void os_init() os_vm_page_size = os_real_page_size = getpagesize(); #endif - max_segments=INITIAL_MAX_SEGS; - segments=(struct segment *)malloc(sizeof(struct segment)*max_segments); - if(segments==NULL){ - fprintf(stderr,"os_init: Couldn't allocate %d segment descriptors\n", + max_segments = INITIAL_MAX_SEGS; + segments = (struct segment *) malloc(sizeof(struct segment) * max_segments); + + if (segments == NULL) { + fprintf(stderr, "os_init: Couldn't allocate %d segment descriptors\n", max_segments); exit(1); } - if(os_vm_page_size>OS_VM_DEFAULT_PAGESIZE){ - fprintf(stderr,"os_init: Pagesize too large (%d > %d)\n", - os_vm_page_size,OS_VM_DEFAULT_PAGESIZE); + if (os_vm_page_size > OS_VM_DEFAULT_PAGESIZE) { + fprintf(stderr, "os_init: Pagesize too large (%d > %d)\n", + os_vm_page_size, OS_VM_DEFAULT_PAGESIZE); exit(1); - }else{ + } else { /* * we do this because there are apparently dependencies on * the pagesize being OS_VM_DEFAULT_PAGESIZE somewhere... @@ -131,67 +135,70 @@ void os_init() * we have to grovel around a bit to enforce it, thus anything * that uses real_page_size_difference. */ - real_page_size_difference=OS_VM_DEFAULT_PAGESIZE-os_vm_page_size; - os_vm_page_size=OS_VM_DEFAULT_PAGESIZE; + real_page_size_difference = OS_VM_DEFAULT_PAGESIZE - os_vm_page_size; + os_vm_page_size = OS_VM_DEFAULT_PAGESIZE; } } /* ---------------------------------------------------------------- */ -void seg_force_resident(struct segment *seg, - os_vm_address_t addr, - os_vm_size_t len) +void +seg_force_resident(struct segment *seg, os_vm_address_t addr, os_vm_size_t len) { - int prot=seg->protection; - - if(prot!=0){ - os_vm_address_t end=addr+len, touch=addr; - - while(touch<end){ - int contents=(*(char *)touch); - if(prot&OS_VM_PROT_WRITE) - (*(char *)touch)=contents; - touch=(os_vm_address_t)(((long)touch+SPARSE_BLOCK_SIZE)&~SPARSE_SIZE_MASK); + int prot = seg->protection; + + if (prot != 0) { + os_vm_address_t end = addr + len, touch = addr; + + while (touch < end) { + int contents = (*(char *) touch); + + if (prot & OS_VM_PROT_WRITE) + (*(char *) touch) = contents; + touch = + (os_vm_address_t) (((long) touch + SPARSE_BLOCK_SIZE) & + ~SPARSE_SIZE_MASK); } } } -static struct segment *seg_create_nomerge(addr,len,protection,mapped_fd,file_offset) -os_vm_address_t addr; -os_vm_size_t len; -int protection; -int mapped_fd; +static struct segment * +seg_create_nomerge(addr, len, protection, mapped_fd, file_offset) + os_vm_address_t addr; + os_vm_size_t len; + int protection; + int mapped_fd; { int n; struct segment *seg; - if(len==0) + if (len == 0) return NULL; - if(n_segments==max_segments){ + if (n_segments == max_segments) { struct segment *new_segs; - max_segments+=GROW_MAX_SEGS; + max_segments += GROW_MAX_SEGS; - new_segs=(struct segment *) - realloc(segments,max_segments*sizeof(struct segment)); + new_segs = (struct segment *) + realloc(segments, max_segments * sizeof(struct segment)); - if(new_segs==NULL){ + if (new_segs == NULL) { fprintf(stderr, "seg_create_nomerge: Couldn't grow segment descriptor table to %s segments\n", max_segments); - max_segments-=GROW_MAX_SEGS; + max_segments -= GROW_MAX_SEGS; return NULL; } - - segments=new_segs; + + segments = new_segs; } - for(n=n_segments, seg=segments; n>0; n--, seg++) - if(addr<seg->start){ - seg=(&segments[n_segments]); - while(n-->0){ - seg[0]=seg[-1]; + for (n = n_segments, seg = segments; n > 0; n--, seg++) + if (addr < seg->start) { + seg = (&segments[n_segments]); + while (n-- > 0) { + seg[0] = seg[-1]; seg--; } break; @@ -199,47 +206,49 @@ int mapped_fd; n_segments++; - seg->start=addr; - seg->length=len; - seg->protection=protection; - seg->mapped_fd=mapped_fd; - seg->file_offset=file_offset; + seg->start = addr; + seg->length = len; + seg->protection = protection; + seg->mapped_fd = mapped_fd; + seg->file_offset = file_offset; return seg; } #if 1 /* returns the first segment containing addr */ -static struct segment *seg_find(addr) -os_vm_address_t addr; +static struct segment * +seg_find(addr) + os_vm_address_t addr; { int n; struct segment *seg; - for(n=n_segments, seg=segments; n>0; n--, seg++) - if(seg->start<=addr && seg->start+seg->length>addr) + for (n = n_segments, seg = segments; n > 0; n--, seg++) + if (seg->start <= addr && seg->start + seg->length > addr) return seg; return NULL; } #else /* returns the first segment containing addr */ -static struct segment *seg_find(addr) -os_vm_address_t addr; +static struct segment * +seg_find(addr) + os_vm_address_t addr; { /* does a binary search */ - struct segment *lo=segments, *hi=segments+n_segments; + struct segment *lo = segments, *hi = segments + n_segments; - while(hi>lo){ - struct segment *mid=lo+((hi-lo)>>1); - os_vm_address_t start=mid->start; + while (hi > lo) { + struct segment *mid = lo + ((hi - lo) >> 1); + os_vm_address_t start = mid->start; - if(addr>=start && addr<start+mid->length) + if (addr >= start && addr < start + mid->length) return mid; - else if(addr<start) - hi=mid; + else if (addr < start) + hi = mid; else - lo=mid+1; + lo = mid + 1; } return NULL; @@ -247,36 +256,38 @@ os_vm_address_t addr; #endif /* returns TRUE if the range from addr to addr+len intersects with any segment */ -static boolean collides_with_seg_p(addr,len) -os_vm_address_t addr; -os_vm_size_t len; +static boolean +collides_with_seg_p(addr, len) + os_vm_address_t addr; + os_vm_size_t len; { int n; struct segment *seg; - os_vm_address_t end=addr+len; + os_vm_address_t end = addr + len; - for(n=n_segments, seg=segments; n>0; n--, seg++) - if(seg->start>=end) + for (n = n_segments, seg = segments; n > 0; n--, seg++) + if (seg->start >= end) return FALSE; - else if(seg->start+seg->length>addr) + else if (seg->start + seg->length > addr) return TRUE; return FALSE; } -#if 0 /* WAY to SLOW */ +#if 0 /* WAY to SLOW */ /* returns TRUE if the range from addr to addr+len is a valid mapping * (that we don't know about) */ -static boolean mem_in_use(addr,len) -os_vm_address_t addr; -os_vm_size_t len; +static boolean +mem_in_use(addr, len) + os_vm_address_t addr; + os_vm_size_t len; { os_vm_address_t p; for (p = addr; addr < addr + len; p += os_real_page_size) { char c; - if (mincore((caddr_t)p, os_real_page_size, &c) == 0 || errno != ENOMEM) + if (mincore((caddr_t) p, os_real_page_size, &c) == 0 || errno != ENOMEM) return TRUE; } return FALSE; @@ -285,14 +296,15 @@ os_vm_size_t len; #define seg_last_p(seg) (((seg)-segments)>=n_segments-1) -static void seg_destroy(seg) -struct segment *seg; +static void +seg_destroy(seg) + struct segment *seg; { - if(seg!=NULL){ + if (seg != NULL) { int n; - for(n=seg-segments+1; n<n_segments; n++){ - seg[0]=seg[1]; + for (n = seg - segments + 1; n < n_segments; n++) { + seg[0] = seg[1]; seg++; } @@ -300,34 +312,34 @@ struct segment *seg; } } -static void seg_try_merge_next(seg) -struct segment *seg; +static void +seg_try_merge_next(seg) + struct segment *seg; { - struct segment *nseg=seg+1; - - if(!seg_last_p(seg) - && seg->start+seg->length==nseg->start - && seg->protection==nseg->protection - && seg->mapped_fd==nseg->mapped_fd - && ADJ_OFFSET(seg->file_offset,seg->length)==nseg->file_offset) - { + struct segment *nseg = seg + 1; + + if (!seg_last_p(seg) + && seg->start + seg->length == nseg->start + && seg->protection == nseg->protection + && seg->mapped_fd == nseg->mapped_fd + && ADJ_OFFSET(seg->file_offset, seg->length) == nseg->file_offset) { /* can merge with the next segment */ #ifdef DEBUG fprintf(stderr, ";;; seg_try_merge: Merged 0x%08x[0x%08x] with 0x%08x[0x%08x]\n", - seg->start,seg->length,nseg->start,nseg->length); + seg->start, seg->length, nseg->start, nseg->length); #endif - if(((long)nseg->start&SPARSE_SIZE_MASK)!=0){ + if (((long) nseg->start & SPARSE_SIZE_MASK) != 0) { /* * if not on a block boundary, we have to ensure both parts * of a common block are in a known state */ - seg_force_resident(seg,nseg->start-1,1); - seg_force_resident(nseg,nseg->start,1); + seg_force_resident(seg, nseg->start - 1, 1); + seg_force_resident(nseg, nseg->start, 1); } - seg->length+=nseg->length; + seg->length += nseg->length; seg_destroy(nseg); } } @@ -336,23 +348,27 @@ struct segment *seg; /* * Try to merge seg with adjacent segments. */ -static void seg_try_merge_adjacent(seg) -struct segment *seg; +static void +seg_try_merge_adjacent(seg) + struct segment *seg; { - if(!seg_last_p(seg)) + if (!seg_last_p(seg)) seg_try_merge_next(seg); - if(seg>segments) - seg_try_merge_next(seg-1); + if (seg > segments) + seg_try_merge_next(seg - 1); } -static struct segment *seg_create(addr,len,protection,mapped_fd,file_offset) -os_vm_address_t addr; -os_vm_size_t len; -int protection; -int mapped_fd; +static struct segment * +seg_create(addr, len, protection, mapped_fd, file_offset) + os_vm_address_t addr; + os_vm_size_t len; + int protection; + int mapped_fd; { - struct segment *seg=seg_create_nomerge(addr,len,protection,mapped_fd,file_offset); - if(seg!=NULL) + struct segment *seg = + + seg_create_nomerge(addr, len, protection, mapped_fd, file_offset); + if (seg != NULL) seg_try_merge_adjacent(seg); return seg; } @@ -361,98 +377,95 @@ int mapped_fd; * Change the attributes of the given range of an existing segment, and return * a segment corresponding to the new bit. */ -static struct segment *seg_change_range(seg,addr,len,protection,mapped_fd,file_offset) -struct segment *seg; -os_vm_address_t addr; -os_vm_size_t len; -int protection; -int mapped_fd; +static struct segment * +seg_change_range(seg, addr, len, protection, mapped_fd, file_offset) + struct segment *seg; + os_vm_address_t addr; + os_vm_size_t len; + int protection; + int mapped_fd; { - os_vm_address_t end=addr+len; + os_vm_address_t end = addr + len; - if(len==0) + if (len == 0) return NULL; - if(protection!=seg->protection - || mapped_fd!=seg->mapped_fd - || file_offset!=ADJ_OFFSET(seg->file_offset,addr-seg->start)) - { - os_vm_size_t old_len=seg->length, seg_offset=(addr-seg->start); - - if(old_len<len+seg_offset){ - struct segment *next=seg+1; - + if (protection != seg->protection + || mapped_fd != seg->mapped_fd + || file_offset != ADJ_OFFSET(seg->file_offset, addr - seg->start)) { + os_vm_size_t old_len = seg->length, seg_offset = (addr - seg->start); + + if (old_len < len + seg_offset) { + struct segment *next = seg + 1; + #ifdef DEBUG fprintf(stderr, ";;; seg_change_range: region 0x%08x[0x%08x] overflows 0x%08x[0x%08x]\n", - addr,len, - seg->start,old_len); + addr, len, seg->start, old_len); #endif - - while(!seg_last_p(seg) && next->start+next->length<=end){ + + while (!seg_last_p(seg) && next->start + next->length <= end) { #ifdef DEBUG fprintf(stderr, ";;; seg_change_range: merging extra segment 0x%08x[0x%08x]\n", - next->start, - next->length); + next->start, next->length); #endif seg_destroy(next); } - - if(!seg_last_p(seg) && next->start<end){ - next->length-=end-next->start; - next->start=end; - old_len=next->start-seg->start; - }else - old_len=len+seg_offset; - + + if (!seg_last_p(seg) && next->start < end) { + next->length -= end - next->start; + next->start = end; + old_len = next->start - seg->start; + } else + old_len = len + seg_offset; + #ifdef DEBUG fprintf(stderr, ";;; seg_change_range: extended first seg to 0x%08x[0x%08x]\n", - seg->start, - old_len); + seg->start, old_len); #endif } - if(seg_offset+len<old_len){ + if (seg_offset + len < old_len) { /* add second part of old segment */ seg_create_nomerge(end, - old_len-(seg_offset+len), + old_len - (seg_offset + len), seg->protection, seg->mapped_fd, - ADJ_OFFSET(seg->file_offset,seg_offset+len)); + ADJ_OFFSET(seg->file_offset, seg_offset + len)); #ifdef DEBUG fprintf(stderr, ";;; seg_change_range: Split off end of 0x%08x[0x%08x]: 0x%08x[0x%08x]\n", - seg->start,old_len, - end,old_len-(seg_offset+len)); + seg->start, old_len, end, old_len - (seg_offset + len)); #endif } - if(seg_offset==0){ - seg->length=len; - seg->protection=protection; - seg->mapped_fd=mapped_fd; - seg->file_offset=file_offset; - }else{ + if (seg_offset == 0) { + seg->length = len; + seg->protection = protection; + seg->mapped_fd = mapped_fd; + seg->file_offset = file_offset; + } else { /* adjust first part of remaining old segment */ - seg->length=seg_offset; + seg->length = seg_offset; #ifdef DEBUG fprintf(stderr, ";;; seg_change_range: Split off beginning of 0x%08x[0x%08x]: 0x%08x[0x%08x]\n", - seg->start,old_len, - seg->start,seg_offset); + seg->start, old_len, seg->start, seg_offset); #endif /* add new middle segment for new protected region */ - seg=seg_create_nomerge(addr,len,protection,mapped_fd,file_offset); + seg = + seg_create_nomerge(addr, len, protection, mapped_fd, + file_offset); } seg_try_merge_adjacent(seg); - last_fault=0; + last_fault = 0; } return seg; @@ -460,92 +473,95 @@ int mapped_fd; /* ---------------------------------------------------------------- */ -static os_vm_address_t mapin(addr,len,protection,map_fd,offset,is_readable) -os_vm_address_t addr; -os_vm_size_t len; -int protection; -int map_fd; -long offset; -int is_readable; +static os_vm_address_t +mapin(addr, len, protection, map_fd, offset, is_readable) + os_vm_address_t addr; + os_vm_size_t len; + int protection; + int map_fd; + long offset; + int is_readable; { os_vm_address_t real; - boolean sparse=(len>=SPARSE_BLOCK_SIZE); + boolean sparse = (len >= SPARSE_BLOCK_SIZE); - if(offset!=OFFSET_NONE - && (offset<os_vm_page_size || (offset&(os_vm_page_size-1))!=0)) - { + if (offset != OFFSET_NONE + && (offset < os_vm_page_size || (offset & (os_vm_page_size - 1)) != 0)) { fprintf(stderr, "mapin: file offset (%d) not multiple of pagesize (%d)\n", - offset, - os_vm_page_size); + offset, os_vm_page_size); } - if(addr==NULL) - len+=real_page_size_difference; /* futz around to get an aligned region */ + if (addr == NULL) + len += real_page_size_difference; /* futz around to get an aligned region */ - last_fault=0; - real=(os_vm_address_t) - mmap((caddr_t)addr, - (long)len, - sparse ? (is_readable ? PROT_READ|PROT_EXEC : 0) : protection, - (addr==NULL? 0 : MAP_FIXED)|MAP_PRIVATE, + last_fault = 0; + real = (os_vm_address_t) + mmap((caddr_t) addr, + (long) len, + sparse ? (is_readable ? PROT_READ | PROT_EXEC : 0) : protection, + (addr == NULL ? 0 : MAP_FIXED) | MAP_PRIVATE, (is_readable || !sparse) ? map_fd : empty_fd, - (off_t)(offset==OFFSET_NONE ? 0 : offset)); + (off_t) (offset == OFFSET_NONE ? 0 : offset)); - if((long)real==-1){ + if ((long) real == -1) { perror("mapin: mmap"); return NULL; } - if(addr==NULL){ + if (addr == NULL) { /* * now play around with what the os gave us to make it align by * our standards (which is why we overallocated) */ os_vm_size_t overflow; - addr=os_round_up_to_page(real); - if(addr!=real) - munmap((caddr_t)real,addr-real); - - overflow=real_page_size_difference-(addr-real); - if(overflow!=0) - munmap((caddr_t)(addr+len-real_page_size_difference),overflow); + addr = os_round_up_to_page(real); + if (addr != real) + munmap((caddr_t) real, addr - real); + + overflow = real_page_size_difference - (addr - real); + if (overflow != 0) + munmap((caddr_t) (addr + len - real_page_size_difference), + overflow); - real=addr; + real = addr; } return real; } -static os_vm_address_t map_and_remember(addr,len,protection,map_fd,offset,is_readable) -os_vm_address_t addr; -os_vm_size_t len; -int protection; -int map_fd; -long offset; -int is_readable; +static os_vm_address_t +map_and_remember(addr, len, protection, map_fd, offset, is_readable) + os_vm_address_t addr; + os_vm_size_t len; + int protection; + int map_fd; + long offset; + int is_readable; { - os_vm_address_t real=mapin(addr,len,protection,map_fd,offset,is_readable); + os_vm_address_t real = - if(real!=NULL){ - struct segment *seg=seg_find(real); + mapin(addr, len, protection, map_fd, offset, is_readable); - if(seg!=NULL) - seg=seg_change_range(seg,real,len,protection,map_fd,offset); + if (real != NULL) { + struct segment *seg = seg_find(real); + + if (seg != NULL) + seg = seg_change_range(seg, real, len, protection, map_fd, offset); else - seg=seg_create(real,len,protection,map_fd,offset); + seg = seg_create(real, len, protection, map_fd, offset); - if(seg==NULL){ - munmap((caddr_t)real,len); + if (seg == NULL) { + munmap((caddr_t) real, len); return NULL; } } - #ifdef DEBUG - fprintf(stderr,";;; map_and_remember: 0x%08x[0x%08x] offset: %d, mapped to: %d\n", - real,len,offset,map_fd); + fprintf(stderr, + ";;; map_and_remember: 0x%08x[0x%08x] offset: %d, mapped to: %d\n", + real, len, offset, map_fd); #endif return real; @@ -553,144 +569,157 @@ int is_readable; /* ---------------------------------------------------------------- */ -os_vm_address_t os_validate(addr, len) -os_vm_address_t addr; -os_vm_size_t len; +os_vm_address_t +os_validate(addr, len) + os_vm_address_t addr; + os_vm_size_t len; { - addr=os_trunc_to_page(addr); - len=os_round_up_size_to_page(len); + addr = os_trunc_to_page(addr); + len = os_round_up_size_to_page(len); #ifdef DEBUG - fprintf(stderr, ";;; os_validate: 0x%08x[0x%08x]\n",addr,len); + fprintf(stderr, ";;; os_validate: 0x%08x[0x%08x]\n", addr, len); #endif - if(addr!=NULL && collides_with_seg_p(addr,len)) + if (addr != NULL && collides_with_seg_p(addr, len)) return NULL; - return map_and_remember(addr,len,PROT_DEFAULT,zero_fd,OFFSET_NONE,FALSE); + return map_and_remember(addr, len, PROT_DEFAULT, zero_fd, OFFSET_NONE, + FALSE); } -void os_invalidate(addr, len) -os_vm_address_t addr; -os_vm_size_t len; +void +os_invalidate(addr, len) + os_vm_address_t addr; + os_vm_size_t len; { - struct segment *seg=seg_find(addr); + struct segment *seg = seg_find(addr); - addr=os_trunc_to_page(addr); - len=os_round_up_size_to_page(len); + addr = os_trunc_to_page(addr); + len = os_round_up_size_to_page(len); #ifdef DEBUG - fprintf(stderr, ";;; os_invalidate: 0x%08x[0x%08x]\n",addr,len); + fprintf(stderr, ";;; os_invalidate: 0x%08x[0x%08x]\n", addr, len); #endif - if(seg==NULL) - fprintf(stderr, "os_invalidate: Unknown segment: 0x%08x[0x%08x]\n",addr,len); - else{ - seg=seg_change_range(seg,addr,len,0,0,OFFSET_NONE); - if(seg!=NULL) + if (seg == NULL) + fprintf(stderr, "os_invalidate: Unknown segment: 0x%08x[0x%08x]\n", + addr, len); + else { + seg = seg_change_range(seg, addr, len, 0, 0, OFFSET_NONE); + if (seg != NULL) seg_destroy(seg); - last_fault=0; - if(munmap((caddr_t)addr,len)!=0) + last_fault = 0; + if (munmap((caddr_t) addr, len) != 0) perror("os_invalidate: munmap"); } } -os_vm_address_t os_map(fd, offset, addr, len) -int fd; -int offset; -os_vm_address_t addr; -long len; +os_vm_address_t +os_map(fd, offset, addr, len) + int fd; + int offset; + os_vm_address_t addr; + long len; { - addr=os_trunc_to_page(addr); - len=os_round_up_size_to_page(len); + addr = os_trunc_to_page(addr); + len = os_round_up_size_to_page(len); #ifdef DEBUG - fprintf(stderr, ";;; os_map: 0x%08x[0x%08x]\n",addr,len); + fprintf(stderr, ";;; os_map: 0x%08x[0x%08x]\n", addr, len); #endif - return map_and_remember(addr,len,PROT_DEFAULT,fd,offset,TRUE); + return map_and_remember(addr, len, PROT_DEFAULT, fd, offset, TRUE); } -void os_flush_icache(address, length) -os_vm_address_t address; -os_vm_size_t length; +void +os_flush_icache(address, length) + os_vm_address_t address; + os_vm_size_t length; { #if defined(MACH) && defined(mips) - vm_machine_attribute_val_t flush; - kern_return_t kr; + vm_machine_attribute_val_t flush; + kern_return_t kr; - flush = MATTR_VAL_ICACHE_FLUSH; + flush = MATTR_VAL_ICACHE_FLUSH; - kr = vm_machine_attribute(task_self(), address, length, - MATTR_CACHE, &flush); - if (kr != KERN_SUCCESS) - mach_error("Could not flush the instruction cache", kr); + kr = vm_machine_attribute(task_self(), address, length, + MATTR_CACHE, &flush); + if (kr != KERN_SUCCESS) + mach_error("Could not flush the instruction cache", kr); #endif -#ifdef SOLARIS /* also SunOS ?? */ - static int flushit = -1; - /* - * On some systems, iflush needs to be emulated in the kernel - * On those systems, it isn't necessary - * Call getenv() only once. - */ - if (flushit == -1) - flushit = getenv("CMUCL_NO_SPARC_IFLUSH") == 0; +#ifdef SOLARIS /* also SunOS ?? */ + static int flushit = -1; - if (flushit) { - static int traceit = -1; - if (traceit == -1) - traceit = getenv("CMUCL_TRACE_SPARC_IFLUSH") != 0; + /* + * On some systems, iflush needs to be emulated in the kernel + * On those systems, it isn't necessary + * Call getenv() only once. + */ + if (flushit == -1) + flushit = getenv("CMUCL_NO_SPARC_IFLUSH") == 0; - if (traceit) - fprintf(stderr,";;;iflush %p - %x\n", address,length); - flush_icache(address,length); - } + if (flushit) { + static int traceit = -1; + + if (traceit == -1) + traceit = getenv("CMUCL_TRACE_SPARC_IFLUSH") != 0; + + if (traceit) + fprintf(stderr, ";;;iflush %p - %x\n", address, length); + flush_icache(address, length); + } #endif } -void os_protect(addr, len, prot) -os_vm_address_t addr; -os_vm_size_t len; -int prot; +void +os_protect(addr, len, prot) + os_vm_address_t addr; + os_vm_size_t len; + int prot; { - struct segment *seg=seg_find(addr); + struct segment *seg = seg_find(addr); - addr=os_trunc_to_page(addr); - len=os_round_up_size_to_page(len); + addr = os_trunc_to_page(addr); + len = os_round_up_size_to_page(len); #ifdef DEBUG - fprintf(stderr,";;; os_protect: 0x%08x[0x%08x]\n",addr,len); + fprintf(stderr, ";;; os_protect: 0x%08x[0x%08x]\n", addr, len); #endif - if(seg!=NULL){ - int old_prot=seg->protection; + if (seg != NULL) { + int old_prot = seg->protection; - if(prot!=old_prot){ + if (prot != old_prot) { /* * oooooh, sick: we have to make sure all the pages being protected have * faulted in, so they're in a known state... */ - seg_force_resident(seg,addr,len); + seg_force_resident(seg, addr, len); - seg_change_range(seg,addr,len,prot,seg->mapped_fd,seg->file_offset); + seg_change_range(seg, addr, len, prot, seg->mapped_fd, + seg->file_offset); - if(mprotect((caddr_t)addr,(long)len,prot)!=0) + if (mprotect((caddr_t) addr, (long) len, prot) != 0) perror("os_unprotect: mprotect"); } - }else - fprintf(stderr,"os_protect: Unknown segment: 0x%08x[0x%08x]\n",addr,len); + } else + fprintf(stderr, "os_protect: Unknown segment: 0x%08x[0x%08x]\n", addr, + len); } -boolean valid_addr(test) -os_vm_address_t test; +boolean +valid_addr(test) + os_vm_address_t test; { - return seg_find(test)!=NULL; + return seg_find(test) != NULL; } /* ---------------------------------------------------------------- */ -static boolean maybe_gc(HANDLER_ARGS) +static boolean +maybe_gc(HANDLER_ARGS) { /* * It's necessary to enable recursive SEGVs, since the handle is @@ -699,22 +728,22 @@ static boolean maybe_gc(HANDLER_ARGS) */ boolean did_gc; - static already_trying=0; + static already_trying = 0; - if(already_trying) + if (already_trying) return FALSE; SAVE_CONTEXT(); #ifdef POSIX_SIGS - sigprocmask(SIG_SETMASK, &context->uc_sigmask,0); + sigprocmask(SIG_SETMASK, &context->uc_sigmask, 0); #else sigsetmask(context->sc_mask); #endif - already_trying=TRUE; - did_gc=interrupt_maybe_gc(signal, code, context); - already_trying=FALSE; + already_trying = TRUE; + did_gc = interrupt_maybe_gc(signal, code, context); + already_trying = FALSE; return did_gc; } @@ -728,10 +757,12 @@ static boolean maybe_gc(HANDLER_ARGS) * Running into the gc trigger page will also end up here... */ #ifndef SOLARIS -void segv_handler(HANDLER_ARGS, caddr_t addr) +void +segv_handler(HANDLER_ARGS, caddr_t addr) #else -void segv_handler(HANDLER_ARGS) -#endif /* SOLARIS */ +void +segv_handler(HANDLER_ARGS) +#endif /* SOLARIS */ { #ifdef SOLARIS caddr_t addr = code->si_addr; @@ -740,74 +771,75 @@ void segv_handler(HANDLER_ARGS) SAVE_CONTEXT(); if (CODE(code) == OS_PROTERR) { /* allow writes to this chunk */ - struct segment *seg=seg_find(addr); + struct segment *seg = seg_find(addr); - if((caddr_t)last_fault==addr){ - if(seg!=NULL && maybe_gc(signal, code, context)) + if ((caddr_t) last_fault == addr) { + if (seg != NULL && maybe_gc(signal, code, context)) /* we just garbage collected */ return; - else{ + else { /* a *real* protection fault */ fprintf(stderr, "segv_handler: Real protection violation: 0x%08x\n", addr); - interrupt_handle_now(signal,code,context); + interrupt_handle_now(signal, code, context); } - }else - last_fault=(os_vm_address_t) addr; + } else + last_fault = (os_vm_address_t) addr; - if(seg!=NULL){ + if (seg != NULL) { int err; + /* round down to a page */ - os_vm_address_t block=(os_vm_address_t)((long)addr&~SPARSE_SIZE_MASK); - os_vm_size_t length=SPARSE_BLOCK_SIZE; + os_vm_address_t block = + + (os_vm_address_t) ((long) addr & ~SPARSE_SIZE_MASK); + os_vm_size_t length = SPARSE_BLOCK_SIZE; - if(block < seg->start){ - length-=(seg->start - block); - block=seg->start; + if (block < seg->start) { + length -= (seg->start - block); + block = seg->start; } - if(block+length > seg->start+seg->length) - length=seg->start+seg->length-block; + if (block + length > seg->start + seg->length) + length = seg->start + seg->length - block; #if 0 /* unmap it. probably redundant. */ - if(munmap((caddr_t)block,length) == -1) + if (munmap((caddr_t) block, length) == -1) perror("segv_handler: munmap"); #endif /* and remap it with more permissions */ - err=(int) - mmap((caddr_t)block, + err = (int) + mmap((caddr_t) block, length, seg->protection, - MAP_PRIVATE|MAP_FIXED, + MAP_PRIVATE | MAP_FIXED, seg->mapped_fd, - seg->file_offset==OFFSET_NONE - ? 0 - : seg->file_offset+(block-seg->start)); + seg->file_offset == OFFSET_NONE + ? 0 : seg->file_offset + (block - seg->start)); if (err == -1) { perror("segv_handler: mmap"); - interrupt_handle_now(signal,code,context); + interrupt_handle_now(signal, code, context); } - } - else{ - fprintf(stderr, "segv_handler: 0x%08x not in any segment\n",addr); - interrupt_handle_now(signal,code,context); + } else { + fprintf(stderr, "segv_handler: 0x%08x not in any segment\n", addr); + interrupt_handle_now(signal, code, context); } } /* * note that we check for a gc-trigger hit even if it's not a PROT error */ - else if(!maybe_gc(signal, code, context)){ - static int nomap_count=0; + else if (!maybe_gc(signal, code, context)) { + static int nomap_count = 0; - if(CODE(code)==OS_MAPERR){ - if(nomap_count==0){ + if (CODE(code) == OS_MAPERR) { + if (nomap_count == 0) { fprintf(stderr, - "segv_handler: No mapping fault: 0x%08x\n",addr); + "segv_handler: No mapping fault: 0x%08x\n", addr); nomap_count++; - }else{ + } else { /* * There should be higher-level protection against stack * overflow somewhere, but at least this prevents infinite @@ -817,21 +849,22 @@ void segv_handler(HANDLER_ARGS) "segv_handler: Recursive no mapping fault (stack overflow?)\n"); exit(-1); } - } else if(OS_HASERRNO(code)) { - errno=OS_ERRNO(code); + } else if (OS_HASERRNO(code)) { + errno = OS_ERRNO(code); perror("segv_handler: Object error"); } - interrupt_handle_now(signal,code,context); + interrupt_handle_now(signal, code, context); - if(CODE(code)==OS_MAPERR) + if (CODE(code) == OS_MAPERR) nomap_count--; } } -void os_install_interrupt_handlers() +void +os_install_interrupt_handlers() { - interrupt_install_low_level_handler(SIGSEGV,segv_handler); + interrupt_install_low_level_handler(SIGSEGV, segv_handler); } @@ -840,7 +873,8 @@ void os_install_interrupt_handlers() /* function defintions for register lvalues */ -int * solaris_register_address(struct ucontext *context, int reg) +int * +solaris_register_address(struct ucontext *context, int reg) { if (reg == 0) { static int zero; @@ -849,20 +883,41 @@ int * solaris_register_address(struct ucontext *context, int reg) return &zero; } else if (reg < 16) { - return &context->uc_mcontext.gregs[reg+3]; + return &context->uc_mcontext.gregs[reg + 3]; } else if (reg < 32) { - int *sp = (int*) context->uc_mcontext.gregs[REG_SP]; - return &sp[reg-16]; + int *sp = (int *) context->uc_mcontext.gregs[REG_SP]; + + return &sp[reg - 16]; } else return 0; } + /* function defintions for backward compatibilty and static linking */ #if 0 -void * dlopen(const char * file, int flag) { return 0; } -void * dlsym(void *obj, const char *sym) { return 0; } -int dlclose(void *obj) { return 0; } -char * dlerror(void) { return "no dynamic linking"; } +void * +dlopen(const char *file, int flag) +{ + return 0; +} + +void * +dlsym(void *obj, const char *sym) +{ + return 0; +} + +int +dlclose(void *obj) +{ + return 0; +} + +char * +dlerror(void) +{ + return "no dynamic linking"; +} #endif /* For now we put in some porting functions */ @@ -889,24 +944,24 @@ getpagesize(void) #include <sys/procfs.h> /* Old rusage definition */ -struct rusage { - struct timeval ru_utime; /* user time used */ - struct timeval ru_stime; /* system time used */ - long ru_maxrss; +struct rusage { + struct timeval ru_utime; /* user time used */ + struct timeval ru_stime; /* system time used */ + long ru_maxrss; #define ru_first ru_ixrss - long ru_ixrss; /* XXX: 0 */ - long ru_idrss; /* XXX: sum of rm_asrss */ - long ru_isrss; /* XXX: 0 */ - long ru_minflt; /* any page faults not requiring I/O */ - long ru_majflt; /* any page faults requiring I/O */ - long ru_nswap; /* swaps */ - long ru_inblock; /* block input operations */ - long ru_oublock; /* block output operations */ - long ru_msgsnd; /* messages sent */ - long ru_msgrcv; /* messages received */ - long ru_nsignals; /* signals received */ - long ru_nvcsw; /* voluntary context switches */ - long ru_nivcsw; /* involuntary " */ + long ru_ixrss; /* XXX: 0 */ + long ru_idrss; /* XXX: sum of rm_asrss */ + long ru_isrss; /* XXX: 0 */ + long ru_minflt; /* any page faults not requiring I/O */ + long ru_majflt; /* any page faults requiring I/O */ + long ru_nswap; /* swaps */ + long ru_inblock; /* block input operations */ + long ru_oublock; /* block output operations */ + long ru_msgsnd; /* messages sent */ + long ru_msgrcv; /* messages received */ + long ru_nsignals; /* signals received */ + long ru_nvcsw; /* voluntary context switches */ + long ru_nivcsw; /* involuntary " */ #define ru_last ru_nivcsw }; @@ -915,13 +970,14 @@ int getrusage(int who, struct rusage *rp) { memset(rp, 0, sizeof(struct rusage)); + return 0; } int setreuid() { - fprintf(stderr,"setreuid unimplemented\n"); + fprintf(stderr, "setreuid unimplemented\n"); errno = ENOSYS; return -1; } @@ -929,7 +985,7 @@ setreuid() int setregid() { - fprintf(stderr,"setregid unimplemented\n"); + fprintf(stderr, "setregid unimplemented\n"); errno = ENOSYS; return -1; } @@ -937,7 +993,7 @@ setregid() int gethostid() { - fprintf(stderr,"gethostid unimplemented\n"); + fprintf(stderr, "gethostid unimplemented\n"); errno = ENOSYS; return -1; } @@ -972,6 +1028,7 @@ wait3(int *status, int options, struct rusage *rp) { if (rp) memset(rp, 0, sizeof(struct rusage)); + return waitpid(-1, status, options); } #endif @@ -992,10 +1049,9 @@ sigsetmask(int mask) #endif /* SOLARIS */ -os_vm_address_t -round_up_sparse_size(os_vm_address_t addr) +os_vm_address_t round_up_sparse_size(os_vm_address_t addr) { - return (addr + SPARSE_BLOCK_SIZE - 1) & ~SPARSE_SIZE_MASK; + return (addr + SPARSE_BLOCK_SIZE - 1) & ~SPARSE_SIZE_MASK; } /* @@ -1003,10 +1059,9 @@ round_up_sparse_size(os_vm_address_t addr) * after them. Must not include the dynamic spaces because the size * of the dynamic space can be controlled from the command line. */ -static os_vm_address_t spaces[] = -{ - READ_ONLY_SPACE_START, STATIC_SPACE_START, - BINDING_STACK_START, CONTROL_STACK_START +static os_vm_address_t spaces[] = { + READ_ONLY_SPACE_START, STATIC_SPACE_START, + BINDING_STACK_START, CONTROL_STACK_START }; /* @@ -1016,10 +1071,9 @@ static os_vm_address_t spaces[] = * SPARSE_BLOCK_SIZE boundaries. */ -static unsigned long space_size[] = -{ - READ_ONLY_SPACE_SIZE, STATIC_SPACE_SIZE, - BINDING_STACK_SIZE, CONTROL_STACK_SIZE +static unsigned long space_size[] = { + READ_ONLY_SPACE_SIZE, STATIC_SPACE_SIZE, + BINDING_STACK_SIZE, CONTROL_STACK_SIZE }; /* @@ -1029,54 +1083,48 @@ static unsigned long space_size[] = #define HOLE_SIZE 0x2000 -void make_holes(void) +void +make_holes(void) { - int k; - os_vm_address_t hole; - - /* Make holes of the appropriate size for desired spaces */ - - for (k = 0; k < sizeof(spaces)/sizeof(spaces[0]); ++k) - { - - hole = spaces[k] + space_size[k]; - - if (os_validate(hole, HOLE_SIZE) == NULL) { - fprintf(stderr, - "ensure_space: Failed to validate hole of %ld bytes at 0x%08X\n", - HOLE_SIZE, - (unsigned long)hole); - exit(1); - } - /* Make it inaccessible */ - os_protect(hole, HOLE_SIZE, 0); + int k; + os_vm_address_t hole; + + /* Make holes of the appropriate size for desired spaces */ + + for (k = 0; k < sizeof(spaces) / sizeof(spaces[0]); ++k) { + + hole = spaces[k] + space_size[k]; + + if (os_validate(hole, HOLE_SIZE) == NULL) { + fprintf(stderr, + "ensure_space: Failed to validate hole of %ld bytes at 0x%08X\n", + HOLE_SIZE, (unsigned long) hole); + exit(1); + } + /* Make it inaccessible */ + os_protect(hole, HOLE_SIZE, 0); } - /* Round up the dynamic_space_size to the nearest SPARSE_BLOCK_SIZE */ - dynamic_space_size = round_up_sparse_size(dynamic_space_size); - - /* Now make a hole for the dynamic spaces */ - hole = dynamic_space_size + (os_vm_address_t) dynamic_0_space; - - if (os_validate(hole, HOLE_SIZE) == NULL) - { - fprintf(stderr, - "ensure_space: Failed to validate hold of %ld bytes at 0x%08X\n", - HOLE_SIZE, - (unsigned long)hole); - exit(1); + /* Round up the dynamic_space_size to the nearest SPARSE_BLOCK_SIZE */ + dynamic_space_size = round_up_sparse_size(dynamic_space_size); + + /* Now make a hole for the dynamic spaces */ + hole = dynamic_space_size + (os_vm_address_t) dynamic_0_space; + + if (os_validate(hole, HOLE_SIZE) == NULL) { + fprintf(stderr, + "ensure_space: Failed to validate hold of %ld bytes at 0x%08X\n", + HOLE_SIZE, (unsigned long) hole); + exit(1); } - os_protect(hole, HOLE_SIZE, 0); - - hole = dynamic_space_size + (os_vm_address_t) dynamic_1_space; - if (os_validate(hole, HOLE_SIZE) == NULL) - { - fprintf(stderr, - "ensure_space: Failed to validate hole of %ld bytes at 0x%08X\n", - HOLE_SIZE, - (unsigned long)hole); - exit(1); + os_protect(hole, HOLE_SIZE, 0); + + hole = dynamic_space_size + (os_vm_address_t) dynamic_1_space; + if (os_validate(hole, HOLE_SIZE) == NULL) { + fprintf(stderr, + "ensure_space: Failed to validate hole of %ld bytes at 0x%08X\n", + HOLE_SIZE, (unsigned long) hole); + exit(1); } - os_protect(hole, HOLE_SIZE, 0); + os_protect(hole, HOLE_SIZE, 0); } - diff --git a/lisp/sunos-os.h b/lisp/sunos-os.h index ffecaf789..f496442f9 100644 --- a/lisp/sunos-os.h +++ b/lisp/sunos-os.h @@ -1,6 +1,6 @@ /* - $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sunos-os.h,v 1.7 2005/09/05 06:09:13 cshapiro Exp $ + $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/sunos-os.h,v 1.8 2005/09/15 18:26:52 rtoy Exp $ This code was written as part of the CMU Common Lisp project at Carnegie Mellon University, and has been placed in the public domain. @@ -56,7 +56,7 @@ typedef int os_vm_prot_t; #define NULL 0 #endif -extern void flush_icache(unsigned int*, unsigned int); +extern void flush_icache(unsigned int *, unsigned int); extern void save_context(void); #endif /* SOLARIS */ diff --git a/lisp/time.c b/lisp/time.c index 0d03dc4e9..4af9b1656 100644 --- a/lisp/time.c +++ b/lisp/time.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/time.c,v 1.2 1993/11/13 01:08:46 wlott Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/time.c,v 1.3 2005/09/15 18:26:52 rtoy Rel $ */ /* Time support routines that are easier to do in C then in lisp. */ @@ -6,7 +6,8 @@ #include <time.h> #include "lisp.h" -void get_timezone(time_t when, int *minwest, boolean *dst) +void +get_timezone(time_t when, int *minwest, boolean * dst) { struct tm ltm, gtm; int mw; @@ -14,11 +15,11 @@ void get_timezone(time_t when, int *minwest, boolean *dst) ltm = *localtime(&when); gtm = *gmtime(&when); - mw = ((gtm.tm_hour*60)+gtm.tm_min) - ((ltm.tm_hour*60)+ltm.tm_min); + mw = ((gtm.tm_hour * 60) + gtm.tm_min) - ((ltm.tm_hour * 60) + ltm.tm_min); if ((gtm.tm_wday + 1) % 7 == ltm.tm_wday) - mw -= 24*60; + mw -= 24 * 60; else if (gtm.tm_wday == (ltm.tm_wday + 1) % 7) - mw += 24*60; + mw += 24 * 60; *minwest = mw; *dst = ltm.tm_isdst; } diff --git a/lisp/undefineds.c b/lisp/undefineds.c index 2191d0f6e..b4d7002c1 100644 --- a/lisp/undefineds.c +++ b/lisp/undefineds.c @@ -1,5 +1,5 @@ /* Routines that must be linked into the core for lisp to work. */ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.c,v 1.6 2001/09/24 21:23:18 toy Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.c,v 1.7 2005/09/15 18:26:53 rtoy Rel $ */ #ifdef sun #ifndef MACH @@ -22,14 +22,15 @@ extern func #include "undefineds.h" #undef F #undef D -exit; /* just a random function known to exist */ - + exit; /* just a random function known to exist */ + #if defined(SOLARIS) || defined(irix) #ifdef irix -int errno; /* hack to be sure works with newer libc without having to redump */ - /* causes libc to be relocated to match cmucl rather than vice - versa */ +int errno; /* hack to be sure works with newer libc without having to redump */ + + /* causes libc to be relocated to match cmucl rather than vice + versa */ #endif extern int @@ -38,16 +39,19 @@ extern int #include "undefineds.h" #undef F #undef D -errno; /* a random variable known to exist */ + errno; /* a random variable known to exist */ + +int +reference_random_symbols(void) +{ + int a; -int reference_random_symbols(void) { - int a; #if defined(SOLARIS) && defined(__GNUC__) - /* - * For some reason, gcc 3.0 still deletes function calls here, even - * with -O0. I don't know why. So, we don't define the functions - * here, but define them in the table below. - */ + /* + * For some reason, gcc 3.0 still deletes function calls here, even + * with -O0. I don't know why. So, we don't define the functions + * here, but define them in the table below. + */ #define F(x) #else #define F(x) x(0); @@ -56,7 +60,7 @@ int reference_random_symbols(void) { #include "undefineds.h" #undef F #undef D - return a; + return a; } #if defined(SOLARIS) && defined(__GNUC__) @@ -72,7 +76,7 @@ func *reference_random_symbols_table[] = { #include "undefineds.h" #undef F #undef D - exit /* a random function known to exist */ + exit /* a random function known to exist */ }; #endif @@ -86,12 +90,12 @@ extern long timezone; #endif func *reference_random_symbols[] = { #define F(x) x, - /* XXXfixme next line is probably wrong but was previous behavior */ + /* XXXfixme next line is probably wrong but was previous behavior */ #define D(x) &x, #include "undefineds.h" #undef F #undef D - exit /* a random function known to exist */ + exit /* a random function known to exist */ }; #endif diff --git a/lisp/undefineds.h b/lisp/undefineds.h index 173631384..7a5f3e3d6 100644 --- a/lisp/undefineds.h +++ b/lisp/undefineds.h @@ -1,306 +1,299 @@ /* Routines that must be linked into the core for lisp to work. */ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.h,v 1.36 2005/01/13 19:55:01 fgilham Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/undefineds.h,v 1.37 2005/09/15 18:26:53 rtoy Exp $ */ #ifndef _UNDEFINEDS_H_ #define _UNDEFINEDS_H_ /* Pick up all the syscalls. */ F(accept) -F(access) -F(acct) + F(access) + F(acct) #ifndef hpux -F(adjtime) + F(adjtime) #endif -F(bind) -F(brk) + F(bind) + F(brk) #if defined(hpux) || defined(SVR4) || defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) -F(cfgetospeed) -F(cfsetospeed) -F(cfgetispeed) -F(cfsetispeed) -#endif -F(chdir) -F(chmod) -F(chown) -F(chroot) -F(close) -F(connect) -F(creat) -F(dup) -F(dup2) -F(execve) -F(exit) -F(fchmod) -F(fchown) -F(fcntl) + F(cfgetospeed) + F(cfsetospeed) + F(cfgetispeed) + F(cfsetispeed) +#endif + F(chdir) + F(chmod) + F(chown) + F(chroot) + F(close) + F(connect) + F(creat) + F(dup) + F(dup2) + F(execve) + F(exit) + F(fchmod) + F(fchown) + F(fcntl) #if !defined(hpux) && !defined(SVR4) -F(flock) + F(flock) #endif -F(fork) -F(fstat) -F(fsync) -F(ftruncate) + F(fork) + F(fstat) + F(fsync) + F(ftruncate) #if !defined(hpux) && !defined(SVR4) || defined(SOLARIS25) || defined(irix) -F(getdtablesize) + F(getdtablesize) #endif -F(getegid) -F(geteuid) -F(getgid) -F(getgroups) + F(getegid) + F(geteuid) + F(getgid) + F(getgroups) #if !defined (SOLARIS) || defined(SOLARIS25) -F(gethostid) + F(gethostid) #endif -F(gethostname) -F(getitimer) + F(gethostname) + F(getitimer) #if !defined(hpux) && !defined(SVR4) || defined(SOLARIS25) -F(getpagesize) + F(getpagesize) #endif -F(getpeername) -F(getpgrp) -F(getpid) -F(getppid) + F(getpeername) + F(getpgrp) + F(getpid) + F(getppid) #if !defined(SVR4) || defined(SOLARIS25) -F(getpriority) + F(getpriority) #endif -F(getrlimit) + F(getrlimit) #if !defined(SOLARIS) || defined(SOLARIS25) -F(getrusage) -#endif -F(getsockname) -F(getsockopt) -F(gettimeofday) -F(getuid) -F(ioctl) -F(kill) + F(getrusage) +#endif + F(getsockname) + F(getsockopt) + F(gettimeofday) + F(getuid) + F(ioctl) + F(kill) #if !defined(SOLARIS) || defined(SOLARIS25) -F(killpg) -#endif -F(link) -F(listen) -F(lseek) -F(lstat) -F(mkdir) -F(mknod) -F(mmap) -F(mount) -F(msync) -F(munmap) -F(open) -F(pipe) -F(profil) -F(ptrace) + F(killpg) +#endif + F(link) + F(listen) + F(lseek) + F(lstat) + F(mkdir) + F(mknod) + F(mmap) + F(mount) + F(msync) + F(munmap) + F(open) + F(pipe) + F(profil) + F(ptrace) #ifdef mach -F(quota) + F(quota) #endif -F(read) -F(readlink) -F(readv) + F(read) + F(readlink) + F(readv) #ifndef SVR4 -F(reboot) -#endif -F(recv) -F(recvfrom) -F(recvmsg) -F(rename) -F(rmdir) -F(sbrk) -F(select) -F(send) -F(sendmsg) -F(sendto) -F(setgroups) + F(reboot) +#endif + F(recv) + F(recvfrom) + F(recvmsg) + F(rename) + F(rmdir) + F(sbrk) + F(select) + F(send) + F(sendmsg) + F(sendto) + F(setgroups) #if !defined(SUNOS) && !(defined(SOLARIS) || defined(SOLARIS25)) -F(sethostid) + F(sethostid) #endif #if !defined(SVR4) || defined(SOLARIS25) -F(sethostname) + F(sethostname) #endif -F(setitimer) -F(setpgrp) + F(setitimer) + F(setpgrp) #if !defined(SVR4) || defined(SOLARIS25) -F(setpriority) + F(setpriority) #endif #if !defined(mach) && !defined(SOLARIS) && !defined(__FreeBSD__) && !defined(__OpenBSD__) && !defined(__NetBSD__) && !defined(SUNOS) && !defined(osf1) && !defined(irix) && !defined(hpux) && !(defined(linux) && defined(alpha)) -F(setquota) + F(setquota) #endif #if !defined(hpux) && !defined(SVR4) || defined(SOLARIS25) -F(setregid) -F(setreuid) -#endif -F(setrlimit) -F(setsockopt) -F(settimeofday) -F(setgid) -F(setuid) -F(shutdown) + F(setregid) + F(setreuid) +#endif + F(setrlimit) + F(setsockopt) + F(settimeofday) + F(setgid) + F(setuid) + F(shutdown) #ifndef SVR4 -F(sigblock) + F(sigblock) #endif -F(sigpause) + F(sigpause) #if !defined(ibmrt) && !defined(hpux) && !defined(SVR4) && !defined(i386) -F(sigreturn) + F(sigreturn) #endif #if !defined(SVR4) && !defined(__FreeBSD__) && !defined(__OpenBSD__) && !defined(__NetBSD__) && !defined(DARWIN) -F(sigsetmask) -F(sigstack) -F(sigvec) + F(sigsetmask) + F(sigstack) + F(sigvec) #endif -F(socket) -F(socketpair) -F(stat) + F(socket) + F(socketpair) + F(stat) #ifndef SVR4 -F(swapon) + F(swapon) #endif -F(symlink) -F(sync) -F(syscall) + F(symlink) + F(sync) + F(syscall) #if defined(hpux) || defined(SVR4) -F(closedir) -F(opendir) -F(readdir) + F(closedir) + F(opendir) + F(readdir) #endif #if defined(hpux) || defined(SVR4) || defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) || defined(__linux__) -F(tcgetattr) -F(tcsetattr) -F(tcsendbreak) -F(tcdrain) -F(tcflush) -F(tcflow) + F(tcgetattr) + F(tcsetattr) + F(tcsendbreak) + F(tcdrain) + F(tcflush) + F(tcflow) #endif #if defined(SOLARIS) -F(times) + F(times) #endif -F(truncate) -F(umask) + F(truncate) + F(umask) #if !defined(SUNOS) && !defined(parisc) && !defined(SOLARIS) \ && !defined(__FreeBSD__) && !defined(__OpenBSD__) && !defined(__NetBSD__) \ && !defined(DARWIN) -F(umount) + F(umount) #endif -F(unlink) + F(unlink) #ifndef hpux -F(utimes) + F(utimes) #endif #ifndef irix -F(vfork) + F(vfork) #endif #if !defined(osf1) && !defined(__FreeBSD__) && !defined(__OpenBSD__) && !defined(__NetBSD__) && !defined(DARWIN) -F(vhangup) + F(vhangup) #endif -F(wait) + F(wait) #if !defined(SOLARIS) || defined(SOLARIS25) -F(wait3) + F(wait3) #endif -F(write) -F(writev) + F(write) + F(writev) /* Math routines. */ -F(cos) -F(sin) -F(tan) -F(acos) -F(asin) -F(atan) -F(atan2) -F(sinh) -F(cosh) -F(tanh) -F(asinh) -F(acosh) -F(atanh) -F(exp) + F(cos) + F(sin) + F(tan) + F(acos) + F(asin) + F(atan) + F(atan2) + F(sinh) + F(cosh) + F(tanh) + F(asinh) + F(acosh) + F(atanh) + F(exp) #ifndef hpux -F(expm1) + F(expm1) #endif -F(log) -F(log10) + F(log) + F(log10) #ifndef hpux -F(log1p) + F(log1p) #endif -F(pow) + F(pow) #ifndef hpux -F(cbrt) + F(cbrt) #endif #ifndef i386 -F(sqrt) + F(sqrt) #endif -F(hypot) + F(hypot) /* Network support. */ -F(gethostbyname) -F(gethostbyaddr) + F(gethostbyname) + F(gethostbyaddr) /* Other random things. */ -#if defined(SVR4) -F(setpgid) -F(getpgid) -D(timezone) -D(altzone) -D(daylight) -D(tzname) +#if defined(SVR4) + F(setpgid) + F(getpgid) + D(timezone) + D(altzone) + D(daylight) + D(tzname) #endif - #if defined(SVR4) || defined(__OpenBSD__) -F(dlopen) -F(dlsym) -F(dlclose) -F(dlerror) + F(dlopen) + F(dlsym) + F(dlclose) + F(dlerror) #endif - #if !defined (SOLARIS) || defined(SOLARIS25) -F(getwd) -F(getcwd) + F(getwd) + F(getcwd) #endif -F(ttyname) - + F(ttyname) #ifdef irix -F(_getpty) + F(_getpty) #endif - #if ( defined(alpha) && defined(linux) ) -F(dlopen) -F(dlsym) -F(dlclose) -F(dlerror) -F(cfgetospeed) -F(cfsetospeed) -F(cfgetispeed) -F(cfsetispeed) -F(opendir) -F(closedir) -F(readdir) -F(sched_yield) -F(setpgid) -D(tzname) -D(errno) -F(open64) -F(creat64) -F(lseek64) -F(truncate64) -F(ftruncate64) -F(stat64) -F(fstat64) -F(lstat64) -F(readdir64) -F(statfs64) -F(lockf64) + F(dlopen) + F(dlsym) + F(dlclose) + F(dlerror) + F(cfgetospeed) + F(cfsetospeed) + F(cfgetispeed) + F(cfsetispeed) + F(opendir) + F(closedir) + F(readdir) + F(sched_yield) + F(setpgid) + D(tzname) + D(errno) + F(open64) + F(creat64) + F(lseek64) + F(truncate64) + F(ftruncate64) + F(stat64) + F(fstat64) + F(lstat64) + F(readdir64) + F(statfs64) + F(lockf64) #endif - #if defined(sparc) || defined(linux) -F(getpwnam_r) -F(getpwuid_r) -F(getgrnam_r) -F(getgrgid_r) + F(getpwnam_r) + F(getpwuid_r) + F(getgrnam_r) + F(getgrgid_r) #endif #if defined(__NetBSD__) || defined(DARWIN) -F(getpwnam) -F(getpwuid) -F(getgrnam) -F(getgrgid) -#endif - -F(setpwent) -F(getpwent) -F(endpwent) - + F(getpwnam) + F(getpwuid) + F(getgrnam) + F(getgrgid) +#endif + F(setpwent) + F(getpwent) + F(endpwent) #endif /* _UNDEFINEDS_H_ */ diff --git a/lisp/validate.c b/lisp/validate.c index 84766b278..581b1428f 100644 --- a/lisp/validate.c +++ b/lisp/validate.c @@ -1,5 +1,5 @@ /* - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/validate.c,v 1.22 2005/09/05 06:09:13 cshapiro Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/validate.c,v 1.23 2005/09/15 18:26:53 rtoy Exp $ * * Memory Validation */ @@ -28,13 +28,12 @@ extern void make_holes(void); #endif static void -ensure_space(lispobj *start, size_t size) +ensure_space(lispobj * start, size_t size) { if (os_validate((os_vm_address_t) start, size) == NULL) { fprintf(stderr, "ensure_space: Failed to validate %ld bytes at 0x%08lx\n", - (unsigned long) size, - (unsigned long) start); + (unsigned long) size, (unsigned long) start); exit(1); } } @@ -53,39 +52,41 @@ validate(void) void *dynamic_space_data = NULL; /* Note: XXX use alloca here because it's not malloc. I'm assuming - that anyone who wants to make this scheme work this will be using - GCC. FMG */ + that anyone who wants to make this scheme work this will be using + GCC. FMG */ if (builtin_image_flag != 0) - dynamic_space_data = alloca((int)(&image_dynamic_space_size)); + dynamic_space_data = alloca((int) (&image_dynamic_space_size)); /* Read-Only Space */ read_only_space = (lispobj *) READ_ONLY_SPACE_START; /* Don't try to map this space if the executable contains the image. */ if (builtin_image_flag == 0) - ensure_space(read_only_space, READ_ONLY_SPACE_SIZE); + ensure_space(read_only_space, READ_ONLY_SPACE_SIZE); /* Static Space */ static_space = (lispobj *) STATIC_SPACE_START; /* Don't try to map this space if the executable contains the image. */ if (builtin_image_flag == 0) - ensure_space(static_space, STATIC_SPACE_SIZE); + ensure_space(static_space, STATIC_SPACE_SIZE); /* Dynamic-0 Space */ dynamic_0_space = (lispobj *) DYNAMIC_0_SPACE_START; if (builtin_image_flag != 0) { - /* If the executable contains the lisp image, we want to copy the - data in the dynamic space out of its segment, then map the - dynamic space (which has the side effect of unmapping the - dynamic space segment in the executable), then copy the data - back into it. This is necessary to make the data in the - dynamic space segment available to the new lisp process. */ - memcpy(dynamic_space_data, dynamic_0_space, (int)&image_dynamic_space_size); - ensure_space(dynamic_0_space, dynamic_space_size); - memcpy(dynamic_0_space, dynamic_space_data, (int)&image_dynamic_space_size); + /* If the executable contains the lisp image, we want to copy the + data in the dynamic space out of its segment, then map the + dynamic space (which has the side effect of unmapping the + dynamic space segment in the executable), then copy the data + back into it. This is necessary to make the data in the + dynamic space segment available to the new lisp process. */ + memcpy(dynamic_space_data, dynamic_0_space, + (int) &image_dynamic_space_size); + ensure_space(dynamic_0_space, dynamic_space_size); + memcpy(dynamic_0_space, dynamic_space_data, + (int) &image_dynamic_space_size); } else - ensure_space(dynamic_0_space, dynamic_space_size); + ensure_space(dynamic_0_space, dynamic_space_size); current_dynamic_space = dynamic_0_space; @@ -98,8 +99,7 @@ validate(void) /* Control Stack */ control_stack = (lispobj *) CONTROL_STACK_START; #if (defined(i386) || defined(__x86_64)) - control_stack_end = (lispobj *) (CONTROL_STACK_START - + CONTROL_STACK_SIZE); + control_stack_end = (lispobj *) (CONTROL_STACK_START + CONTROL_STACK_SIZE); #endif ensure_space(control_stack, CONTROL_STACK_SIZE); @@ -111,7 +111,7 @@ validate(void) binding_stack = (lispobj *) BINDING_STACK_START; ensure_space(binding_stack, BINDING_STACK_SIZE); #ifdef LINKAGE_TABLE - ensure_space((lispobj *)FOREIGN_LINKAGE_SPACE_START, + ensure_space((lispobj *) FOREIGN_LINKAGE_SPACE_START, FOREIGN_LINKAGE_SPACE_SIZE); #endif #ifdef sparc @@ -123,6 +123,6 @@ validate(void) #endif #ifdef RED_ZONE_HIT - os_guard_control_stack (0, 1); + os_guard_control_stack(0, 1); #endif } diff --git a/lisp/vars.c b/lisp/vars.c index 2a8516a45..4d7ee287f 100644 --- a/lisp/vars.c +++ b/lisp/vars.c @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/vars.c,v 1.5 2005/09/05 06:09:13 cshapiro Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/vars.c,v 1.6 2005/09/15 18:26:53 rtoy Exp $ */ #include <stdio.h> #include <sys/types.h> #include <stdlib.h> @@ -16,34 +16,37 @@ static int tempcntr = 1; struct var { lispobj obj; - lispobj (*update_fn)(struct var *var); + lispobj(*update_fn) (struct var * var); char *name; long clock; boolean map_back, permanent; - struct var *nnext; /* Next in name list */ - struct var *onext; /* Next in object list */ + struct var *nnext; /* Next in name list */ + struct var *onext; /* Next in object list */ }; -static int hash_name(char *name) +static int +hash_name(char *name) { unsigned long value = 0; while (*name != '\0') { - value = (value << 1) ^ *(unsigned char *)(name++); - value = (value & (1-(1<<24))) ^ (value >> 24); + value = (value << 1) ^ *(unsigned char *) (name++); + value = (value & (1 - (1 << 24))) ^ (value >> 24); } return value % NAME_BUCKETS; } -static int hash_obj(lispobj obj) +static int +hash_obj(lispobj obj) { - return (unsigned long)obj % OBJ_BUCKETS; + return (unsigned long) obj % OBJ_BUCKETS; } -void flush_vars() +void +flush_vars() { int index; struct var *var, *next, *perm = NULL; @@ -51,86 +54,90 @@ void flush_vars() /* Note: all vars in the object hash table also appear in the name hash table, so if we free everything in the name hash table, we free everything in the object hash table. */ for (index = 0; index < NAME_BUCKETS; index++) - for (var = NameHash[index]; var != NULL; var = next) { - next = var->nnext; - if (var->permanent) { - var->nnext = perm; - perm = var; - } - else { - free(var->name); - free(var); - } - } + for (var = NameHash[index]; var != NULL; var = next) { + next = var->nnext; + if (var->permanent) { + var->nnext = perm; + perm = var; + } else { + free(var->name); + free(var); + } + } memset(NameHash, 0, sizeof(NameHash)); memset(ObjHash, 0, sizeof(ObjHash)); tempcntr = 1; for (var = perm; var != NULL; var = next) { - next = var->nnext; - index = hash_name(var->name); - var->nnext = NameHash[index]; - NameHash[index] = var; - if (var->map_back) { - index = hash_obj(var->obj); - var->onext = ObjHash[index]; - ObjHash[index] = var; - } + next = var->nnext; + index = hash_name(var->name); + var->nnext = NameHash[index]; + NameHash[index] = var; + if (var->map_back) { + index = hash_obj(var->obj); + var->onext = ObjHash[index]; + ObjHash[index] = var; + } } } -struct var *lookup_by_name(name) -char *name; +struct var * +lookup_by_name(name) + char *name; { struct var *var; for (var = NameHash[hash_name(name)]; var != NULL; var = var->nnext) - if (strcmp(var->name, name) == 0) - return var; + if (strcmp(var->name, name) == 0) + return var; return NULL; } -struct var *lookup_by_obj(obj) -lispobj obj; +struct var * +lookup_by_obj(obj) + lispobj obj; { struct var *var; for (var = ObjHash[hash_obj(obj)]; var != NULL; var = var->onext) - if (var->obj == obj) - return var; + if (var->obj == obj) + return var; return NULL; } -static struct var *make_var(char *name, boolean perm) +static struct var * +make_var(char *name, boolean perm) { struct var *var; char buffer[256]; int index; - var = (struct var *)malloc(sizeof(struct var)); + var = (struct var *) malloc(sizeof(struct var)); + if (var == NULL) { - perror("malloc"); - exit(1); + perror("malloc"); + exit(1); } - + if (name == NULL) { - sprintf(buffer, "%d", tempcntr++); - name = buffer; + sprintf(buffer, "%d", tempcntr++); + name = buffer; } - var->name = (char *)malloc(strlen(name)+1); + var->name = (char *) malloc(strlen(name) + 1); strcpy(var->name, name); var->clock = 0; var->permanent = perm; var->map_back = FALSE; - + index = hash_name(name); var->nnext = NameHash[index]; NameHash[index] = var; return var; -} +} -struct var *define_var(char *name, lispobj obj, boolean perm) +struct var * +define_var(char *name, lispobj obj, boolean perm) { struct var *var = make_var(name, perm); int index; @@ -139,17 +146,17 @@ struct var *define_var(char *name, lispobj obj, boolean perm) var->update_fn = NULL; if (lookup_by_obj(obj) == NULL) { - var->map_back = TRUE; - index = hash_obj(obj); - var->onext = ObjHash[index]; - ObjHash[index] = var; + var->map_back = TRUE; + index = hash_obj(obj); + var->onext = ObjHash[index]; + ObjHash[index] = var; } return var; } -struct var *define_dynamic_var(char *name, lispobj updatefn(struct var *), - boolean perm) +struct var * +define_dynamic_var(char *name, lispobj updatefn(struct var *), boolean perm) { struct var *var = make_var(name, perm); @@ -158,24 +165,28 @@ struct var *define_dynamic_var(char *name, lispobj updatefn(struct var *), return var; } -char *var_name(struct var *var) +char * +var_name(struct var *var) { return var->name; } -lispobj var_value(struct var *var) +lispobj +var_value(struct var * var) { if (var->update_fn != NULL) - var->obj = (*var->update_fn)(var); + var->obj = (*var->update_fn) (var); return var->obj; } -long var_clock(struct var *var) +long +var_clock(struct var *var) { return var->clock; } -void var_setclock(struct var *var, long val) +void +var_setclock(struct var *var, long val) { var->clock = val; } diff --git a/lisp/vars.h b/lisp/vars.h index 8c56bdaab..73898c402 100644 --- a/lisp/vars.h +++ b/lisp/vars.h @@ -1,4 +1,4 @@ -/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/vars.h,v 1.2 2005/01/13 19:55:01 fgilham Exp $ */ +/* $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/vars.h,v 1.3 2005/09/15 18:26:53 rtoy Rel $ */ #ifndef _VARS_H_ #define _VARS_H_ @@ -9,6 +9,7 @@ extern struct var *lookup_by_obj(lispobj obj); extern struct var *define_var(char *name, lispobj obj, boolean perm); extern struct var *define_dynamic_var(char *name, lispobj update_fn(struct var *var), + boolean perm); extern char *var_name(struct var *var); diff --git a/lisp/x86-arch.c b/lisp/x86-arch.c index 1f89b9bb8..c1bd01cc4 100644 --- a/lisp/x86-arch.c +++ b/lisp/x86-arch.c @@ -1,6 +1,6 @@ /* x86-arch.c -*- Mode: C; comment-column: 40 -*- * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-arch.c,v 1.23 2004/07/08 03:31:15 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-arch.c,v 1.24 2005/09/15 18:26:53 rtoy Exp $ * */ @@ -23,15 +23,16 @@ #define BREAKPOINT_INST 0xcc /* INT3 */ -unsigned long fast_random_state = 1; +unsigned long fast_random_state = 1; -char * arch_init(void) +char * +arch_init(void) { - return "lisp.core"; + return "lisp.core"; } - + /* * Assuming we get here via an INT3 xxx instruction, the PC now * points to the interrupt code (lisp value) so we just move past @@ -39,278 +40,289 @@ char * arch_init(void) * Cerror-trap then skip the data bytes that follow. */ -void arch_skip_instruction(os_context_t *context) +void +arch_skip_instruction(os_context_t * context) { - int vlen,code; - - DPRINTF(0,(stderr,"[arch_skip_inst at %lx>]\n", SC_PC(context))); - - /* Get and skip the lisp error code. */ - code = *(char*) SC_PC(context)++; - switch (code) - { - case trap_Error: - case trap_Cerror: - /* Lisp error arg vector length */ - vlen = *(char*) SC_PC(context)++; - /* Skip lisp error arg data bytes */ - while(vlen-- > 0) - ((char*) SC_PC(context))++; - break; - - case trap_Breakpoint: - case trap_FunctionEndBreakpoint: - break; - - case trap_PendingInterrupt: - case trap_Halt: - /* Only needed to skip the Code. */ - break; - - default: - fprintf(stderr, "[arch_skip_inst invalid code %d\n]\n", code); - break; + int vlen, code; + + DPRINTF(0, (stderr, "[arch_skip_inst at %lx>]\n", SC_PC(context))); + + /* Get and skip the lisp error code. */ + code = *(char *) SC_PC(context)++; + switch (code) { + case trap_Error: + case trap_Cerror: + /* Lisp error arg vector length */ + vlen = *(char *) SC_PC(context)++; + /* Skip lisp error arg data bytes */ + while (vlen-- > 0) + ((char *) SC_PC(context))++; + break; + + case trap_Breakpoint: + case trap_FunctionEndBreakpoint: + break; + + case trap_PendingInterrupt: + case trap_Halt: + /* Only needed to skip the Code. */ + break; + + default: + fprintf(stderr, "[arch_skip_inst invalid code %d\n]\n", code); + break; } - DPRINTF(0,(stderr,"[arch_skip_inst resuming at %lx>]\n", SC_PC(context))); + DPRINTF(0, (stderr, "[arch_skip_inst resuming at %lx>]\n", SC_PC(context))); } -unsigned char * arch_internal_error_arguments(os_context_t *context) +unsigned char * +arch_internal_error_arguments(os_context_t * context) { - return (unsigned char *) (SC_PC(context) + 1); + return (unsigned char *) (SC_PC(context) + 1); } -boolean arch_pseudo_atomic_atomic(os_context_t *context) +boolean +arch_pseudo_atomic_atomic(os_context_t * context) { - return SymbolValue(PSEUDO_ATOMIC_ATOMIC); + return SymbolValue(PSEUDO_ATOMIC_ATOMIC); } -void arch_set_pseudo_atomic_interrupted(os_context_t *context) +void +arch_set_pseudo_atomic_interrupted(os_context_t * context) { - SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1)); + SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(1)); } - -unsigned long arch_install_breakpoint(void *pc) + +unsigned long +arch_install_breakpoint(void *pc) { - unsigned long result = *(unsigned long*)pc; + unsigned long result = *(unsigned long *) pc; - *(char*)pc = BREAKPOINT_INST; /* x86 INT3 */ - *((char*)pc+1) = trap_Breakpoint; /* Lisp trap code */ - - return result; + *(char *) pc = BREAKPOINT_INST; /* x86 INT3 */ + *((char *) pc + 1) = trap_Breakpoint; /* Lisp trap code */ + + return result; } -void arch_remove_breakpoint(void *pc, unsigned long orig_inst) +void +arch_remove_breakpoint(void *pc, unsigned long orig_inst) { - *((char *) pc) = orig_inst & 0xff; - *((char *) pc + 1) = (orig_inst & 0xff00) >> 8; + *((char *) pc) = orig_inst & 0xff; + *((char *) pc + 1) = (orig_inst & 0xff00) >> 8; } - + /* * When single stepping single_stepping holds the original instruction * pc location. */ unsigned int *single_stepping = NULL; + #ifndef __linux__ -unsigned int single_step_save1; -unsigned int single_step_save2; -unsigned int single_step_save3; +unsigned int single_step_save1; +unsigned int single_step_save2; +unsigned int single_step_save3; #endif -void arch_do_displaced_inst(os_context_t *context, - unsigned long orig_inst) +void +arch_do_displaced_inst(os_context_t * context, unsigned long orig_inst) { - unsigned int *pc = (unsigned int*) SC_PC(context); + unsigned int *pc = (unsigned int *) SC_PC(context); - /* - * Put the original instruction back. - */ + /* + * Put the original instruction back. + */ - *((char *) pc) = orig_inst & 0xff; - *((char *) pc + 1) = (orig_inst & 0xff00) >> 8; + *((char *) pc) = orig_inst & 0xff; + *((char *) pc + 1) = (orig_inst & 0xff00) >> 8; #ifdef __linux__ - context->eflags |= 0x100; + context->eflags |= 0x100; #else - /* - * Install helper instructions for the single step: - * pushf; or [esp],0x100; popf. - */ - - single_step_save1 = *(pc - 3); - single_step_save2 = *(pc - 2); - single_step_save3 = *(pc - 1); - *(pc - 3) = 0x9c909090; - *(pc - 2) = 0x00240c81; - *(pc - 1) = 0x9d000001; + /* + * Install helper instructions for the single step: + * pushf; or [esp],0x100; popf. + */ + + single_step_save1 = *(pc - 3); + single_step_save2 = *(pc - 2); + single_step_save3 = *(pc - 1); + *(pc - 3) = 0x9c909090; + *(pc - 2) = 0x00240c81; + *(pc - 1) = 0x9d000001; #endif - single_stepping = (unsigned int*) pc; + single_stepping = (unsigned int *) pc; #ifndef __linux__ - (unsigned int*) SC_PC(context) = (char *) pc - 9; + (unsigned int *) SC_PC(context) = (char *) pc - 9; #endif } -void sigtrap_handler(HANDLER_ARGS) +void +sigtrap_handler(HANDLER_ARGS) { - unsigned int trap; - + unsigned int trap; + #ifdef __linux__ - GET_CONTEXT + GET_CONTEXT #endif - #if 0 - fprintf(stderr,"x86sigtrap: %8x %x\n", - SC_PC(context), *(unsigned char *)(SC_PC(context)-1)); - fprintf(stderr,"sigtrap(%d %d %x)\n",signal,code,context); + fprintf(stderr, "x86sigtrap: %8x %x\n", + SC_PC(context), *(unsigned char *) (SC_PC(context) - 1)); + fprintf(stderr, "sigtrap(%d %d %x)\n", signal, code, context); #endif - if (single_stepping && (signal == SIGTRAP)) - { + if (single_stepping && (signal == SIGTRAP)) { #if 0 - fprintf(stderr,"* Single step trap %x\n", single_stepping); + fprintf(stderr, "* Single step trap %x\n", single_stepping); #endif #ifndef __linux__ - /* Un-install single step helper instructions. */ - *(single_stepping-3) = single_step_save1; - *(single_stepping-2) = single_step_save2; - *(single_stepping-1) = single_step_save3; -#else - context->eflags ^= 0x100; + /* Un-install single step helper instructions. */ + *(single_stepping - 3) = single_step_save1; + *(single_stepping - 2) = single_step_save2; + *(single_stepping - 1) = single_step_save3; +#else + context->eflags ^= 0x100; #endif - /* - * Re-install the breakpoint if possible. - */ - if ((int) SC_PC(context) == (int) single_stepping + 1) - fprintf(stderr, "* Breakpoint not re-install\n"); - else - { - char *ptr = (char *) single_stepping; - ptr[0] = BREAKPOINT_INST; /* x86 INT3 */ - ptr[1] = trap_Breakpoint; + /* + * Re-install the breakpoint if possible. + */ + if ((int) SC_PC(context) == (int) single_stepping + 1) + fprintf(stderr, "* Breakpoint not re-install\n"); + else { + char *ptr = (char *) single_stepping; + + ptr[0] = BREAKPOINT_INST; /* x86 INT3 */ + ptr[1] = trap_Breakpoint; } - single_stepping = NULL; - return; + single_stepping = NULL; + return; } - SAVE_CONTEXT(); + SAVE_CONTEXT(); - /* This is just for info in case monitor wants to print an approx */ - current_control_stack_pointer = (unsigned long*) SC_SP(context); + /* This is just for info in case monitor wants to print an approx */ + current_control_stack_pointer = (unsigned long *) SC_SP(context); #if defined(__linux__) && defined(i386) - /* - * Restore the FPU control word, setting the rounding mode to nearest. - */ + /* + * Restore the FPU control word, setting the rounding mode to nearest. + */ - if (contextstruct.fpstate) - setfpucw(contextstruct.fpstate->cw & ~0xc00); + if (contextstruct.fpstate) + setfpucw(contextstruct.fpstate->cw & ~0xc00); #endif - /* - * On entry %eip points just after the INT3 byte and aims at the - * 'kind' value (eg trap_Cerror). For error-trap and Cerror-trap a - * number of bytes will follow, the first is the length of the byte - * arguments to follow. - */ - - trap = *(unsigned char *) SC_PC(context); - - switch (trap) - { - case trap_PendingInterrupt: - DPRINTF(0,(stderr,"<trap Pending Interrupt.>\n")); - arch_skip_instruction(context); - interrupt_handle_pending(context); - break; - - case trap_Halt: - { + /* + * On entry %eip points just after the INT3 byte and aims at the + * 'kind' value (eg trap_Cerror). For error-trap and Cerror-trap a + * number of bytes will follow, the first is the length of the byte + * arguments to follow. + */ + + trap = *(unsigned char *) SC_PC(context); + + switch (trap) { + case trap_PendingInterrupt: + DPRINTF(0, (stderr, "<trap Pending Interrupt.>\n")); + arch_skip_instruction(context); + interrupt_handle_pending(context); + break; + + case trap_Halt: + { #if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) - int fpu_state[27]; - fpu_save(fpu_state); + int fpu_state[27]; + + fpu_save(fpu_state); #endif - fake_foreign_function_call(context); - lose("%%primitive halt called; the party is over.\n"); - undo_fake_foreign_function_call(context); + fake_foreign_function_call(context); + lose("%%primitive halt called; the party is over.\n"); + undo_fake_foreign_function_call(context); #if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__) - fpu_restore(fpu_state); + fpu_restore(fpu_state); #endif - arch_skip_instruction(context); - break; - } - - case trap_Error: - case trap_Cerror: - DPRINTF(0, (stderr, "<trap Error %d>\n",code)); + arch_skip_instruction(context); + break; + } + + case trap_Error: + case trap_Cerror: + DPRINTF(0, (stderr, "<trap Error %d>\n", code)); #ifdef __linux__ - interrupt_internal_error(signal, contextstruct, code == trap_Cerror); + interrupt_internal_error(signal, contextstruct, code == trap_Cerror); #else - interrupt_internal_error(signal, code, context, code == trap_Cerror); + interrupt_internal_error(signal, code, context, code == trap_Cerror); #endif - break; + break; - case trap_Breakpoint: + case trap_Breakpoint: #if 0 - fprintf(stderr,"*C break\n"); + fprintf(stderr, "*C break\n"); #endif - (char*) SC_PC(context) -= 1; + (char *) SC_PC(context) -= 1; - handle_breakpoint(signal, code, context); + handle_breakpoint(signal, code, context); #if 0 - fprintf(stderr,"*C break return\n"); + fprintf(stderr, "*C break return\n"); #endif - break; - - case trap_FunctionEndBreakpoint: - (char*) SC_PC(context) -= 1; - SC_PC(context) = (int) handle_function_end_breakpoint(signal, code, context); - break; - + break; + + case trap_FunctionEndBreakpoint: + (char *) SC_PC(context) -= 1; + SC_PC(context) = + (int) handle_function_end_breakpoint(signal, code, context); + break; + #ifdef trap_DynamicSpaceOverflowWarning - case trap_DynamicSpaceOverflowWarning: - interrupt_handle_space_overflow(SymbolFunction(DYNAMIC_SPACE_OVERFLOW_WARNING_HIT), - context); - break; + case trap_DynamicSpaceOverflowWarning: + interrupt_handle_space_overflow(SymbolFunction + (DYNAMIC_SPACE_OVERFLOW_WARNING_HIT), + context); + break; #endif #ifdef trap_DynamicSpaceOverflowError - case trap_DynamicSpaceOverflowError: - interrupt_handle_space_overflow(SymbolFunction(DYNAMIC_SPACE_OVERFLOW_ERROR_HIT), - context); - break; + case trap_DynamicSpaceOverflowError: + interrupt_handle_space_overflow(SymbolFunction + (DYNAMIC_SPACE_OVERFLOW_ERROR_HIT), + context); + break; #endif - default: - DPRINTF(0,(stderr,"[C--trap default %d %d %p]\n", signal, code,context)); + default: + DPRINTF(0, + (stderr, "[C--trap default %d %d %p]\n", signal, code, + context)); #ifdef __linux__ - interrupt_handle_now(signal, contextstruct); + interrupt_handle_now(signal, contextstruct); #else - interrupt_handle_now(signal, code, context); + interrupt_handle_now(signal, code, context); #endif - break; + break; } } #define FIXNUM_VALUE(lispobj) (((int) lispobj) >> 2) -void arch_install_interrupt_handlers() +void +arch_install_interrupt_handlers() { interrupt_install_low_level_handler(SIGILL, sigtrap_handler); interrupt_install_low_level_handler(SIGTRAP, sigtrap_handler); } -extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs); +extern lispobj call_into_lisp(lispobj fun, lispobj * args, int nargs); /* These next four functions are an interface to the * Lisp call-in facility. Since this is C we can know @@ -324,31 +336,38 @@ extern lispobj call_into_lisp(lispobj fun, lispobj *args, int nargs); * call-in function figure it out. */ -lispobj funcall0(lispobj function) +lispobj +funcall0(lispobj function) { lispobj *args = NULL; return call_into_lisp(function, args, 0); } -lispobj funcall1(lispobj function, lispobj arg0) +lispobj +funcall1(lispobj function, lispobj arg0) { lispobj args[1]; + args[0] = arg0; return call_into_lisp(function, args, 1); } -lispobj funcall2(lispobj function, lispobj arg0, lispobj arg1) +lispobj +funcall2(lispobj function, lispobj arg0, lispobj arg1) { lispobj args[2]; + args[0] = arg0; args[1] = arg1; return call_into_lisp(function, args, 2); } -lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) +lispobj +funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) { lispobj args[3]; + args[0] = arg0; args[1] = arg1; args[2] = arg2; @@ -361,18 +380,20 @@ lispobj funcall3(lispobj function, lispobj arg0, lispobj arg1, lispobj arg2) #define LinkageEntrySize 8 #endif -void arch_make_linkage_entry(long linkage_entry, void *target_addr, long type) +void +arch_make_linkage_entry(long linkage_entry, void *target_addr, long type) { - char *reloc_addr = (char *)(FOREIGN_LINKAGE_SPACE_START - + linkage_entry * LinkageEntrySize); + char *reloc_addr = (char *) (FOREIGN_LINKAGE_SPACE_START - if (type == 1) { /* code reference */ - /* Make JMP to function entry. */ + + linkage_entry * LinkageEntrySize); + + if (type == 1) { /* code reference */ + /* Make JMP to function entry. */ /* JMP offset is calculated from next instruction. */ - long offset = (char *)target_addr - (reloc_addr + 5); + long offset = (char *) target_addr - (reloc_addr + 5); int i; - - *reloc_addr++ = 0xe9; /* opcode for JMP rel32 */ + + *reloc_addr++ = 0xe9; /* opcode for JMP rel32 */ for (i = 0; i < 4; i++) { *reloc_addr++ = offset & 0xff; offset >>= 8; @@ -380,20 +401,22 @@ void arch_make_linkage_entry(long linkage_entry, void *target_addr, long type) /* write a nop for good measure. */ *reloc_addr = 0x90; } else if (type == 2) { - *(unsigned long *)reloc_addr = (unsigned long)target_addr; + *(unsigned long *) reloc_addr = (unsigned long) target_addr; } } /* Make a call to the first function in the linkage table, which is resolve_linkage_tramp. */ -void arch_make_lazy_linkage(long linkage_entry) +void +arch_make_lazy_linkage(long linkage_entry) { - char *reloc_addr = (char *)(FOREIGN_LINKAGE_SPACE_START - + linkage_entry * LinkageEntrySize); - long offset = (char *)(FOREIGN_LINKAGE_SPACE_START) - (reloc_addr + 5); + char *reloc_addr = (char *) (FOREIGN_LINKAGE_SPACE_START + + + linkage_entry * LinkageEntrySize); + long offset = (char *) (FOREIGN_LINKAGE_SPACE_START) - (reloc_addr + 5); int i; - *reloc_addr++ = 0xe8; /* opcode for CALL rel32 */ + *reloc_addr++ = 0xe8; /* opcode for CALL rel32 */ for (i = 0; i < 4; i++) { *reloc_addr++ = offset & 0xff; offset >>= 8; @@ -406,7 +429,8 @@ void arch_make_lazy_linkage(long linkage_entry) entry is a CALL; the return address we're passed points to the next instruction. */ -long arch_linkage_entry(unsigned long retaddr) +long +arch_linkage_entry(unsigned long retaddr) { return ((retaddr - 5) - FOREIGN_LINKAGE_SPACE_START) / LinkageEntrySize; } diff --git a/lisp/x86-validate.h b/lisp/x86-validate.h index 1d77b1757..44c05d645 100644 --- a/lisp/x86-validate.h +++ b/lisp/x86-validate.h @@ -3,7 +3,7 @@ * This code was written as part of the CMU Common Lisp project at * Carnegie Mellon University, and has been placed in the public domain. * - * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-validate.h,v 1.24 2005/03/18 17:56:56 rtoy Exp $ + * $Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/lisp/x86-validate.h,v 1.25 2005/09/15 18:26:53 rtoy Exp $ * */ @@ -67,113 +67,113 @@ #ifdef __FreeBSD__ #define READ_ONLY_SPACE_START (0x10000000) -#define READ_ONLY_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */ +#define READ_ONLY_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */ #define STATIC_SPACE_START (0x28f00000) -#define STATIC_SPACE_SIZE (0x0f0ff000) /* 241MB - 1 page */ +#define STATIC_SPACE_SIZE (0x0f0ff000) /* 241MB - 1 page */ #define BINDING_STACK_START (0x38000000) -#define BINDING_STACK_SIZE (0x07fff000) /* 128MB - 1 page */ +#define BINDING_STACK_SIZE (0x07fff000) /* 128MB - 1 page */ #define CONTROL_STACK_START 0x40000000 -#define CONTROL_STACK_SIZE 0x07fd8000 /* 128MB - SIGSTKSZ */ +#define CONTROL_STACK_SIZE 0x07fd8000 /* 128MB - SIGSTKSZ */ #define SIGNAL_STACK_START 0x47fd8000 #define SIGNAL_STACK_SIZE SIGSTKSZ #define DYNAMIC_0_SPACE_START (0x48000000) #ifdef GENCGC -#define DYNAMIC_SPACE_SIZE (0x40000000) /* May be up to 2GB */ +#define DYNAMIC_SPACE_SIZE (0x40000000) /* May be up to 2GB */ #else -#define DYNAMIC_SPACE_SIZE (0x04000000) /* 64MB */ +#define DYNAMIC_SPACE_SIZE (0x04000000) /* 64MB */ #endif -#define DEFAULT_DYNAMIC_SPACE_SIZE (0x20000000) /* 512MB */ +#define DEFAULT_DYNAMIC_SPACE_SIZE (0x20000000) /* 512MB */ #ifdef LINKAGE_TABLE -#define FOREIGN_LINKAGE_SPACE_START ((unsigned long) LinkageSpaceStart) -#define FOREIGN_LINKAGE_SPACE_SIZE (0x100000) /* 1MB */ +#define FOREIGN_LINKAGE_SPACE_START ((unsigned long) LinkageSpaceStart) +#define FOREIGN_LINKAGE_SPACE_SIZE (0x100000) /* 1MB */ #endif #endif /* __FreeBSD__ */ #ifdef __OpenBSD__ #define READ_ONLY_SPACE_START (0x10000000) -#define READ_ONLY_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */ +#define READ_ONLY_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */ #define STATIC_SPACE_START (0x28000000) -#define STATIC_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */ +#define STATIC_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */ #define BINDING_STACK_START (0x38000000) -#define BINDING_STACK_SIZE (0x07fff000) /* 128MB - 1 page */ +#define BINDING_STACK_SIZE (0x07fff000) /* 128MB - 1 page */ #define CONTROL_STACK_START (0x40000000) -#define CONTROL_STACK_SIZE (0x07fd8000) /* 128MB - SIGSTKSZ */ +#define CONTROL_STACK_SIZE (0x07fd8000) /* 128MB - SIGSTKSZ */ #define SIGNAL_STACK_START (0x47fd8000) #define SIGNAL_STACK_SIZE SIGSTKSZ #define DYNAMIC_0_SPACE_START (0x48000000) #ifdef GENCGC -#define DYNAMIC_SPACE_SIZE (0x68000000) /* 1.625GB */ +#define DYNAMIC_SPACE_SIZE (0x68000000) /* 1.625GB */ #else -#define DYNAMIC_SPACE_SIZE (0x04000000) /* 64MB */ +#define DYNAMIC_SPACE_SIZE (0x04000000) /* 64MB */ #endif -#define DEFAULT_DYNAMIC_SPACE_SIZE (0x20000000) /* 512MB */ +#define DEFAULT_DYNAMIC_SPACE_SIZE (0x20000000) /* 512MB */ #endif #ifdef __NetBSD__ #define READ_ONLY_SPACE_START (0x10000000) -#define READ_ONLY_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */ +#define READ_ONLY_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */ #define STATIC_SPACE_START (0x28000000) -#define STATIC_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */ +#define STATIC_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */ #define BINDING_STACK_START (0x38000000) -#define BINDING_STACK_SIZE (0x07fff000) /* 128MB - 1 page */ +#define BINDING_STACK_SIZE (0x07fff000) /* 128MB - 1 page */ #define CONTROL_STACK_START (0x40000000) -#define CONTROL_STACK_SIZE (0x07fd8000) /* 128MB - SIGSTKSZ */ +#define CONTROL_STACK_SIZE (0x07fd8000) /* 128MB - SIGSTKSZ */ #define SIGNAL_STACK_START (0x47fd8000) #define SIGNAL_STACK_SIZE SIGSTKSZ #define DYNAMIC_0_SPACE_START (0x48800000) #ifdef GENCGC -#define DYNAMIC_SPACE_SIZE (0x67800000) /* 1.656GB */ +#define DYNAMIC_SPACE_SIZE (0x67800000) /* 1.656GB */ #else -#define DYNAMIC_SPACE_SIZE (0x04000000) /* 64MB */ +#define DYNAMIC_SPACE_SIZE (0x04000000) /* 64MB */ #endif -#define DEFAULT_DYNAMIC_SPACE_SIZE (0x20000000) /* 512MB */ +#define DEFAULT_DYNAMIC_SPACE_SIZE (0x20000000) /* 512MB */ #ifdef LINKAGE_TABLE #define FOREIGN_LINKAGE_SPACE_START (0xb0000000) -#define FOREIGN_LINKAGE_SPACE_SIZE (0x100000) /* 1MB */ +#define FOREIGN_LINKAGE_SPACE_SIZE (0x100000) /* 1MB */ #endif #endif #ifdef __linux__ #define READ_ONLY_SPACE_START (SpaceStart_TargetReadOnly) -#define READ_ONLY_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */ +#define READ_ONLY_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */ #define STATIC_SPACE_START (SpaceStart_TargetStatic) -#define STATIC_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */ +#define STATIC_SPACE_SIZE (0x0ffff000) /* 256MB - 1 page */ #define BINDING_STACK_START (0x20000000) -#define BINDING_STACK_SIZE (0x07fff000) /* 128MB - 1 page */ +#define BINDING_STACK_SIZE (0x07fff000) /* 128MB - 1 page */ #define CONTROL_STACK_START 0x38000000 -#define CONTROL_STACK_SIZE (0x07fff000 - 8192) +#define CONTROL_STACK_SIZE (0x07fff000 - 8192) #define SIGNAL_STACK_START CONTROL_STACK_END #define SIGNAL_STACK_SIZE 8192 #define DYNAMIC_0_SPACE_START (SpaceStart_TargetDynamic) #ifdef GENCGC -#define DYNAMIC_SPACE_SIZE (0x66000000) /* 1.632GB */ +#define DYNAMIC_SPACE_SIZE (0x66000000) /* 1.632GB */ #else -#define DYNAMIC_SPACE_SIZE (0x04000000) /* 64MB */ +#define DYNAMIC_SPACE_SIZE (0x04000000) /* 64MB */ #endif -#define DEFAULT_DYNAMIC_SPACE_SIZE (0x20000000) /* 512MB */ +#define DEFAULT_DYNAMIC_SPACE_SIZE (0x20000000) /* 512MB */ #ifdef LINKAGE_TABLE -#define FOREIGN_LINKAGE_SPACE_START (LinkageSpaceStart) -#define FOREIGN_LINKAGE_SPACE_SIZE (0x100000) /* 1MB */ +#define FOREIGN_LINKAGE_SPACE_START (LinkageSpaceStart) +#define FOREIGN_LINKAGE_SPACE_SIZE (0x100000) /* 1MB */ #endif #endif -- GitLab