Changeset 8493


Ignore:
Timestamp:
Feb 15, 2008, 10:27:54 AM (12 years ago)
Author:
gb
Message:

Purify/impurify stuff for PPC.

Location:
trunk/source/lisp-kernel
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lisp-kernel/ppc-exceptions.c

    r8131 r8493  
    442442        /*        nrs_GC_EVENT_STATUS_BITS.vcell |= gc_integrity_check_bit; */
    443443        gc_from_xp(xp, 0L);
     444        release_readonly_area();
    444445      }
    445446      if (selector & GC_TRAP_FUNCTION_PURIFY) {
     
    905906      handler = protection_handlers[area->why];
    906907      return handler(xp, area, addr);
     908    } else {
     909      if ((addr >= readonly_area->low) &&
     910          (addr < readonly_area->active)) {
     911        UnProtectMemory((LogicalAddress)(truncate_to_power_of_2(addr,log2_page_size)),
     912                        page_size);
     913        return 0;
     914      }
    907915    }
    908916  }
  • trunk/source/lisp-kernel/ppc-gc.c

    r8401 r8493  
    17291729
    17301730  /*
    1731      This assumes that it's getting called with a simple-{base,general}-string
    1732      or code vector as an argument and that there's room for the object in the
     1731     This assumes that it's getting called with an ivector
     1732     argument and that there's room for the object in the
    17331733     destination area.
    17341734  */
    17351735
    17361736
     1737LispObj
     1738purify_displaced_object(LispObj obj, area *dest, natural disp)
     1739{
     1740  BytePtr
     1741    free = dest->active,
     1742    *old = (BytePtr *) ptr_from_lispobj(untag(obj));
     1743  LispObj
     1744    header = header_of(obj),
     1745    new;
     1746  natural
     1747    start = (natural)old,
     1748    physbytes;
     1749
     1750  physbytes = ((natural)(skip_over_ivector(start,header))) - start;
     1751  dest->active += physbytes;
     1752
     1753  new = ptr_to_lispobj(free)+disp;
     1754
     1755  memcpy(free, (BytePtr)old, physbytes);
     1756  /* Leave a trail of breadcrumbs.  Or maybe just one breadcrumb. */
     1757  /* Actually, it's best to always leave a trail, for two reasons.
     1758     a) We may be walking the same heap that we're leaving forwaring
     1759     pointers in, so we don't want garbage that we leave behind to
     1760     look like a header.
     1761     b) We'd like to be able to forward code-vector locatives, and
     1762     it's easiest to do so if we leave a {forward_marker, dnode_locative}
     1763     pair at every doubleword in the old vector.
     1764  */
     1765  while(physbytes) {
     1766    *old++ = (BytePtr) forward_marker;
     1767    *old++ = (BytePtr) free;
     1768    free += dnode_size;
     1769    physbytes -= dnode_size;
     1770  }
     1771  return new;
     1772}
     1773
     1774LispObj
     1775purify_object(LispObj obj, area *dest)
     1776{
     1777  return purify_displaced_object(obj, dest, fulltag_of(obj));
     1778}
     1779
     1780
     1781
     1782void
     1783copy_ivector_reference(LispObj *ref, BytePtr low, BytePtr high, area *dest)
     1784{
     1785  LispObj obj = *ref, header;
     1786  natural tag = fulltag_of(obj), header_tag, header_subtag;
     1787
     1788  if ((tag == fulltag_misc) &&
     1789      (((BytePtr)ptr_from_lispobj(obj)) > low) &&
     1790      (((BytePtr)ptr_from_lispobj(obj)) < high)) {
     1791    header = deref(obj, 0);
     1792    if (header == forward_marker) { /* already copied */
     1793      *ref = (untag(deref(obj,1)) + tag);
     1794    } else {
     1795      header_tag = fulltag_of(header);
     1796      if (immheader_tag_p(header_tag)) {
     1797        *ref = purify_object(obj, dest);
     1798      }
     1799    }
     1800  }
     1801}
     1802
     1803void
     1804purify_locref(LispObj *locaddr, BytePtr low, BytePtr high, area *to)
     1805{
     1806#ifdef PPC
    17371807  LispObj
    1738     purify_displaced_object(LispObj obj, area *dest, natural disp)
    1739   {
    1740     BytePtr
    1741       free = dest->active,
    1742       *old = (BytePtr *) ptr_from_lispobj(untag(obj));
    1743     LispObj
    1744       header = header_of(obj),
    1745       new;
    1746     natural
    1747       subtag = header_subtag(header),
    1748       element_count = header_element_count(header),
    1749       physbytes;
    1750 
    1751     switch(subtag) {
    1752     case subtag_simple_base_string:
    1753       physbytes = node_size + (element_count << 2);
    1754       break;
    1755 
    1756     case subtag_code_vector:
    1757       physbytes = node_size + (element_count << 2);
    1758       break;
    1759 
    1760     default:
    1761       Bug(NULL, "Can't purify object at 0x%08x", obj);
    1762       return obj;
    1763     }
    1764     physbytes = (physbytes+(dnode_size-1))&~(dnode_size-1);
    1765     dest->active += physbytes;
    1766 
    1767     new = ptr_to_lispobj(free)+disp;
    1768 
    1769     memcpy(free, (BytePtr)old, physbytes);
    1770     /* Leave a trail of breadcrumbs.  Or maybe just one breadcrumb. */
    1771     /* Actually, it's best to always leave a trail, for two reasons.
    1772        a) We may be walking the same heap that we're leaving forwaring
    1773        pointers in, so we don't want garbage that we leave behind to
    1774        look like a header.
    1775        b) We'd like to be able to forward code-vector locatives, and
    1776        it's easiest to do so if we leave a {forward_marker, dnode_locative}
    1777        pair at every doubleword in the old vector.
    1778     */
    1779     while(physbytes) {
    1780       *old++ = (BytePtr) forward_marker;
    1781       *old++ = (BytePtr) free;
    1782       free += dnode_size;
    1783       physbytes -= dnode_size;
    1784     }
    1785     return new;
    1786   }
    1787 
    1788   LispObj
    1789     purify_object(LispObj obj, area *dest)
    1790   {
    1791     return purify_displaced_object(obj, dest, fulltag_of(obj));
    1792   }
    1793 
    1794 
    1795 #define FORWARD_ONLY 0
    1796 #define COPY_CODE (1<<0)
    1797 #define COPY_STRINGS (1<<1)
    1798 
    1799   void
    1800     copy_ivector_reference(LispObj *ref, BytePtr low, BytePtr high, area *dest, int what_to_copy)
    1801   {
    1802     LispObj obj = *ref, header;
    1803     natural tag = fulltag_of(obj), header_tag, header_subtag;
    1804 
    1805     if ((tag == fulltag_misc) &&
    1806         (((BytePtr)ptr_from_lispobj(obj)) > low) &&
    1807         (((BytePtr)ptr_from_lispobj(obj)) < high)) {
    1808       header = deref(obj, 0);
    1809       if (header == forward_marker) { /* already copied */
    1810         *ref = (untag(deref(obj,1)) + tag);
     1808    loc = *locaddr,
     1809    *headerP;
     1810  opcode
     1811    *p,
     1812    insn;
     1813  natural
     1814    tag = fulltag_of(loc);
     1815
     1816  if (((BytePtr)ptr_from_lispobj(loc) > low) &&
     1817      ((BytePtr)ptr_from_lispobj(loc) < high)) {
     1818
     1819    headerP = (LispObj *)ptr_from_lispobj(untag(loc));
     1820    switch (tag) {
     1821    case fulltag_even_fixnum:
     1822    case fulltag_odd_fixnum:
     1823#ifdef PPC64
     1824    case fulltag_cons:
     1825    case fulltag_misc:
     1826#endif
     1827      if (*headerP == forward_marker) {
     1828        *locaddr = (headerP[1]+tag);
    18111829      } else {
    1812         header_tag = fulltag_of(header);
    1813         if (immheader_tag_p(header_tag)) {
    1814           header_subtag = header_subtag(header);
    1815           if (((header_subtag == subtag_code_vector) && (what_to_copy & COPY_CODE)) ||
    1816               ((what_to_copy & COPY_STRINGS) &&
    1817                ((header_subtag == subtag_simple_base_string)))) {
    1818             *ref = purify_object(obj, dest);
    1819           }
    1820         }
    1821       }
    1822     }
    1823   }
    1824 
    1825   void
    1826     purify_locref(LispObj *locaddr, BytePtr low, BytePtr high, area *to, int what)
    1827   {
    1828 #ifdef PPC
    1829     LispObj
    1830       loc = *locaddr,
    1831       *headerP;
    1832     opcode
    1833       *p,
    1834       insn;
    1835     natural
    1836       tag = fulltag_of(loc);
    1837 
    1838     if (((BytePtr)ptr_from_lispobj(loc) > low) &&
    1839 
    1840         ((BytePtr)ptr_from_lispobj(loc) < high)) {
    1841 
    1842       headerP = (LispObj *)ptr_from_lispobj(untag(loc));
    1843       switch (tag) {
    1844       case fulltag_even_fixnum:
    1845       case fulltag_odd_fixnum:
     1830        /* Grovel backwards until the header's found; copy
     1831           the code vector to to space, then treat it as if it
     1832           hasn't already been copied. */
     1833        p = (opcode *)headerP;
     1834        do {
     1835          p -= 2;
     1836          tag += 8;
     1837          insn = *p;
    18461838#ifdef PPC64
    1847       case fulltag_cons:
    1848       case fulltag_misc:
    1849 #endif
    1850         if (*headerP == forward_marker) {
    1851           *locaddr = (headerP[1]+tag);
    1852         } else {
    1853           /* Grovel backwards until the header's found; copy
    1854              the code vector to to space, then treat it as if it
    1855              hasn't already been copied. */
    1856           p = (opcode *)headerP;
    1857           do {
    1858             p -= 2;
    1859             tag += 8;
    1860             insn = *p;
    1861 #ifdef PPC64
    1862           } while (insn != PPC64_CODE_VECTOR_PREFIX);
    1863           headerP = ((LispObj*)p)-1;
    1864           *locaddr = purify_displaced_object(((LispObj)headerP), to, tag);
     1839        } while (insn != PPC64_CODE_VECTOR_PREFIX);
     1840        headerP = ((LispObj*)p)-1;
     1841        *locaddr = purify_displaced_object(((LispObj)headerP), to, tag);
    18651842#else
    1866         } while ((insn & code_header_mask) != subtag_code_vector);
    1867         *locaddr = purify_displaced_object(ptr_to_lispobj(p), to, tag);
    1868 #endif
    1869       }
    1870       break;
     1843      } while ((insn & code_header_mask) != subtag_code_vector);
     1844      *locaddr = purify_displaced_object(ptr_to_lispobj(p), to, tag);
     1845#endif
     1846    }
     1847    break;
    18711848
    18721849#ifndef PPC64
    1873     case fulltag_misc:
    1874       copy_ivector_reference(locaddr, low, high, to, what);
    1875       break;
    1876 #endif
    1877     }
    1878   }
    1879 #endif
    1880 }
    1881 
    1882 void
    1883 purify_range(LispObj *start, LispObj *end, BytePtr low, BytePtr high, area *to, int what)
     1850  case fulltag_misc:
     1851    copy_ivector_reference(locaddr, low, high, to);
     1852    break;
     1853#endif
     1854  }
     1855}
     1856#endif
     1857}
     1858
     1859void
     1860purify_range(LispObj *start, LispObj *end, BytePtr low, BytePtr high, area *to)
    18841861{
    18851862  LispObj header;
     
    18961873      } else {
    18971874        if (!nodeheader_tag_p(tag)) {
    1898           copy_ivector_reference(start, low, high, to, what);
     1875          copy_ivector_reference(start, low, high, to);
    18991876        }
    19001877        start++;
    1901         copy_ivector_reference(start, low, high, to, what);
     1878        copy_ivector_reference(start, low, high, to);
    19021879        start++;
    19031880      }
     
    19081885/* Purify references from tstack areas */
    19091886void
    1910 purify_tstack_area(area *a, BytePtr low, BytePtr high, area *to, int what)
     1887purify_tstack_area(area *a, BytePtr low, BytePtr high, area *to)
    19111888{
    19121889  LispObj
     
    19231900    end = ((next >= start) && (next < limit)) ? next : limit;
    19241901    if (current[1] == 0) {
    1925       purify_range(current+2, end, low, high, to, what);
     1902      purify_range(current+2, end, low, high, to);
    19261903    }
    19271904  }
     
    19301907/* Purify a vstack area */
    19311908void
    1932 purify_vstack_area(area *a, BytePtr low, BytePtr high, area *to, int what)
     1909purify_vstack_area(area *a, BytePtr low, BytePtr high, area *to)
    19331910{
    19341911  LispObj
     
    19371914
    19381915  if (((natural)p) & sizeof(natural)) {
    1939     copy_ivector_reference(p, low, high, to, what);
     1916    copy_ivector_reference(p, low, high, to);
    19401917    p++;
    19411918  }
    1942   purify_range(p, q, low, high, to, what);
    1943 }
    1944 
    1945 #ifdef PPC
    1946 void
    1947 purify_cstack_area(area *a, BytePtr low, BytePtr high, area *to, int what)
     1919  purify_range(p, q, low, high, to);
     1920}
     1921
     1922
     1923void
     1924purify_cstack_area(area *a, BytePtr low, BytePtr high, area *to)
    19481925{
    19491926  BytePtr
     
    19581935        (((((lisp_frame *)current)->savefn) == 0) ||
    19591936         (fulltag_of(((lisp_frame *)current)->savefn) == fulltag_misc))) {
    1960       purify_locref(&((lisp_frame *) current)->savelr, low, high, to, what);
     1937      purify_locref(&((lisp_frame *) current)->savelr, low, high, to);
    19611938    } else {
    19621939      /* Clear low bits of "next", just in case */
     
    19651942  }
    19661943}
    1967 #endif
    1968 
    1969 void
    1970 purify_xp(ExceptionInformation *xp, BytePtr low, BytePtr high, area *to, int what)
     1944
     1945void
     1946purify_xp(ExceptionInformation *xp, BytePtr low, BytePtr high, area *to)
    19711947{
    19721948  unsigned long *regs = (unsigned long *) xpGPRvector(xp);
    19731949
    1974 #ifdef PPC
    19751950  int r;
    19761951
     
    19801955
    19811956  for (r = fn; r < 32; r++) {
    1982     copy_ivector_reference((LispObj*) (&(regs[r])), low, high, to, what);
     1957    copy_ivector_reference((LispObj*) (&(regs[r])), low, high, to);
    19831958  };
    19841959
    1985   purify_locref((LispObj*) (&(regs[loc_pc])), low, high, to, what);
    1986 
    1987   purify_locref((LispObj*) (&(xpPC(xp))), low, high, to, what);
    1988   purify_locref((LispObj*) (&(xpLR(xp))), low, high, to, what);
    1989   purify_locref((LispObj*) (&(xpCTR(xp))), low, high, to, what);
    1990 #endif
    1991 
    1992 }
    1993 
    1994 void
    1995 purify_tcr_tlb(TCR *tcr, BytePtr low, BytePtr high, area *to, int what)
     1960  purify_locref((LispObj*) (&(regs[loc_pc])), low, high, to);
     1961
     1962  purify_locref((LispObj*) (&(xpPC(xp))), low, high, to);
     1963  purify_locref((LispObj*) (&(xpLR(xp))), low, high, to);
     1964  purify_locref((LispObj*) (&(xpCTR(xp))), low, high, to);
     1965}
     1966
     1967void
     1968purify_tcr_tlb(TCR *tcr, BytePtr low, BytePtr high, area *to)
    19961969{
    19971970  natural n = tcr->tlb_limit;
    19981971  LispObj *start = tcr->tlb_pointer, *end = (LispObj *) ((BytePtr)start+n);
    19991972
    2000   purify_range(start, end, low, high, to, what);
    2001 }
    2002 
    2003 void
    2004 purify_tcr_xframes(TCR *tcr, BytePtr low, BytePtr high, area *to, int what)
     1973  purify_range(start, end, low, high, to);
     1974}
     1975
     1976void
     1977purify_tcr_xframes(TCR *tcr, BytePtr low, BytePtr high, area *to)
    20051978{
    20061979  xframe_list *xframes;
     
    20091982  xp = tcr->gc_context;
    20101983  if (xp) {
    2011     purify_xp(xp, low, high, to, what);
     1984    purify_xp(xp, low, high, to);
    20121985  }
    20131986
    20141987  for (xframes = tcr->xframe; xframes; xframes = xframes->prev) {
    2015     purify_xp(xframes->curr, low, high, to, what);
    2016   }
    2017 }
    2018 
    2019 
    2020 void
    2021 purify_areas(BytePtr low, BytePtr high, area *target, int what)
     1988    purify_xp(xframes->curr, low, high, to);
     1989  }
     1990}
     1991
     1992void
     1993purify_gcable_ptrs(BytePtr low, BytePtr high, area *to)
     1994{
     1995  LispObj *prev = &(lisp_global(GCABLE_POINTERS)), next;
     1996
     1997  while ((*prev) != (LispObj)NULL) {
     1998    copy_ivector_reference(prev, low, high, to);
     1999    next = *prev;
     2000    prev = &(((xmacptr *)ptr_from_lispobj(untag(next)))->link);
     2001  }
     2002}
     2003
     2004
     2005void
     2006purify_areas(BytePtr low, BytePtr high, area *target)
    20222007{
    20232008  area *next_area;
     
    20272012    switch (code) {
    20282013    case AREA_TSTACK:
    2029       purify_tstack_area(next_area, low, high, target, what);
     2014      purify_tstack_area(next_area, low, high, target);
    20302015      break;
    20312016     
    20322017    case AREA_VSTACK:
    2033       purify_vstack_area(next_area, low, high, target, what);
     2018      purify_vstack_area(next_area, low, high, target);
    20342019      break;
    20352020     
    20362021    case AREA_CSTACK:
    2037 #ifdef PPC
    2038       purify_cstack_area(next_area, low, high, target, what);
    2039 #endif
     2022      purify_cstack_area(next_area, low, high, target);
    20402023      break;
    20412024     
    20422025    case AREA_STATIC:
    20432026    case AREA_DYNAMIC:
    2044       purify_range((LispObj *) next_area->low, (LispObj *) next_area->active, low, high, target, what);
     2027      purify_range((LispObj *) next_area->low, (LispObj *) next_area->active, low, high, target);
    20452028      break;
    20462029     
     
    20802063    lisp_global(IN_GC) = (1<<fixnumshift);
    20812064
    2082     /*
    2083       First, loop thru *all-packages* and purify the pnames of all
    2084       interned symbols.  Then walk every place that could reference
    2085       a heap-allocated object (all_areas, the xframe_list) and
    2086       purify code_vectors (and update the odd case of a shared
    2087       reference to a pname.)
    2088        
    2089       Make the new_pure_area executable, just in case.
    2090 
    2091       Caller will typically GC again (and that should recover quite a bit of
    2092       the dynamic heap.)
    2093       */
    2094 
    2095     {
    2096       lispsymbol *rawsym = (lispsymbol *)(&(nrs_ALL_PACKAGES));
    2097       LispObj pkg_list = rawsym->vcell, htab, obj;
    2098       package *p;
    2099       cons *c;
    2100       natural elements, i;
    2101 
    2102       while (fulltag_of(pkg_list) == fulltag_cons) {
    2103         c = (cons *) ptr_from_lispobj(untag(pkg_list));
    2104         p = (package *) ptr_from_lispobj(untag(c->car));
    2105         pkg_list = c->cdr;
    2106         c = (cons *) ptr_from_lispobj(untag(p->itab));
    2107         htab = c->car;
    2108         elements = header_element_count(header_of(htab));
    2109         for (i = 1; i<= elements; i++) {
    2110           obj = deref(htab,i);
    2111           if (fulltag_of(obj) == fulltag_misc) {
    2112             rawsym = (lispsymbol *) ptr_from_lispobj(untag(obj));
    2113             copy_ivector_reference(&(rawsym->pname), a->low, a->active, new_pure_area, COPY_STRINGS);
    2114           }
    2115         }
    2116         c = (cons *) ptr_from_lispobj(untag(p->etab));
    2117         htab = c->car;
    2118         elements = header_element_count(header_of(htab));
    2119         for (i = 1; i<= elements; i++) {
    2120           obj = deref(htab,i);
    2121           if (fulltag_of(obj) == fulltag_misc) {
    2122             rawsym = (lispsymbol *) ptr_from_lispobj(untag(obj));
    2123             copy_ivector_reference(&(rawsym->pname), a->low, a->active, new_pure_area, COPY_STRINGS);
    2124           }
    2125         }
    2126       }
    2127     }
    21282065   
    2129     purify_areas(a->low, a->active, new_pure_area, COPY_CODE);
     2066    purify_areas(a->low, a->active, new_pure_area);
    21302067   
    21312068    other_tcr = tcr;
    21322069    do {
    2133       purify_tcr_xframes(other_tcr, a->low, a->active, new_pure_area, COPY_CODE);
    2134       purify_tcr_tlb(other_tcr, a->low, a->active, new_pure_area, COPY_CODE);
     2070      purify_tcr_xframes(other_tcr, a->low, a->active, new_pure_area);
     2071      purify_tcr_tlb(other_tcr, a->low, a->active, new_pure_area);
    21352072      other_tcr = other_tcr->next;
    21362073    } while (other_tcr != tcr);
    21372074
     2075    purify_gcable_ptrs(a->low, a->active, new_pure_area);
    21382076
    21392077    {
     
    23532291}
    23542292
     2293void
     2294impurify_gcable_ptrs(LispObj low, LispObj high, signed_natural delta)
     2295{
     2296  LispObj *prev = &(lisp_global(GCABLE_POINTERS)), next;
     2297
     2298  while ((*prev) != (LispObj)NULL) {
     2299    impurify_noderef(prev, low, high, delta);
     2300    next = *prev;
     2301    prev = &(((xmacptr *)ptr_from_lispobj(untag(next)))->link);
     2302  }
     2303}
     2304
    23552305int
    23562306impurify(TCR *tcr, signed_natural param)
    23572307{
    2358   area *r = find_readonly_area();
     2308  area *r = readonly_area;
    23592309
    23602310  if (r) {
     
    23882338        other_tcr = other_tcr->next;
    23892339      } while (other_tcr != tcr);
     2340
     2341      impurify_gcable_ptrs(ptr_to_lispobj(ro_base), ptr_to_lispobj(ro_limit), delta);
    23902342      lisp_global(IN_GC) = 0;
    23912343    }
Note: See TracChangeset for help on using the changeset viewer.