Changeset 8478

Timestamp:

Feb 13, 2008, 6:11:50 AM (17 years ago)

Author:

gz

Message:

update to trunk r8477

Location:

branches/gz-working/lisp-kernel

Files:

• gc-common.c (modified) (1 diff)
• gc.h (modified) (1 diff)
• lisp.h (modified) (1 diff)
• memory.c (modified) (1 diff)
• ppc-spentry.s (modified) (1 diff)
• x86-exceptions.c (modified) (3 diffs)
• x86-gc.c (modified) (32 diffs)
• x86-spentry64.s (modified) (2 diffs)

branches/gz-working/lisp-kernel/gc-common.c

@@ -815 +815 @@
 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);
   }

branches/gz-working/lisp-kernel/gc.h

@@ -214 +214 @@
 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);

branches/gz-working/lisp-kernel/lisp.h

@@ -47 +47 @@
 #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<<power) -1);
 }
 
-#define truncate_to_power_of_2(n,p) _truncate_to_power_of_2((unsigned long)(n),p)
+#define truncate_to_power_of_2(n,p) _truncate_to_power_of_2((natural)(n),p)
 
 LispObj start_lisp(TCR*, LispObj);

branches/gz-working/lisp-kernel/memory.c

@@ -616 +616 @@
 }
 
+void
+release_readonly_area()
+{
+  area *a = readonly_area;
+  munmap(a->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;
+}

branches/gz-working/lisp-kernel/ppc-spentry.s

@@ -947 +947 @@
 /* because nargs < 32K.  */
 _spentry(gvector)
+        __(subi nargs,nargs,node_size)
         __(ldrx(arg_z,vsp,nargs))
         __(unbox_fixnum(imm0,arg_z))

branches/gz-working/lisp-kernel/x86-exceptions.c

@@ -157 +157 @@
   area *a = active_dynamic_area;
   Boolean egc_was_enabled = (a->older != NULL);
+  
   natural gc_previously_deferred = gc_deferred;
 
@@ -219 +220 @@
       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 +647 @@
       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;
+      }
     }
   }

branches/gz-working/lisp-kernel/x86-gc.c

@@ -1656 +1656 @@
     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 +1691 @@
 
 
-#define FORWARD_ONLY 0
-#define COPY_CODE (1<<0)
-#define COPY_STRINGS (1<<1)
 
 
@@ -1763 +1745 @@
 
 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 +1761 @@
       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 +1771 @@
 
 
-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 +1793 @@
    
 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 +1820 @@
           nwords -= skip;
           while(skip--) {
-            copy_ivector_reference(start, low, high, to, what);
+            copy_ivector_reference(start, low, high, to);
             start++;
           }
@@ -1838 +1829 @@
           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 +1846 @@
           start++;
           while(nwords--) {
-            copy_ivector_reference(start, low, high, to, what);
+            copy_ivector_reference(start, low, high, to);
             start++;
           }
@@ -1861 +1852 @@
       } 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 +1863 @@
 /* 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 +1877 @@
     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 +1883 @@
 /* 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 +1889 @@
     *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 +1900 @@
 
 #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 +1919 @@
 
 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 +1935 @@
   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 +1953 @@
     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 +1997 @@
 
 
-  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 +2005 @@
 
     /* 
-      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 +2013 @@
       */
 
-    {
-      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 +2059 @@
   
 
-
-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 +2098 @@
 
 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 +2108 @@
 
 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 +2180 @@
 
 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 +2189 @@
 
 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 +2205 @@
 
 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 +2225 @@
 }
 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 +2236 @@
 
 void
-impurify_areas(LispObj low, LispObj high, int delta)
+impurify_areas(LispObj low, LispObj high, signed_natural delta)
 {
   area *next_area;
@@ -2290 +2252 @@
       
     case AREA_CSTACK:
-#ifdef PPC
-      impurify_cstack_area(next_area, low, high, delta);
-#endif
       break;
       
@@ -2316 +2275 @@
       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 +2300 @@
         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;
     }

branches/gz-working/lisp-kernel/x86-spentry64.s

@@ -1597 +1597 @@
         __(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 +2076 @@
 /* objects.   */
 _spentry(gvector)
+        __(subl $node_size,%nargs)
         __(movq (%rsp,%nargs_q),%imm0)  /* boxed subtype   */
         __(sarq $fixnumshift,%imm0)