X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fruntime%2Fgc.c;h=482cf653b4d6b2b5a6aee9c44f5881b3c0f105b5;hb=1e4629723d19f96d752235ffde34fe58431431ae;hp=0cb2f37a1a6440fc940d6b72c7db9dc5b8170074;hpb=aa2dc9529460ea0d9c99998dc87283fc1a43e808;p=sbcl.git diff --git a/src/runtime/gc.c b/src/runtime/gc.c index 0cb2f37..482cf65 100644 --- a/src/runtime/gc.c +++ b/src/runtime/gc.c @@ -28,8 +28,8 @@ #include "interr.h" /* So you need to debug? */ -#if 0 #define PRINTNOISE +#if 0 #define DEBUG_SPACE_PREDICATES #define DEBUG_SCAVENGE_VERBOSE #define DEBUG_COPY_VERBOSE @@ -79,9 +79,9 @@ from_space_p(lispobj object) /* this can be called for untagged pointers as well as for descriptors, so this assertion's not applicable - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); */ - ptr = (lispobj *) PTR(object); + ptr = (lispobj *) native_pointer(object); return ((from_space <= ptr) && (ptr < from_space_free_pointer)); @@ -92,9 +92,9 @@ new_space_p(lispobj object) { lispobj *ptr; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - ptr = (lispobj *) PTR(object); + ptr = (lispobj *) native_pointer(object); return ((new_space <= ptr) && (ptr < new_space_free_pointer)); @@ -122,19 +122,19 @@ copy_object(lispobj object, int nwords) lispobj *new; lispobj *source, *dest; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); gc_assert(from_space_p(object)); gc_assert((nwords & 0x01) == 0); /* get tag of object */ - tag = LowtagOf(object); + tag = lowtag_of(object); /* allocate space */ new = new_space_free_pointer; new_space_free_pointer += nwords; dest = new; - source = (lispobj *) PTR(object); + source = (lispobj *) native_pointer(object); #ifdef DEBUG_COPY_VERBOSE fprintf(stderr,"Copying %d words from %p to %p\n", nwords,source,new); @@ -230,11 +230,7 @@ struct timeval start_tv, stop_tv; /* Set up from space and new space pointers. */ from_space = current_dynamic_space; -#ifndef ibmrt from_space_free_pointer = dynamic_space_free_pointer; -#else - from_space_free_pointer = (lispobj *)SymbolValue(ALLOCATION_POINTER); -#endif #ifdef PRINTNOISE fprintf(stderr,"from_space = %lx\n", @@ -248,7 +244,23 @@ struct timeval start_tv, stop_tv; lose("GC lossage. Current dynamic space is bogus!\n"); } new_space_free_pointer = new_space; - +#if 0 + /* at one time we had the bright idea of using mprotect() to + * hide the semispace that we're not using at the moment, so + * we'd see immediately if anyone had a pointer to it. + * Unfortunately, if we gc during a call to an assembler + * routine with a "raw" return style, at least on PPC we are + * expected to return into oldspace because we can't easily + * update the link register - it's not tagged, and we can't do + * it as an offset of reg_CODE because the calling routine + * might be nowhere near our code vector. We hope that we + * don't run very far in oldspace before it catapults us into + * newspace by either calling something else or returning + */ + + /* write-enable */ + os_protect(new_space,DYNAMIC_SPACE_SIZE,OS_VM_PROT_ALL); +#endif /* Initialize the weak pointer list. */ weak_pointers = (struct weak_pointer *) NULL; @@ -279,14 +291,9 @@ struct timeval start_tv, stop_tv; scavenge(((lispobj *)CONTROL_STACK_START), control_stack_size); -#ifdef ibmrt - binding_stack_size = - (lispobj *)SymbolValue(BINDING_STACK_POINTER) - binding_stack; -#else binding_stack_size = current_binding_stack_pointer - (lispobj *)BINDING_STACK_START; -#endif #ifdef PRINTNOISE printf("Scavenging the binding stack %x - %x (%d words) ...\n", BINDING_STACK_START,current_binding_stack_pointer, @@ -331,11 +338,7 @@ struct timeval start_tv, stop_tv; (os_vm_size_t) DYNAMIC_SPACE_SIZE); current_dynamic_space = new_space; -#ifndef ibmrt dynamic_space_free_pointer = new_space_free_pointer; -#else - SetSymbolValue(ALLOCATION_POINTER, (lispobj)new_space_free_pointer); -#endif #ifdef PRINTNOISE size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj); @@ -378,16 +381,26 @@ struct timeval start_tv, stop_tv; #endif gc_rate = ((float) size_retained / (float) (1<<20)) / real_time; - + printf("%10.2f M bytes/sec collected.\n", gc_rate); #endif + /* os_flush_icache((os_vm_address_t) 0, sizeof(unsigned long)); */ + +#if 0 + /* see comment above about mprotecting oldspace */ + + /* zero the from space now, to make it easier to find stale + pointers to it */ + + /* pray that both dynamic spaces are the same size ... */ + memset(from_space,(DYNAMIC_0_SPACE_END-DYNAMIC_0_SPACE_START-1),0); + os_protect(from_space,DYNAMIC_SPACE_SIZE,0); /* write-protect */ +#endif } /* scavenging */ -#define DIRECT_SCAV 0 - static void scavenge(lispobj *start, u32 nwords) { @@ -396,25 +409,23 @@ scavenge(lispobj *start, u32 nwords) int type, words_scavenged; object = *start; - type = TypeOf(object); + type = widetag_of(object); #if defined(DEBUG_SCAVENGE_VERBOSE) fprintf(stderr,"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); -#else - if (Pointerp(object)) { + if (is_lisp_pointer(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)) { + first_word = *((lispobj *)native_pointer(object)); + if (is_lisp_pointer(first_word) && + new_space_p(first_word)) { /* Yep, there be a forwarding pointer. */ *start = first_word; words_scavenged = 1; @@ -430,7 +441,7 @@ scavenge(lispobj *start, u32 nwords) words_scavenged = 1; } } - else if(nwords==1) { + else if (nwords==1) { /* there are some situations where an other-immediate may end up in a descriptor register. I'm not sure whether this is @@ -441,7 +452,7 @@ scavenge(lispobj *start, u32 nwords) other than a pointer, just hush it up */ words_scavenged=1; - if((scavtab[type]==scav_lose) || + if ((scavtab[type]==scav_lose) || (((scavtab[type])(start,object))>1)) { fprintf(stderr,"warning: attempted to scavenge non-descriptor value %x at %p. If you can\nreproduce this warning, send a test case to sbcl-devel@lists.sourceforge.net\n", object,start); @@ -456,7 +467,7 @@ scavenge(lispobj *start, u32 nwords) words_scavenged = (scavtab[type])(start, object); } -#endif + start += words_scavenged; nwords -= words_scavenged; } @@ -493,10 +504,15 @@ scavenge_interrupt_context(os_context_t *context) int lip_register_pair; #endif unsigned long pc_code_offset; -#ifdef SC_NPC +#ifdef ARCH_HAS_LINK_REGISTER + unsigned long lr_code_offset; +#endif +#ifdef ARCH_HAS_NPC_REGISTER unsigned long npc_code_offset; #endif - +#ifdef DEBUG_SCAVENGE_VERBOSE + fprintf(stderr, "Scavenging interrupt context at 0x%x\n",context); +#endif /* Find the LIP's register pair and calculate its offset */ /* before we scavenge the context. */ #ifdef reg_LIP @@ -512,7 +528,7 @@ scavenge_interrupt_context(os_context_t *context) index = boxed_registers[i]; reg = *os_context_register_addr(context, index); /* would be using PTR if not for integer length issues */ - if ((reg & ~((1L<header; - if (Pointerp(first) && new_space_p(first)) { + /* if object has already been transported, just return pointer */ + first = code->header; + if (is_lisp_pointer(first) && new_space_p(first)) { #ifdef DEBUG_CODE_GC - printf("Was already transported\n"); + printf("Was already transported\n"); #endif - return (struct code *) PTR(first); - } + return (struct code *) native_pointer(first); + } - gc_assert(TypeOf(first) == type_CodeHeader); + gc_assert(widetag_of(first) == CODE_HEADER_WIDETAG); - /* prepare to transport the code vector */ - l_code = (lispobj) LOW_WORD(code) | type_OtherPointer; + /* prepare to transport the code vector */ + l_code = (lispobj) LOW_WORD(code) | OTHER_POINTER_LOWTAG; - 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 *) native_pointer(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 pointer */ + code->header = 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 simple_fun *fheaderp, *nfheaderp; + lispobj nfheaderl; - fheaderp = (struct function *) PTR(fheaderl); - gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader); + fheaderp = (struct simple_fun *) native_pointer(fheaderl); + gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG); - /* calcuate the new function pointer and the new */ - /* function header */ - nfheaderl = fheaderl + displacement; - nfheaderp = (struct function *) PTR(nfheaderl); + /* Calculate the new function pointer and the new */ + /* function header. */ + nfheaderl = fheaderl + displacement; + nfheaderp = (struct simple_fun *) native_pointer(nfheaderl); - /* set forwarding pointer */ + /* set forwarding pointer */ #ifdef DEBUG_CODE_GC - printf("fheaderp->header (at %x) <- %x\n", - &(fheaderp->header) , nfheaderl); + printf("fheaderp->header (at %x) <- %x\n", + &(fheaderp->header) , nfheaderl); #endif - fheaderp->header = nfheaderl; + fheaderp->header = nfheaderl; - /* fix self pointer */ - nfheaderp->self = nfheaderl; + /* fix self pointer */ + nfheaderp->self = nfheaderl; - *prev_pointer = nfheaderl; + *prev_pointer = nfheaderl; - fheaderl = fheaderp->next; - prev_pointer = &nfheaderp->next; - } + 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) { - 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 simple_fun *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 simple_fun *) native_pointer(fheaderl); + gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG); #if defined(DEBUG_CODE_GC) - printf("Scavenging boxed section of entry point located at 0x%08x.\n", - (unsigned long) PTR(fheaderl)); + printf("Scavenging boxed section of entry point located at 0x%08x.\n", + (unsigned long) native_pointer(fheaderl)); #endif - 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) { - struct code *ncode; + struct code *ncode; - ncode = trans_code((struct code *) PTR(object)); - return (lispobj) LOW_WORD(ncode) | type_OtherPointer; + ncode = trans_code((struct code *) native_pointer(object)); + return (lispobj) LOW_WORD(ncode) | OTHER_POINTER_LOWTAG; } 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; } @@ -898,27 +891,27 @@ 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; - lispobj ret; - return_pc = (struct function *) PTR(object); - offset = HeaderValue(return_pc->header) * 4 ; + struct simple_fun *return_pc; + unsigned long offset; + struct code *code, *ncode; + lispobj ret; + return_pc = (struct simple_fun *) native_pointer(object); + offset = HeaderValue(return_pc->header) * 4 ; - /* Transport the whole code object */ - code = (struct code *) ((unsigned long) return_pc - offset); + /* Transport the whole code object */ + code = (struct code *) ((unsigned long) return_pc - offset); #ifdef DEBUG_CODE_GC - printf("trans_return_pc_header object=%x, code=%lx\n",object,code); + printf("trans_return_pc_header object=%x, code=%lx\n",object,code); #endif - ncode = trans_code(code); - if(object==0x304748d7) { - /* ldb_monitor(); */ - } - ret= ((lispobj) LOW_WORD(ncode) + offset) | type_OtherPointer; + ncode = trans_code(code); + if (object==0x304748d7) { + /* monitor_or_something(); */ + } + ret= ((lispobj) LOW_WORD(ncode) + offset) | OTHER_POINTER_LOWTAG; #ifdef DEBUG_CODE_GC - printf("trans_return_pc_header returning %x\n",ret); + printf("trans_return_pc_header returning %x\n",ret); #endif - return ret; + return ret; } /* On the 386, closures hold a pointer to the raw address instead of @@ -931,19 +924,19 @@ static scav_closure_header(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->fun - FUN_RAW_ADDR_OFFSET; + scavenge(&fun, 1); - return 2; + return 2; } #endif static int -scav_function_header(lispobj *where, lispobj object) +scav_fun_header(lispobj *where, lispobj object) { fprintf(stderr, "GC lossage. Should not be scavenging a "); fprintf(stderr, "Function Header.\n"); @@ -954,206 +947,133 @@ scav_function_header(lispobj *where, lispobj object) } static lispobj -trans_function_header(lispobj object) +trans_fun_header(lispobj object) { - struct function *fheader; - unsigned long offset; - struct code *code, *ncode; + struct simple_fun *fheader; + unsigned long offset; + struct code *code, *ncode; - fheader = (struct function *) PTR(object); - offset = HeaderValue(fheader->header) * 4; + fheader = (struct simple_fun *) native_pointer(object); + offset = HeaderValue(fheader->header) * 4; - /* 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) LOW_WORD(ncode) + offset) | type_FunctionPointer; + return ((lispobj) LOW_WORD(ncode) + offset) | FUN_POINTER_LOWTAG; } /* instances */ -#if DIRECT_SCAV static int scav_instance_pointer(lispobj *where, lispobj 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))) - first = *first_pointer = trans_boxed(object); - *where = first; - } - return 1; -} -#else -static int -scav_instance_pointer(lispobj *where, lispobj object) -{ - lispobj *first_pointer; + lispobj *first_pointer; - /* 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 *) native_pointer(object); - *where = *first_pointer = trans_boxed(object); - return 1; + *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) { - gc_assert(Pointerp(object)); + lispobj first, *first_pointer; - if (from_space_p(object)) { - lispobj first, *first_pointer; + gc_assert(is_lisp_pointer(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 (!(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; -} -#else -static int -scav_list_pointer(lispobj *where, lispobj object) -{ - lispobj first, *first_pointer; - - 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 *) native_pointer(object); - first = *first_pointer = trans_list(object); + first = *first_pointer = trans_list(object); - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); + gc_assert(is_lisp_pointer(first)); + gc_assert(!from_space_p(first)); - *where = first; - return 1; + *where = first; + return 1; } -#endif static lispobj trans_list(lispobj object) { - lispobj new_list_pointer; - struct cons *cons, *new_cons; + lispobj new_list_pointer; + struct cons *cons, *new_cons; - cons = (struct cons *) PTR(object); + cons = (struct cons *) native_pointer(object); - /* ### Don't use copy_object here. */ - new_list_pointer = copy_object(object, 2); - new_cons = (struct cons *) PTR(new_list_pointer); + /* ### Don't use copy_object here. */ + new_list_pointer = copy_object(object, 2); + new_cons = (struct cons *) native_pointer(new_list_pointer); - /* Set forwarding pointer. */ - cons->car = new_list_pointer; + /* Set forwarding pointer. */ + cons->car = new_list_pointer; - /* Try to linearize the list in the cdr direction to help reduce */ - /* paging. */ + /* 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; + while (1) { + lispobj cdr, new_cdr, first; + struct cons *cdr_cons, *new_cdr_cons; - cdr = cons->cdr; + cdr = cons->cdr; - if (LowtagOf(cdr) != type_ListPointer || - !from_space_p(cdr) || - (Pointerp(first = *(lispobj *)PTR(cdr)) && - new_space_p(first))) - break; + if (lowtag_of(cdr) != LIST_POINTER_LOWTAG || + !from_space_p(cdr) || + (is_lisp_pointer(first = *(lispobj *)native_pointer(cdr)) + && new_space_p(first))) + break; - cdr_cons = (struct cons *) PTR(cdr); + cdr_cons = (struct cons *) native_pointer(cdr); - /* ### Don't use copy_object here */ - new_cdr = copy_object(cdr, 2); - new_cdr_cons = (struct cons *) PTR(new_cdr); + /* ### Don't use copy_object here */ + new_cdr = copy_object(cdr, 2); + new_cdr_cons = (struct cons *) native_pointer(new_cdr); - /* Set forwarding pointer */ - cdr_cons->car = 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; + /* 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; - } + cons = cdr_cons; + new_cons = new_cdr_cons; + } - return new_list_pointer; + return new_list_pointer; } /* scavenging and transporting other pointers */ -#if DIRECT_SCAV -static int -scav_other_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))) - first = *first_pointer = - (transother[TypeOf(first)])(object); - - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); - - *where = first; - } - return 1; -} -#else static int scav_other_pointer(lispobj *where, lispobj object) { - lispobj first, *first_pointer; + lispobj first, *first_pointer; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_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); + /* Object is a pointer into from space - not a FP */ + first_pointer = (lispobj *) native_pointer(object); + first = *first_pointer = (transother[widetag_of(*first_pointer)])(object); - gc_assert(Pointerp(first)); - gc_assert(!from_space_p(first)); + gc_assert(is_lisp_pointer(first)); + gc_assert(!from_space_p(first)); - *where = first; - return 1; + *where = first; + return 1; } -#endif /* immediate, boxed, and unboxed objects */ @@ -1194,29 +1114,29 @@ 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(is_lisp_pointer(object)); - header = *((lispobj *) PTR(object)); - length = HeaderValue(header) + 1; - length = CEILING(length, 2); + header = *((lispobj *) native_pointer(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) { - 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, */ @@ -1229,10 +1149,11 @@ scav_fdefn(lispobj *where, lispobj object) fdefn = (struct fdefn *)where; - if ((char *)(fdefn->function + RAW_ADDR_OFFSET) + if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET) == (char *)((unsigned long)(fdefn->raw_addr))) { scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1); - fdefn->raw_addr = (u32) ((char *) LOW_WORD(fdefn->function)) + RAW_ADDR_OFFSET; + fdefn->raw_addr = + (u32) ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET; return sizeof(struct fdefn) / sizeof(lispobj); } else @@ -1243,41 +1164,41 @@ scav_fdefn(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) { - lispobj header; - unsigned long length; + lispobj header; + unsigned long length; - gc_assert(Pointerp(object)); + gc_assert(is_lisp_pointer(object)); - header = *((lispobj *) PTR(object)); - length = HeaderValue(header) + 1; - length = CEILING(length, 2); + header = *((lispobj *) native_pointer(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) { - 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; } @@ -1288,58 +1209,60 @@ size_unboxed(lispobj *where) static int 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(is_lisp_pointer(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 *) native_pointer(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) { - 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) { - if (HeaderValue(object) == subtype_VectorValidHashing) - *where = (subtype_VectorMustRehash<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) { - 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) { - 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(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 32) + 2, 2); + vector = (struct vector *) native_pointer(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) { - 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) { - 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(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 16) + 2, 2); + vector = (struct vector *) native_pointer(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) { - 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) { - 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(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 8) + 2, 2); + vector = (struct vector *) native_pointer(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) { - 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) { - 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(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 4) + 2, 2); + vector = (struct vector *) native_pointer(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) { - 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) { - 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(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(NWORDS(length, 2) + 2, 2); + vector = (struct vector *) native_pointer(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) { - 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) { - 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(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + vector = (struct vector *) native_pointer(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) { - 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) { - 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(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(length + 2, 2); + vector = (struct vector *) native_pointer(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) { - 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) { - 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(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); + vector = (struct vector *) native_pointer(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) { - 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 +#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG static int 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(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); + vector = (struct vector *) native_pointer(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) { - 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 +#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG static int 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(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(length * 2 + 2, 2); + vector = (struct vector *) native_pointer(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) { - 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 +#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG static int 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(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); - nwords = CEILING(length * 4 + 2, 2); + vector = (struct vector *) native_pointer(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) { - 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 +#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG static int 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(is_lisp_pointer(object)); - vector = (struct vector *) PTR(object); - length = fixnum_value(vector->length); + vector = (struct vector *) native_pointer(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) { - 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 @@ -1905,83 +1827,83 @@ size_vector_complex_long_float(lispobj *where) static int 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(is_lisp_pointer(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 *) native_pointer(copy); - /* Push the weak pointer onto the list of weak pointers. */ - wp->next = LOW_WORD(weak_pointers); - weak_pointers = wp; + /* Push the weak pointer onto the list of weak pointers. */ + wp->next = LOW_WORD(weak_pointers); + weak_pointers = wp; - return copy; + return copy; } static int size_weak_pointer(lispobj *where) { - return WEAK_POINTER_NWORDS; + return WEAK_POINTER_NWORDS; } void scan_weak_pointers(void) { - struct weak_pointer *wp; + struct weak_pointer *wp; - for (wp = weak_pointers; wp != (struct weak_pointer *) NULL; - wp = (struct weak_pointer *)((unsigned long)wp->next)) { - lispobj value; - lispobj first, *first_pointer; + for (wp = weak_pointers; wp != (struct weak_pointer *) NULL; + wp = (struct weak_pointer *)((unsigned long)wp->next)) { + lispobj value; + lispobj first, *first_pointer; - value = wp->value; + value = wp->value; #if defined(DEBUG_WEAK) - printf("Weak pointer at 0x%p\n", wp); - printf("Value: 0x%08x\n", (unsigned int) value); + printf("Weak pointer at 0x%p\n", wp); + printf("Value: 0x%08x\n", (unsigned int) value); #endif - if (!(Pointerp(value) && from_space_p(value))) - continue; + if (!(is_lisp_pointer(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 *) native_pointer(value); + first = *first_pointer; #if defined(DEBUG_WEAK) - printf("First: 0x%08x\n", (unsigned long) first); + 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; - } + if (is_lisp_pointer(first) && new_space_p(first)) + wp->value = first; + else { + wp->value = NIL; + wp->broken = T; } + } } @@ -2009,11 +1931,11 @@ trans_lose(lispobj object) static int size_lose(lispobj *where) { - fprintf(stderr, "Size lossage. No size function for object at 0x%p\n", - where); - fprintf(stderr, "First word of object: 0x%08x\n", - (u32) *where); - return 1; + fprintf(stderr, "Size lossage. No size function for object at 0x%p\n", + where); + fprintf(stderr, "First word of object: 0x%08x\n", + (u32) *where); + return 1; } /* KLUDGE: SBCL already has two GC implementations, and if someday the @@ -2024,302 +1946,331 @@ size_lose(lispobj *where) void gc_init(void) { - int i; - - /* scavenge table */ - for (i = 0; i < 256; i++) - scavtab[i] = scav_lose; - /* scavtab[i] = scav_immediate; */ - - 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; - } + int i; + + /* scavenge table */ + for (i = 0; i < 256; i++) + scavtab[i] = scav_lose; + /* scavtab[i] = scav_immediate; */ + + for (i = 0; i < 32; i++) { + scavtab[EVEN_FIXNUM_LOWTAG|(i<<3)] = scav_immediate; + scavtab[FUN_POINTER_LOWTAG|(i<<3)] = scav_fun_pointer; + /* skipping OTHER_IMMEDIATE_0_LOWTAG */ + scavtab[LIST_POINTER_LOWTAG|(i<<3)] = scav_list_pointer; + scavtab[ODD_FIXNUM_LOWTAG|(i<<3)] = scav_immediate; + scavtab[INSTANCE_POINTER_LOWTAG|(i<<3)] =scav_instance_pointer; + /* skipping OTHER_IMMEDIATE_1_LOWTAG */ + scavtab[OTHER_POINTER_LOWTAG|(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; -#ifdef type_LongFloat - scavtab[type_LongFloat] = scav_unboxed; -#endif - scavtab[type_Complex] = scav_boxed; -#ifdef type_ComplexSingleFloat - scavtab[type_ComplexSingleFloat] = scav_unboxed; -#endif -#ifdef type_ComplexDoubleFloat - 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; -#ifdef type_SimpleArraySignedByte8 - scavtab[type_SimpleArraySignedByte8] = scav_vector_unsigned_byte_8; -#endif -#ifdef type_SimpleArraySignedByte16 - scavtab[type_SimpleArraySignedByte16] = scav_vector_unsigned_byte_16; -#endif -#ifdef type_SimpleArraySignedByte30 - scavtab[type_SimpleArraySignedByte30] = scav_vector_unsigned_byte_32; -#endif -#ifdef type_SimpleArraySignedByte32 - scavtab[type_SimpleArraySignedByte32] = scav_vector_unsigned_byte_32; -#endif - scavtab[type_SimpleArraySingleFloat] = scav_vector_single_float; - scavtab[type_SimpleArrayDoubleFloat] = scav_vector_double_float; -#ifdef type_SimpleArrayLongFloat - scavtab[type_SimpleArrayLongFloat] = scav_vector_long_float; -#endif -#ifdef type_SimpleArrayComplexSingleFloat - scavtab[type_SimpleArrayComplexSingleFloat] = scav_vector_complex_single_float; -#endif -#ifdef type_SimpleArrayComplexDoubleFloat - 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[BIGNUM_WIDETAG] = scav_unboxed; + scavtab[RATIO_WIDETAG] = scav_boxed; + scavtab[SINGLE_FLOAT_WIDETAG] = scav_unboxed; + scavtab[DOUBLE_FLOAT_WIDETAG] = scav_unboxed; +#ifdef LONG_FLOAT_WIDETAG + scavtab[LONG_FLOAT_WIDETAG] = scav_unboxed; +#endif + scavtab[COMPLEX_WIDETAG] = scav_boxed; +#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG + scavtab[COMPLEX_SINGLE_FLOAT_WIDETAG] = scav_unboxed; +#endif +#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG + scavtab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = scav_unboxed; +#endif +#ifdef COMPLEX_LONG_FLOAT_WIDETAG + scavtab[COMPLEX_LONG_FLOAT_WIDETAG] = scav_unboxed; +#endif + scavtab[SIMPLE_ARRAY_WIDETAG] = scav_boxed; + scavtab[SIMPLE_STRING_WIDETAG] = scav_string; + scavtab[SIMPLE_BIT_VECTOR_WIDETAG] = scav_vector_bit; + scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector; + scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] = + scav_vector_unsigned_byte_2; + scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] = + scav_vector_unsigned_byte_4; + scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] = + scav_vector_unsigned_byte_8; + scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] = + scav_vector_unsigned_byte_16; + scavtab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] = + scav_vector_unsigned_byte_32; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG + scavtab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = + scav_vector_unsigned_byte_8; +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG + scavtab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] = + scav_vector_unsigned_byte_16; +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG + scavtab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] = + scav_vector_unsigned_byte_32; +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG + scavtab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] = + scav_vector_unsigned_byte_32; +#endif + scavtab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = scav_vector_single_float; + scavtab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = scav_vector_double_float; +#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG + scavtab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = scav_vector_long_float; +#endif +#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG + scavtab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] = + scav_vector_complex_single_float; +#endif +#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG + scavtab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] = + scav_vector_complex_double_float; +#endif +#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG + scavtab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] = + scav_vector_complex_long_float; +#endif + scavtab[COMPLEX_STRING_WIDETAG] = scav_boxed; + scavtab[COMPLEX_BIT_VECTOR_WIDETAG] = scav_boxed; + scavtab[COMPLEX_VECTOR_WIDETAG] = scav_boxed; + scavtab[COMPLEX_ARRAY_WIDETAG] = scav_boxed; + scavtab[CODE_HEADER_WIDETAG] = scav_code_header; + scavtab[SIMPLE_FUN_HEADER_WIDETAG] = scav_fun_header; + scavtab[CLOSURE_FUN_HEADER_WIDETAG] = scav_fun_header; + scavtab[RETURN_PC_HEADER_WIDETAG] = 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[CLOSURE_HEADER_WIDETAG] = scav_closure_header; + scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = 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[CLOSURE_HEADER_WIDETAG] = scav_boxed; + scavtab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = scav_boxed; +#endif + scavtab[VALUE_CELL_HEADER_WIDETAG] = scav_boxed; + scavtab[SYMBOL_HEADER_WIDETAG] = scav_boxed; + scavtab[BASE_CHAR_WIDETAG] = scav_immediate; + scavtab[SAP_WIDETAG] = scav_unboxed; + scavtab[UNBOUND_MARKER_WIDETAG] = scav_immediate; + scavtab[WEAK_POINTER_WIDETAG] = scav_weak_pointer; + scavtab[INSTANCE_HEADER_WIDETAG] = scav_boxed; #ifndef sparc - scavtab[type_Fdefn] = scav_fdefn; + scavtab[FDEFN_WIDETAG] = scav_fdefn; #else - scavtab[type_Fdefn] = scav_boxed; -#endif - - /* 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; -#ifdef type_LongFloat - transother[type_LongFloat] = trans_unboxed; -#endif - transother[type_Complex] = trans_boxed; -#ifdef type_ComplexSingleFloat - transother[type_ComplexSingleFloat] = trans_unboxed; -#endif -#ifdef type_ComplexDoubleFloat - 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; -#ifdef type_SimpleArraySignedByte8 - transother[type_SimpleArraySignedByte8] = trans_vector_unsigned_byte_8; -#endif -#ifdef type_SimpleArraySignedByte16 - transother[type_SimpleArraySignedByte16] = trans_vector_unsigned_byte_16; -#endif -#ifdef type_SimpleArraySignedByte30 - transother[type_SimpleArraySignedByte30] = trans_vector_unsigned_byte_32; -#endif -#ifdef type_SimpleArraySignedByte32 - transother[type_SimpleArraySignedByte32] = trans_vector_unsigned_byte_32; -#endif - transother[type_SimpleArraySingleFloat] = trans_vector_single_float; - transother[type_SimpleArrayDoubleFloat] = trans_vector_double_float; -#ifdef type_SimpleArrayLongFloat - transother[type_SimpleArrayLongFloat] = trans_vector_long_float; -#endif -#ifdef type_SimpleArrayComplexSingleFloat - transother[type_SimpleArrayComplexSingleFloat] = trans_vector_complex_single_float; -#endif -#ifdef type_SimpleArrayComplexDoubleFloat - 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; - } + scavtab[FDEFN_WIDETAG] = scav_boxed; +#endif + + /* Transport Other Table */ + for (i = 0; i < 256; i++) + transother[i] = trans_lose; + + transother[BIGNUM_WIDETAG] = trans_unboxed; + transother[RATIO_WIDETAG] = trans_boxed; + transother[SINGLE_FLOAT_WIDETAG] = trans_unboxed; + transother[DOUBLE_FLOAT_WIDETAG] = trans_unboxed; +#ifdef LONG_FLOAT_WIDETAG + transother[LONG_FLOAT_WIDETAG] = trans_unboxed; +#endif + transother[COMPLEX_WIDETAG] = trans_boxed; +#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG + transother[COMPLEX_SINGLE_FLOAT_WIDETAG] = trans_unboxed; +#endif +#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG + transother[COMPLEX_DOUBLE_FLOAT_WIDETAG] = trans_unboxed; +#endif +#ifdef COMPLEX_LONG_FLOAT_WIDETAG + transother[COMPLEX_LONG_FLOAT_WIDETAG] = trans_unboxed; +#endif + transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed; + transother[SIMPLE_STRING_WIDETAG] = trans_string; + transother[SIMPLE_BIT_VECTOR_WIDETAG] = trans_vector_bit; + transother[SIMPLE_VECTOR_WIDETAG] = trans_vector; + transother[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] = + trans_vector_unsigned_byte_2; + transother[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] = + trans_vector_unsigned_byte_4; + transother[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] = + trans_vector_unsigned_byte_8; + transother[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] = + trans_vector_unsigned_byte_16; + transother[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] = + trans_vector_unsigned_byte_32; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG + transother[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = + trans_vector_unsigned_byte_8; +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG + transother[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] = + trans_vector_unsigned_byte_16; +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG + transother[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] = + trans_vector_unsigned_byte_32; +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG + transother[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] = + trans_vector_unsigned_byte_32; +#endif + transother[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = + trans_vector_single_float; + transother[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = + trans_vector_double_float; +#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG + transother[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = + trans_vector_long_float; +#endif +#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG + transother[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] = + trans_vector_complex_single_float; +#endif +#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG + transother[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] = + trans_vector_complex_double_float; +#endif +#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG + transother[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] = + trans_vector_complex_long_float; +#endif + transother[COMPLEX_STRING_WIDETAG] = trans_boxed; + transother[COMPLEX_BIT_VECTOR_WIDETAG] = trans_boxed; + transother[COMPLEX_VECTOR_WIDETAG] = trans_boxed; + transother[COMPLEX_ARRAY_WIDETAG] = trans_boxed; + transother[CODE_HEADER_WIDETAG] = trans_code_header; + transother[SIMPLE_FUN_HEADER_WIDETAG] = trans_fun_header; + transother[CLOSURE_FUN_HEADER_WIDETAG] = trans_fun_header; + transother[RETURN_PC_HEADER_WIDETAG] = trans_return_pc_header; + transother[CLOSURE_HEADER_WIDETAG] = trans_boxed; + transother[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = trans_boxed; + transother[VALUE_CELL_HEADER_WIDETAG] = trans_boxed; + transother[SYMBOL_HEADER_WIDETAG] = trans_boxed; + transother[BASE_CHAR_WIDETAG] = trans_immediate; + transother[SAP_WIDETAG] = trans_unboxed; + transother[UNBOUND_MARKER_WIDETAG] = trans_immediate; + transother[WEAK_POINTER_WIDETAG] = trans_weak_pointer; + transother[INSTANCE_HEADER_WIDETAG] = trans_boxed; + transother[FDEFN_WIDETAG] = trans_boxed; + + /* Size table */ + + for (i = 0; i < 256; i++) + sizetab[i] = size_lose; + + for (i = 0; i < 32; i++) { + sizetab[EVEN_FIXNUM_LOWTAG|(i<<3)] = size_immediate; + sizetab[FUN_POINTER_LOWTAG|(i<<3)] = size_pointer; + /* skipping OTHER_IMMEDIATE_0_LOWTAG */ + sizetab[LIST_POINTER_LOWTAG|(i<<3)] = size_pointer; + sizetab[ODD_FIXNUM_LOWTAG|(i<<3)] = size_immediate; + sizetab[INSTANCE_POINTER_LOWTAG|(i<<3)] = size_pointer; + /* skipping OTHER_IMMEDIATE_1_LOWTAG */ + sizetab[OTHER_POINTER_LOWTAG|(i<<3)] = size_pointer; + } - 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; -#endif - sizetab[type_Complex] = size_boxed; -#ifdef type_ComplexSingleFloat - sizetab[type_ComplexSingleFloat] = size_unboxed; -#endif -#ifdef type_ComplexDoubleFloat - 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; -#ifdef type_SimpleArraySignedByte8 - sizetab[type_SimpleArraySignedByte8] = size_vector_unsigned_byte_8; -#endif -#ifdef type_SimpleArraySignedByte16 - sizetab[type_SimpleArraySignedByte16] = size_vector_unsigned_byte_16; -#endif -#ifdef type_SimpleArraySignedByte30 - sizetab[type_SimpleArraySignedByte30] = size_vector_unsigned_byte_32; -#endif -#ifdef type_SimpleArraySignedByte32 - sizetab[type_SimpleArraySignedByte32] = size_vector_unsigned_byte_32; -#endif - sizetab[type_SimpleArraySingleFloat] = size_vector_single_float; - sizetab[type_SimpleArrayDoubleFloat] = size_vector_double_float; -#ifdef type_SimpleArrayLongFloat - sizetab[type_SimpleArrayLongFloat] = size_vector_long_float; -#endif -#ifdef type_SimpleArrayComplexSingleFloat - sizetab[type_SimpleArrayComplexSingleFloat] = size_vector_complex_single_float; -#endif -#ifdef type_SimpleArrayComplexDoubleFloat - sizetab[type_SimpleArrayComplexDoubleFloat] = size_vector_complex_double_float; -#endif -#ifdef type_SimpleArrayComplexLongFloat - 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[BIGNUM_WIDETAG] = size_unboxed; + sizetab[RATIO_WIDETAG] = size_boxed; + sizetab[SINGLE_FLOAT_WIDETAG] = size_unboxed; + sizetab[DOUBLE_FLOAT_WIDETAG] = size_unboxed; +#ifdef LONG_FLOAT_WIDETAG + sizetab[LONG_FLOAT_WIDETAG] = size_unboxed; +#endif + sizetab[COMPLEX_WIDETAG] = size_boxed; +#ifdef COMPLEX_SINGLE_FLOAT_WIDETAG + sizetab[COMPLEX_SINGLE_FLOAT_WIDETAG] = size_unboxed; +#endif +#ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG + sizetab[COMPLEX_DOUBLE_FLOAT_WIDETAG] = size_unboxed; +#endif +#ifdef COMPLEX_LONG_FLOAT_WIDETAG + sizetab[COMPLEX_LONG_FLOAT_WIDETAG] = size_unboxed; +#endif + sizetab[SIMPLE_ARRAY_WIDETAG] = size_boxed; + sizetab[SIMPLE_STRING_WIDETAG] = size_string; + sizetab[SIMPLE_BIT_VECTOR_WIDETAG] = size_vector_bit; + sizetab[SIMPLE_VECTOR_WIDETAG] = size_vector; + sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG] = + size_vector_unsigned_byte_2; + sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG] = + size_vector_unsigned_byte_4; + sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG] = + size_vector_unsigned_byte_8; + sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG] = + size_vector_unsigned_byte_16; + sizetab[SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG] = + size_vector_unsigned_byte_32; +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG + sizetab[SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG] = + size_vector_unsigned_byte_8; +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG + sizetab[SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG] = + size_vector_unsigned_byte_16; +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG + sizetab[SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG] = + size_vector_unsigned_byte_32; +#endif +#ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG + sizetab[SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG] = + size_vector_unsigned_byte_32; +#endif + sizetab[SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG] = size_vector_single_float; + sizetab[SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG] = size_vector_double_float; +#ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG + sizetab[SIMPLE_ARRAY_LONG_FLOAT_WIDETAG] = size_vector_long_float; +#endif +#ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG + sizetab[SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG] = + size_vector_complex_single_float; +#endif +#ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG + sizetab[SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG] = + size_vector_complex_double_float; +#endif +#ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG + sizetab[SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG] = + size_vector_complex_long_float; +#endif + sizetab[COMPLEX_STRING_WIDETAG] = size_boxed; + sizetab[COMPLEX_BIT_VECTOR_WIDETAG] = size_boxed; + sizetab[COMPLEX_VECTOR_WIDETAG] = size_boxed; + sizetab[COMPLEX_ARRAY_WIDETAG] = size_boxed; + sizetab[CODE_HEADER_WIDETAG] = 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[SIMPLE_FUN_HEADER_WIDETAG] = size_function_header; + sizetab[CLOSURE_FUN_HEADER_WIDETAG] = size_function_header; + sizetab[RETURN_PC_HEADER_WIDETAG] = size_return_pc_header; +#endif + sizetab[CLOSURE_HEADER_WIDETAG] = size_boxed; + sizetab[FUNCALLABLE_INSTANCE_HEADER_WIDETAG] = size_boxed; + sizetab[VALUE_CELL_HEADER_WIDETAG] = size_boxed; + sizetab[SYMBOL_HEADER_WIDETAG] = size_boxed; + sizetab[BASE_CHAR_WIDETAG] = size_immediate; + sizetab[SAP_WIDETAG] = size_unboxed; + sizetab[UNBOUND_MARKER_WIDETAG] = size_immediate; + sizetab[WEAK_POINTER_WIDETAG] = size_weak_pointer; + sizetab[INSTANCE_HEADER_WIDETAG] = size_boxed; + sizetab[FDEFN_WIDETAG] = size_boxed; } /* noise to manipulate the gc trigger stuff */ -#ifndef ibmrt - void set_auto_gc_trigger(os_vm_size_t dynamic_usage) { - 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; + os_vm_address_t addr=(os_vm_address_t)current_dynamic_space + + dynamic_usage; + + long length = DYNAMIC_SPACE_SIZE - dynamic_usage; - if(addr < (os_vm_address_t)dynamic_space_free_pointer) { + if (addr < (os_vm_address_t)dynamic_space_free_pointer) { fprintf(stderr, "set_auto_gc_trigger: tried to set gc trigger too low! (%d < %p)\n", (unsigned int)dynamic_usage, (os_vm_address_t)dynamic_space_free_pointer - (os_vm_address_t)current_dynamic_space); - return; + lose("lost"); } else if (length < 0) { fprintf(stderr, "set_auto_gc_trigger: tried to set gc trigger too high! (%p)\n", dynamic_usage); - return; + lose("lost"); } addr=os_round_up_to_page(addr); @@ -2336,7 +2287,7 @@ void set_auto_gc_trigger(os_vm_size_t dynamic_usage) void clear_auto_gc_trigger(void) { - if(current_auto_gc_trigger!=NULL){ + 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= @@ -2352,5 +2303,3 @@ void clear_auto_gc_trigger(void) current_auto_gc_trigger = NULL; } } - -#endif