Index: /branches/gz-working/lisp-kernel/gc-common.c =================================================================== --- /branches/gz-working/lisp-kernel/gc-common.c (revision 8477) +++ /branches/gz-working/lisp-kernel/gc-common.c (revision 8478) @@ -815,8 +815,11 @@ forward_gcable_ptrs() { - LispObj *prev = &(lisp_global(GCABLE_POINTERS)), next; + LispObj *prev = &(lisp_global(GCABLE_POINTERS)), next, new; while ((next = *prev) != (LispObj)NULL) { - *prev = node_forwarding_address(next); + new = node_forwarding_address(next); + if (new != next) { + *prev = new; + } prev = &(((xmacptr *)ptr_from_lispobj(untag(next)))->link); } Index: /branches/gz-working/lisp-kernel/gc.h =================================================================== --- /branches/gz-working/lisp-kernel/gc.h (revision 8477) +++ /branches/gz-working/lisp-kernel/gc.h (revision 8478) @@ -214,5 +214,4 @@ void forward_cstack_area(area *); LispObj compact_dynamic_heap(void); -LispObj * skip_over_ivector(natural, LispObj); int purify(TCR *, signed_natural); int impurify(TCR *, signed_natural); Index: /branches/gz-working/lisp-kernel/lisp.h =================================================================== --- /branches/gz-working/lisp-kernel/lisp.h (revision 8477) +++ /branches/gz-working/lisp-kernel/lisp.h (revision 8478) @@ -47,11 +47,11 @@ #define align_to_power_of_2(n,p) _align_to_power_of_2(((natural)(n)),p) -static inline unsigned long -_truncate_to_power_of_2(unsigned long n, unsigned power) +static inline natural +_truncate_to_power_of_2(natural n, unsigned power) { return n & ~((1<low,align_to_power_of_2(a->active-a->low, log2_page_size)); + a->active = a->low; + a->ndnodes = 0; + pure_space_active = pure_space_start; +} Index: /branches/gz-working/lisp-kernel/ppc-spentry.s =================================================================== --- /branches/gz-working/lisp-kernel/ppc-spentry.s (revision 8477) +++ /branches/gz-working/lisp-kernel/ppc-spentry.s (revision 8478) @@ -947,4 +947,5 @@ /* because nargs < 32K. */ _spentry(gvector) + __(subi nargs,nargs,node_size) __(ldrx(arg_z,vsp,nargs)) __(unbox_fixnum(imm0,arg_z)) Index: /branches/gz-working/lisp-kernel/x86-exceptions.c =================================================================== --- /branches/gz-working/lisp-kernel/x86-exceptions.c (revision 8477) +++ /branches/gz-working/lisp-kernel/x86-exceptions.c (revision 8478) @@ -157,4 +157,5 @@ area *a = active_dynamic_area; Boolean egc_was_enabled = (a->older != NULL); + natural gc_previously_deferred = gc_deferred; @@ -219,31 +220,39 @@ full_gc_deferred = 0; } - if (selector & GC_TRAP_FUNCTION_PURIFY) { - purify_from_xp(xp, 0L); - gc_from_xp(xp, 0L); - } - if (selector & GC_TRAP_FUNCTION_SAVE_APPLICATION) { - OSErr err; - extern OSErr save_application(unsigned); - area *vsarea = tcr->vs_area; + if (selector > GC_TRAP_FUNCTION_GC) { + if (selector & GC_TRAP_FUNCTION_IMPURIFY) { + impurify_from_xp(xp, 0L); + /* nrs_GC_EVENT_STATUS_BITS.vcell |= gc_integrity_check_bit; */ + gc_from_xp(xp, 0L); + release_readonly_area(); + } + if (selector & GC_TRAP_FUNCTION_PURIFY) { + purify_from_xp(xp, 0L); + gc_from_xp(xp, 0L); + } + if (selector & GC_TRAP_FUNCTION_SAVE_APPLICATION) { + OSErr err; + extern OSErr save_application(unsigned); + area *vsarea = tcr->vs_area; - nrs_TOPLFUNC.vcell = *((LispObj *)(vsarea->high)-1); - err = save_application(arg); - if (err == noErr) { - _exit(0); + nrs_TOPLFUNC.vcell = *((LispObj *)(vsarea->high)-1); + err = save_application(arg); + if (err == noErr) { + _exit(0); + } + fatal_oserr(": save_application", err); } - fatal_oserr(": save_application", err); - } - switch (selector) { - case GC_TRAP_FUNCTION_SET_HONS_AREA_SIZE: - xpGPR(xp, Iimm0) = 0; - break; - case GC_TRAP_FUNCTION_FREEZE: - a->active = (BytePtr) align_to_power_of_2(a->active, log2_page_size); - tenured_area->static_dnodes = area_dnode(a->active, a->low); - xpGPR(xp, Iimm0) = tenured_area->static_dnodes << dnode_shift; - break; - default: - break; + switch (selector) { + case GC_TRAP_FUNCTION_SET_HONS_AREA_SIZE: + xpGPR(xp, Iimm0) = 0; + break; + case GC_TRAP_FUNCTION_FREEZE: + a->active = (BytePtr) align_to_power_of_2(a->active, log2_page_size); + tenured_area->static_dnodes = area_dnode(a->active, a->low); + xpGPR(xp, Iimm0) = tenured_area->static_dnodes << dnode_shift; + break; + default: + break; + } } if (egc_was_enabled) { @@ -638,4 +647,11 @@ handler = protection_handlers[a->why]; return handler(xp, a, addr); + } else { + if ((addr >= readonly_area->low) && + (addr < readonly_area->active)) { + UnProtectMemory((LogicalAddress)(truncate_to_power_of_2(addr,log2_page_size)), + page_size); + return true; + } } } Index: /branches/gz-working/lisp-kernel/x86-gc.c =================================================================== --- /branches/gz-working/lisp-kernel/x86-gc.c (revision 8477) +++ /branches/gz-working/lisp-kernel/x86-gc.c (revision 8478) @@ -1656,24 +1656,9 @@ new; natural - subtag = header_subtag(header), - element_count = header_element_count(header), + start = (natural)old, physbytes; - switch(subtag) { - case subtag_simple_base_string: - physbytes = node_size + (element_count << 2); - break; - -#ifndef X86 - case subtag_code_vector: - physbytes = node_size + (element_count << 2); - break; -#endif - - default: - Bug(NULL, "Can't purify object at 0x%08x", obj); - return obj; - } - physbytes = (physbytes+(dnode_size-1))&~(dnode_size-1); + physbytes = ((natural)(skip_over_ivector(start,header))) - start; + dest->active += physbytes; @@ -1706,7 +1691,4 @@ -#define FORWARD_ONLY 0 -#define COPY_CODE (1<<0) -#define COPY_STRINGS (1<<1) @@ -1763,5 +1745,5 @@ Boolean -copy_ivector_reference(LispObj *ref, BytePtr low, BytePtr high, area *dest, int what_to_copy) +copy_ivector_reference(LispObj *ref, BytePtr low, BytePtr high, area *dest) { LispObj obj = *ref, header, new; @@ -1779,11 +1761,7 @@ header_tag = fulltag_of(header); if (immheader_tag_p(header_tag)) { - header_subtag = header_subtag(header); - if ((what_to_copy & COPY_STRINGS) && - ((header_subtag == subtag_simple_base_string))) { - new = purify_object(obj, dest); - *ref = new; - changed = (new != obj); - } + new = purify_object(obj, dest); + *ref = new; + changed = (new != obj); } } @@ -1793,8 +1771,21 @@ -void purify_headerless_range(LispObj *start, LispObj *end, BytePtr low, BytePtr high, area *to, int what) +void +purify_gcable_ptrs(BytePtr low, BytePtr high, area *to) +{ + LispObj *prev = &(lisp_global(GCABLE_POINTERS)), next; + + while ((*prev) != (LispObj)NULL) { + copy_ivector_reference(prev, low, high, to); + next = *prev; + prev = &(((xmacptr *)ptr_from_lispobj(untag(next)))->link); + } +} + +void +purify_headerless_range(LispObj *start, LispObj *end, BytePtr low, BytePtr high, area *to) { while (start < end) { - copy_ivector_reference(start, low, high, to, what); + copy_ivector_reference(start, low, high, to); start++; } @@ -1802,5 +1793,5 @@ void -purify_range(LispObj *start, LispObj *end, BytePtr low, BytePtr high, area *to, int what) +purify_range(LispObj *start, LispObj *end, BytePtr low, BytePtr high, area *to) { LispObj header; @@ -1829,5 +1820,5 @@ nwords -= skip; while(skip--) { - copy_ivector_reference(start, low, high, to, what); + copy_ivector_reference(start, low, high, to); start++; } @@ -1838,10 +1829,10 @@ nwords >>= 1; while(nwords--) { - if (copy_ivector_reference(start, low, high, to, what) && hashp) { + if (copy_ivector_reference(start, low, high, to) && hashp) { hashp->flags |= nhash_key_moved_mask; hashp = NULL; } start++; - copy_ivector_reference(start, low, high, to, what); + copy_ivector_reference(start, low, high, to); start++; } @@ -1855,5 +1846,5 @@ start++; while(nwords--) { - copy_ivector_reference(start, low, high, to, what); + copy_ivector_reference(start, low, high, to); start++; } @@ -1861,7 +1852,7 @@ } else { /* Not a header, just a cons cell */ - copy_ivector_reference(start, low, high, to, what); + copy_ivector_reference(start, low, high, to); start++; - copy_ivector_reference(start, low, high, to, what); + copy_ivector_reference(start, low, high, to); start++; } @@ -1872,5 +1863,5 @@ /* Purify references from tstack areas */ void -purify_tstack_area(area *a, BytePtr low, BytePtr high, area *to, int what) +purify_tstack_area(area *a, BytePtr low, BytePtr high, area *to) { LispObj @@ -1886,7 +1877,5 @@ next = (LispObj *) ptr_from_lispobj(*current); end = ((next >= start) && (next < limit)) ? next : limit; - if (current[1] == 0) { - purify_range(current+2, end, low, high, to, what); - } + purify_range(current+2, end, low, high, to); } } @@ -1894,5 +1883,5 @@ /* Purify a vstack area */ void -purify_vstack_area(area *a, BytePtr low, BytePtr high, area *to, int what) +purify_vstack_area(area *a, BytePtr low, BytePtr high, area *to) { LispObj @@ -1900,10 +1889,10 @@ *q = (LispObj *) a->high; - purify_headerless_range(p, q, low, high, to, what); -} - - -void -purify_xp(ExceptionInformation *xp, BytePtr low, BytePtr high, area *to, int what) + purify_headerless_range(p, q, low, high, to); +} + + +void +purify_xp(ExceptionInformation *xp, BytePtr low, BytePtr high, area *to) { natural *regs = (natural *) xpGPRvector(xp); @@ -1911,17 +1900,17 @@ #ifdef X8664 - copy_ivector_reference(&(regs[Iarg_z]), low, high, to, what); - copy_ivector_reference(&(regs[Iarg_y]), low, high, to, what); - copy_ivector_reference(&(regs[Iarg_x]), low, high, to, what); - copy_ivector_reference(&(regs[Isave3]), low, high, to, what); - copy_ivector_reference(&(regs[Isave2]), low, high, to, what); - copy_ivector_reference(&(regs[Isave1]), low, high, to, what); - copy_ivector_reference(&(regs[Isave0]), low, high, to, what); - copy_ivector_reference(&(regs[Ifn]), low, high, to, what); - copy_ivector_reference(&(regs[Itemp0]), low, high, to, what); - copy_ivector_reference(&(regs[Itemp1]), low, high, to, what); - copy_ivector_reference(&(regs[Itemp2]), low, high, to, what); + copy_ivector_reference(&(regs[Iarg_z]), low, high, to); + copy_ivector_reference(&(regs[Iarg_y]), low, high, to); + copy_ivector_reference(&(regs[Iarg_x]), low, high, to); + copy_ivector_reference(&(regs[Isave3]), low, high, to); + copy_ivector_reference(&(regs[Isave2]), low, high, to); + copy_ivector_reference(&(regs[Isave1]), low, high, to); + copy_ivector_reference(&(regs[Isave0]), low, high, to); + copy_ivector_reference(&(regs[Ifn]), low, high, to); + copy_ivector_reference(&(regs[Itemp0]), low, high, to); + copy_ivector_reference(&(regs[Itemp1]), low, high, to); + copy_ivector_reference(&(regs[Itemp2]), low, high, to); #if 0 - purify_locref(&(regs[Iip]), low, high, to, what); + purify_locref(&(regs[Iip]), low, high, to); #endif #else @@ -1930,14 +1919,14 @@ void -purify_tcr_tlb(TCR *tcr, BytePtr low, BytePtr high, area *to, int what) +purify_tcr_tlb(TCR *tcr, BytePtr low, BytePtr high, area *to) { natural n = tcr->tlb_limit; LispObj *start = tcr->tlb_pointer, *end = (LispObj *) ((BytePtr)start+n); - purify_range(start, end, low, high, to, what); -} - -void -purify_tcr_xframes(TCR *tcr, BytePtr low, BytePtr high, area *to, int what) + purify_range(start, end, low, high, to); +} + +void +purify_tcr_xframes(TCR *tcr, BytePtr low, BytePtr high, area *to) { xframe_list *xframes; @@ -1946,15 +1935,15 @@ xp = tcr->gc_context; if (xp) { - purify_xp(xp, low, high, to, what); + purify_xp(xp, low, high, to); } for (xframes = tcr->xframe; xframes; xframes = xframes->prev) { - purify_xp(xframes->curr, low, high, to, what); - } -} - - -void -purify_areas(BytePtr low, BytePtr high, area *target, int what) + purify_xp(xframes->curr, low, high, to); + } +} + + +void +purify_areas(BytePtr low, BytePtr high, area *target) { area *next_area; @@ -1964,20 +1953,17 @@ switch (code) { case AREA_TSTACK: - purify_tstack_area(next_area, low, high, target, what); + purify_tstack_area(next_area, low, high, target); break; case AREA_VSTACK: - purify_vstack_area(next_area, low, high, target, what); + purify_vstack_area(next_area, low, high, target); break; case AREA_CSTACK: -#ifdef PPC - purify_cstack_area(next_area, low, high, target, what); -#endif break; case AREA_STATIC: case AREA_DYNAMIC: - purify_range((LispObj *) next_area->low, (LispObj *) next_area->active, low, high, target, what); + purify_range((LispObj *) next_area->low, (LispObj *) next_area->active, low, high, target); break; @@ -2011,5 +1997,5 @@ - max_pure_size = interned_pname_bytes_in_range((LispObj *)(a->low + (static_dnodes_for_area(a) << dnode_shift)), + max_pure_size = unboxed_bytes_in_range((LispObj *)(a->low + (static_dnodes_for_area(a) << dnode_shift)), (LispObj *) a->active); new_pure_area = extend_readonly_area(max_pure_size); @@ -2019,9 +2005,5 @@ /* - First, loop thru *all-packages* and purify the pnames of all - interned symbols. Then walk every place that could reference - a heap-allocated object (all_areas, the xframe_list) and - purify code_vectors (and update the odd case of a shared - reference to a pname.) + Make the new_pure_area executable, just in case. @@ -2031,48 +2013,16 @@ */ - { - lispsymbol *rawsym = (lispsymbol *)(&(nrs_ALL_PACKAGES)); - LispObj pkg_list = rawsym->vcell, htab, obj; - package *p; - cons *c; - natural elements, i; - - while (fulltag_of(pkg_list) == fulltag_cons) { - c = (cons *) ptr_from_lispobj(untag(pkg_list)); - p = (package *) ptr_from_lispobj(untag(c->car)); - pkg_list = c->cdr; - c = (cons *) ptr_from_lispobj(untag(p->itab)); - htab = c->car; - elements = header_element_count(header_of(htab)); - for (i = 1; i<= elements; i++) { - obj = deref(htab,i); - if (fulltag_of(obj) == fulltag_symbol) { - rawsym = (lispsymbol *) ptr_from_lispobj(untag(obj)); - copy_ivector_reference(&(rawsym->pname), a->low, a->active, new_pure_area, COPY_STRINGS); - } - } - c = (cons *) ptr_from_lispobj(untag(p->etab)); - htab = c->car; - elements = header_element_count(header_of(htab)); - for (i = 1; i<= elements; i++) { - obj = deref(htab,i); - if (fulltag_of(obj) == fulltag_symbol) { - rawsym = (lispsymbol *) ptr_from_lispobj(untag(obj)); - copy_ivector_reference(&(rawsym->pname), a->low, a->active, new_pure_area, COPY_STRINGS); - } - } - } - } + - purify_areas(a->low, a->active, new_pure_area, FORWARD_ONLY); + purify_areas(a->low, a->active, new_pure_area); other_tcr = tcr; do { - purify_tcr_xframes(other_tcr, a->low, a->active, new_pure_area, FORWARD_ONLY); - purify_tcr_tlb(other_tcr, a->low, a->active, new_pure_area, FORWARD_ONLY); + purify_tcr_xframes(other_tcr, a->low, a->active, new_pure_area); + purify_tcr_tlb(other_tcr, a->low, a->active, new_pure_area); other_tcr = other_tcr->next; } while (other_tcr != tcr); - + purify_gcable_ptrs(a->low, a->active, new_pure_area); { natural puresize = (unsigned) (new_pure_area->active-new_pure_start); @@ -2109,7 +2059,19 @@ - -void -impurify_xp(ExceptionInformation *xp, LispObj low, LispObj high, int delta) +void +impurify_gcable_ptrs(LispObj low, LispObj high, signed_natural delta) +{ + LispObj *prev = &(lisp_global(GCABLE_POINTERS)), next; + + while ((*prev) != (LispObj)NULL) { + impurify_noderef(prev, low, high, delta); + next = *prev; + prev = &(((xmacptr *)ptr_from_lispobj(untag(next)))->link); + } +} + + +void +impurify_xp(ExceptionInformation *xp, LispObj low, LispObj high, signed_natural delta) { natural *regs = (natural *) xpGPRvector(xp); @@ -2136,5 +2098,5 @@ void -impurify_headerless_range(LispObj *start, LispObj *end, LispObj low, LispObj high, int delta) +impurify_headerless_range(LispObj *start, LispObj *end, LispObj low, LispObj high, signed_natural delta) { while (start < end) { @@ -2146,5 +2108,5 @@ void -impurify_range(LispObj *start, LispObj *end, LispObj low, LispObj high, int delta) +impurify_range(LispObj *start, LispObj *end, LispObj low, LispObj high, signed_natural delta) { LispObj header; @@ -2218,5 +2180,5 @@ void -impurify_tcr_tlb(TCR *tcr, LispObj low, LispObj high, int delta) +impurify_tcr_tlb(TCR *tcr, LispObj low, LispObj high, signed_natural delta) { unsigned n = tcr->tlb_limit; @@ -2227,5 +2189,5 @@ void -impurify_tcr_xframes(TCR *tcr, LispObj low, LispObj high, int delta) +impurify_tcr_xframes(TCR *tcr, LispObj low, LispObj high, signed_natural delta) { xframe_list *xframes; @@ -2243,5 +2205,5 @@ void -impurify_tstack_area(area *a, LispObj low, LispObj high, int delta) +impurify_tstack_area(area *a, LispObj low, LispObj high, signed_natural delta) { LispObj @@ -2263,5 +2225,5 @@ } void -impurify_vstack_area(area *a, LispObj low, LispObj high, int delta) +impurify_vstack_area(area *a, LispObj low, LispObj high, signed_natural delta) { LispObj @@ -2274,5 +2236,5 @@ void -impurify_areas(LispObj low, LispObj high, int delta) +impurify_areas(LispObj low, LispObj high, signed_natural delta) { area *next_area; @@ -2290,7 +2252,4 @@ case AREA_CSTACK: -#ifdef PPC - impurify_cstack_area(next_area, low, high, delta); -#endif break; @@ -2316,5 +2275,5 @@ oldhigh = a->high, newhigh; unsigned n = ro_limit - ro_base; - int delta = oldfree-ro_base; + signed_natural delta = oldfree-ro_base; TCR *other_tcr; @@ -2341,4 +2300,6 @@ other_tcr = other_tcr->next; } while (other_tcr != tcr); + + impurify_gcable_ptrs(ptr_to_lispobj(ro_base), ptr_to_lispobj(ro_limit), delta); lisp_global(IN_GC) = 0; } Index: /branches/gz-working/lisp-kernel/x86-spentry64.s =================================================================== --- /branches/gz-working/lisp-kernel/x86-spentry64.s (revision 8477) +++ /branches/gz-working/lisp-kernel/x86-spentry64.s (revision 8478) @@ -1597,5 +1597,5 @@ __(push %rcontext:tcr.db_link) __(movq %rsp,%rcontext:tcr.db_link) - __(movq $nil_value,(%temp0,%temp1)) + __(movq $nil_value,(%temp1,%temp0)) __(jmp *%ra0) 9: __(movq $XSYMNOBIND,%arg_y) @@ -2076,4 +2076,5 @@ /* objects. */ _spentry(gvector) + __(subl $node_size,%nargs) __(movq (%rsp,%nargs_q),%imm0) /* boxed subtype */ __(sarq $fixnumshift,%imm0)