Changeset 9990


Ignore:
Timestamp:
Jul 10, 2008, 9:58:33 AM (11 years ago)
Author:
gb
Message:

From trunk: purify all ivectors (except MACPTRs).

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/working-0711/ccl/lisp-kernel/x86-gc.c

    r7680 r9990  
    2525#include <string.h>
    2626#include <sys/time.h>
    27 
    28 #ifndef timeradd
    29 # define timeradd(a, b, result)                                               \
    30   do {                                                                        \
    31     (result)->tv_sec = (a)->tv_sec + (b)->tv_sec;                             \
    32     (result)->tv_usec = (a)->tv_usec + (b)->tv_usec;                          \
    33     if ((result)->tv_usec >= 1000000)                                         \
    34       {                                                                       \
    35         ++(result)->tv_sec;                                                   \
    36         (result)->tv_usec -= 1000000;                                         \
    37       }                                                                       \
    38   } while (0)
    39 #endif
    40 #ifndef timersub
    41 # define timersub(a, b, result)                                               \
    42   do {                                                                        \
    43     (result)->tv_sec = (a)->tv_sec - (b)->tv_sec;                             \
    44     (result)->tv_usec = (a)->tv_usec - (b)->tv_usec;                          \
    45     if ((result)->tv_usec < 0) {                                              \
    46       --(result)->tv_sec;                                                     \
    47       (result)->tv_usec += 1000000;                                           \
    48     }                                                                         \
    49   } while (0)
    50 #endif
    5127
    5228
     
    168144check_range(LispObj *start, LispObj *end, Boolean header_allowed)
    169145{
    170   LispObj node, *current = start, *prev;
     146  LispObj node, *current = start, *prev = NULL;
    171147  int tag;
    172148  natural elements;
     
    349325          ((hash_table_vector_header *) base)->cache_key = undefined;
    350326          ((hash_table_vector_header *) base)->cache_value = lisp_nil;
     327          mark_weak_htabv(n);
     328          return;
    351329        }
    352         deref(ptr_to_lispobj(base),1) = GCweakvll;
    353         GCweakvll = n;
    354         return;
    355330      }
    356331
    357332      if (subtag == subtag_pool) {
    358         deref(ptr_to_lispobj(base), 1) = lisp_nil;
     333        deref(base, 1) = lisp_nil;
    359334      }
    360335     
     
    438413  int tag_n = fulltag_of(n);
    439414  bitvector markbits = GCmarkbits;
    440   natural dnode, bits, *bitsp, mask, original_n = n;
     415  natural dnode, bits, *bitsp, mask;
    441416
    442417  if (!is_node_fulltag(tag_n)) {
     
    518493          ((hash_table_vector_header *) base)->cache_key = undefined;
    519494          ((hash_table_vector_header *) base)->cache_value = lisp_nil;
     495          mark_weak_htabv(n);
     496          return;
    520497        }
    521         deref(ptr_to_lispobj(base),1) = GCweakvll;
    522         GCweakvll = n;
    523         return;
    524498      }
    525499
     
    758732        ((hash_table_vector_header *) base)->cache_key = undefined;
    759733        ((hash_table_vector_header *) base)->cache_value = lisp_nil;
    760       }
    761 
    762       deref(ptr_to_lispobj(base),1) = GCweakvll;
    763       GCweakvll = this;
    764       goto Climb;
     734        dws_mark_weak_htabv(this);
     735        element_count = hash_table_vector_header_count;
     736      }
    765737    }
    766738
     
    1023995          ((hash_table_vector_header *) start)->cache_key = undefined;
    1024996          ((hash_table_vector_header *) start)->cache_value = lisp_nil;
    1025         }
    1026 
    1027         start[1] = GCweakvll;
    1028         GCweakvll = (LispObj) (((natural) start) + fulltag_misc);
    1029       } else {
    1030 
    1031         if (subtag == subtag_pool) {
    1032           start[1] = lisp_nil;
    1033         }
    1034 
    1035         if (subtag == subtag_weak) {
    1036           natural weak_type = (natural) start[2];
    1037           if (weak_type >> population_termination_bit)
    1038             element_count -= 2;
    1039           else
    1040             element_count -= 1;
    1041           start[1] = GCweakvll;
    1042           GCweakvll = (LispObj) (((natural) start) + fulltag_misc);   
    1043         }
    1044 
    1045         base = start + element_count + 1;
    1046         if (subtag == subtag_function) {
    1047           element_count -= (int)start[1];
     997          mark_weak_htabv((LispObj)start);
     998          element_count = 0;
    1048999        }
    1049         while(element_count--) {
    1050           mark_root(*--base);
    1051         }
     1000      }
     1001      if (subtag == subtag_pool) {
     1002        start[1] = lisp_nil;
     1003      }
     1004
     1005      if (subtag == subtag_weak) {
     1006        natural weak_type = (natural) start[2];
     1007        if (weak_type >> population_termination_bit)
     1008          element_count -= 2;
     1009        else
     1010          element_count -= 1;
     1011        start[1] = GCweakvll;
     1012        GCweakvll = (LispObj) (((natural) start) + fulltag_misc);   
     1013      }
     1014
     1015      base = start + element_count + 1;
     1016      if (subtag == subtag_function) {
     1017        element_count -= (int)start[1];
     1018      }
     1019      while(element_count--) {
     1020        mark_root(*--base);
    10521021      }
    10531022      start += size;
     
    13221291      if ((header_subtag(node) == subtag_hash_vector) &&
    13231292          ((((hash_table_vector_header *)p)->flags) & nhash_track_keys_mask)) {
    1324         natural skip = (sizeof(hash_table_vector_header)/sizeof(LispObj))-1;
     1293        natural skip = hash_table_vector_header_count-1;
    13251294        hashp = (hash_table_vector_header *) p;
    13261295        p++;
     
    14711440  int tag;
    14721441  bitvector markbits = GCmarkbits;
    1473     /* keep track of whether or not we saw any
    1474        code_vector headers, and only flush cache if so. */
    1475   Boolean GCrelocated_code_vector = false;
    14761442
    14771443  if (dnode < GCndnodes_in_area) {
     
    16871653    new;
    16881654  natural
    1689     subtag = header_subtag(header),
    1690     element_count = header_element_count(header),
     1655    start = (natural)old,
    16911656    physbytes;
    16921657
    1693   switch(subtag) {
    1694   case subtag_simple_base_string:
    1695     physbytes = node_size + (element_count << 2);
    1696     break;
    1697 
    1698 #ifndef X86
    1699   case subtag_code_vector:
    1700     physbytes = node_size + (element_count << 2);
    1701     break;
    1702 #endif
    1703 
    1704   default:
    1705     Bug(NULL, "Can't purify object at 0x%08x", obj);
    1706     return obj;
    1707   }
    1708   physbytes = (physbytes+(dnode_size-1))&~(dnode_size-1);
     1658  physbytes = ((natural)(skip_over_ivector(start,header))) - start;
     1659
    17091660  dest->active += physbytes;
    17101661
     
    17371688
    17381689
    1739 #define FORWARD_ONLY 0
    1740 #define COPY_CODE (1<<0)
    1741 #define COPY_STRINGS (1<<1)
    17421690
    17431691
     
    17941742
    17951743Boolean
    1796 copy_ivector_reference(LispObj *ref, BytePtr low, BytePtr high, area *dest, int what_to_copy)
     1744copy_ivector_reference(LispObj *ref, BytePtr low, BytePtr high, area *dest)
    17971745{
    17981746  LispObj obj = *ref, header, new;
    1799   natural tag = fulltag_of(obj), header_tag, header_subtag;
     1747  natural tag = fulltag_of(obj), header_tag;
    18001748  Boolean changed = false;
    18011749
     
    18101758      header_tag = fulltag_of(header);
    18111759      if (immheader_tag_p(header_tag)) {
    1812         header_subtag = header_subtag(header);
    1813         if ((what_to_copy & COPY_STRINGS) &&
    1814             ((header_subtag == subtag_simple_base_string))) {
     1760        if (header_subtag(header) != subtag_macptr) {
    18151761          new = purify_object(obj, dest);
    18161762          *ref = new;
     
    18241770
    18251771
    1826 void purify_headerless_range(LispObj *start, LispObj *end, BytePtr low, BytePtr high, area *to, int what)
     1772void
     1773purify_gcable_ptrs(BytePtr low, BytePtr high, area *to)
     1774{
     1775  LispObj *prev = &(lisp_global(GCABLE_POINTERS)), next;
     1776
     1777  while ((*prev) != (LispObj)NULL) {
     1778    copy_ivector_reference(prev, low, high, to);
     1779    next = *prev;
     1780    prev = &(((xmacptr *)ptr_from_lispobj(untag(next)))->link);
     1781  }
     1782}
     1783
     1784void
     1785purify_headerless_range(LispObj *start, LispObj *end, BytePtr low, BytePtr high, area *to)
    18271786{
    18281787  while (start < end) {
    1829     copy_ivector_reference(start, low, high, to, what);
     1788    copy_ivector_reference(start, low, high, to);
    18301789    start++;
    18311790  }
     
    18331792   
    18341793void
    1835 purify_range(LispObj *start, LispObj *end, BytePtr low, BytePtr high, area *to, int what)
     1794purify_range(LispObj *start, LispObj *end, BytePtr low, BytePtr high, area *to)
    18361795{
    18371796  LispObj header;
     
    18601819          nwords -= skip;
    18611820          while(skip--) {
    1862             copy_ivector_reference(start, low, high, to, what);
     1821            copy_ivector_reference(start, low, high, to);
    18631822            start++;
    18641823          }
     
    18691828          nwords >>= 1;
    18701829          while(nwords--) {
    1871             if (copy_ivector_reference(start, low, high, to, what) && hashp) {
     1830            if (copy_ivector_reference(start, low, high, to) && hashp) {
    18721831              hashp->flags |= nhash_key_moved_mask;
    18731832              hashp = NULL;
    18741833            }
    18751834            start++;
    1876             copy_ivector_reference(start, low, high, to, what);
     1835            copy_ivector_reference(start, low, high, to);
    18771836            start++;
    18781837          }
     
    18861845          start++;
    18871846          while(nwords--) {
    1888             copy_ivector_reference(start, low, high, to, what);
     1847            copy_ivector_reference(start, low, high, to);
    18891848            start++;
    18901849          }
     
    18921851      } else {
    18931852        /* Not a header, just a cons cell */
    1894         copy_ivector_reference(start, low, high, to, what);
     1853        copy_ivector_reference(start, low, high, to);
    18951854        start++;
    1896         copy_ivector_reference(start, low, high, to, what);
     1855        copy_ivector_reference(start, low, high, to);
    18971856        start++;
    18981857      }
     
    19031862/* Purify references from tstack areas */
    19041863void
    1905 purify_tstack_area(area *a, BytePtr low, BytePtr high, area *to, int what)
     1864purify_tstack_area(area *a, BytePtr low, BytePtr high, area *to)
    19061865{
    19071866  LispObj
     
    19171876    next = (LispObj *) ptr_from_lispobj(*current);
    19181877    end = ((next >= start) && (next < limit)) ? next : limit;
    1919     if (current[1] == 0) {
    1920       purify_range(current+2, end, low, high, to, what);
    1921     }
     1878    purify_range(current+2, end, low, high, to);
    19221879  }
    19231880}
     
    19251882/* Purify a vstack area */
    19261883void
    1927 purify_vstack_area(area *a, BytePtr low, BytePtr high, area *to, int what)
     1884purify_vstack_area(area *a, BytePtr low, BytePtr high, area *to)
    19281885{
    19291886  LispObj
     
    19311888    *q = (LispObj *) a->high;
    19321889 
    1933   purify_headerless_range(p, q, low, high, to, what);
    1934 }
    1935 
    1936 
    1937 void
    1938 purify_xp(ExceptionInformation *xp, BytePtr low, BytePtr high, area *to, int what)
     1890  purify_headerless_range(p, q, low, high, to);
     1891}
     1892
     1893
     1894void
     1895purify_xp(ExceptionInformation *xp, BytePtr low, BytePtr high, area *to)
    19391896{
    19401897  natural *regs = (natural *) xpGPRvector(xp);
     
    19421899
    19431900#ifdef X8664
    1944   copy_ivector_reference(&(regs[Iarg_z]), low, high, to, what);
    1945   copy_ivector_reference(&(regs[Iarg_y]), low, high, to, what);
    1946   copy_ivector_reference(&(regs[Iarg_x]), low, high, to, what);
    1947   copy_ivector_reference(&(regs[Isave3]), low, high, to, what);
    1948   copy_ivector_reference(&(regs[Isave2]), low, high, to, what);
    1949   copy_ivector_reference(&(regs[Isave1]), low, high, to, what);
    1950   copy_ivector_reference(&(regs[Isave0]), low, high, to, what);
    1951   copy_ivector_reference(&(regs[Ifn]), low, high, to, what);
    1952   copy_ivector_reference(&(regs[Itemp0]), low, high, to, what);
    1953   copy_ivector_reference(&(regs[Itemp1]), low, high, to, what);
    1954   copy_ivector_reference(&(regs[Itemp2]), low, high, to, what);
     1901  copy_ivector_reference(&(regs[Iarg_z]), low, high, to);
     1902  copy_ivector_reference(&(regs[Iarg_y]), low, high, to);
     1903  copy_ivector_reference(&(regs[Iarg_x]), low, high, to);
     1904  copy_ivector_reference(&(regs[Isave3]), low, high, to);
     1905  copy_ivector_reference(&(regs[Isave2]), low, high, to);
     1906  copy_ivector_reference(&(regs[Isave1]), low, high, to);
     1907  copy_ivector_reference(&(regs[Isave0]), low, high, to);
     1908  copy_ivector_reference(&(regs[Ifn]), low, high, to);
     1909  copy_ivector_reference(&(regs[Itemp0]), low, high, to);
     1910  copy_ivector_reference(&(regs[Itemp1]), low, high, to);
     1911  copy_ivector_reference(&(regs[Itemp2]), low, high, to);
    19551912#if 0
    1956   purify_locref(&(regs[Iip]), low, high, to, what);
     1913  purify_locref(&(regs[Iip]), low, high, to);
    19571914#endif
    19581915#else
     
    19611918
    19621919void
    1963 purify_tcr_tlb(TCR *tcr, BytePtr low, BytePtr high, area *to, int what)
     1920purify_tcr_tlb(TCR *tcr, BytePtr low, BytePtr high, area *to)
    19641921{
    19651922  natural n = tcr->tlb_limit;
    19661923  LispObj *start = tcr->tlb_pointer, *end = (LispObj *) ((BytePtr)start+n);
    19671924
    1968   purify_range(start, end, low, high, to, what);
    1969 }
    1970 
    1971 void
    1972 purify_tcr_xframes(TCR *tcr, BytePtr low, BytePtr high, area *to, int what)
     1925  purify_range(start, end, low, high, to);
     1926}
     1927
     1928void
     1929purify_tcr_xframes(TCR *tcr, BytePtr low, BytePtr high, area *to)
    19731930{
    19741931  xframe_list *xframes;
     
    19771934  xp = tcr->gc_context;
    19781935  if (xp) {
    1979     purify_xp(xp, low, high, to, what);
     1936    purify_xp(xp, low, high, to);
    19801937  }
    19811938
    19821939  for (xframes = tcr->xframe; xframes; xframes = xframes->prev) {
    1983     purify_xp(xframes->curr, low, high, to, what);
    1984   }
    1985 }
    1986 
    1987 
    1988 void
    1989 purify_areas(BytePtr low, BytePtr high, area *target, int what)
     1940    purify_xp(xframes->curr, low, high, to);
     1941  }
     1942}
     1943
     1944
     1945void
     1946purify_areas(BytePtr low, BytePtr high, area *target)
    19901947{
    19911948  area *next_area;
     
    19951952    switch (code) {
    19961953    case AREA_TSTACK:
    1997       purify_tstack_area(next_area, low, high, target, what);
     1954      purify_tstack_area(next_area, low, high, target);
    19981955      break;
    19991956     
    20001957    case AREA_VSTACK:
    2001       purify_vstack_area(next_area, low, high, target, what);
     1958      purify_vstack_area(next_area, low, high, target);
    20021959      break;
    20031960     
    20041961    case AREA_CSTACK:
    2005 #ifdef PPC
    2006       purify_cstack_area(next_area, low, high, target, what);
    2007 #endif
    20081962      break;
    20091963     
    20101964    case AREA_STATIC:
    20111965    case AREA_DYNAMIC:
    2012       purify_range((LispObj *) next_area->low, (LispObj *) next_area->active, low, high, target, what);
     1966      purify_range((LispObj *) next_area->low, (LispObj *) next_area->active, low, high, target);
    20131967      break;
    20141968     
     
    20371991  TCR  *other_tcr;
    20381992  natural max_pure_size;
    2039   OSErr err;
    20401993  BytePtr new_pure_start;
    20411994
    20421995
    20431996
    2044   max_pure_size = interned_pname_bytes_in_range((LispObj *)(a->low + (static_dnodes_for_area(a) << dnode_shift)),
     1997  max_pure_size = unboxed_bytes_in_range((LispObj *)(a->low + (static_dnodes_for_area(a) << dnode_shift)),
    20451998                                         (LispObj *) a->active);
    20461999  new_pure_area = extend_readonly_area(max_pure_size);
     
    20502003
    20512004    /*
    2052       First, loop thru *all-packages* and purify the pnames of all
    2053       interned symbols.  Then walk every place that could reference
    2054       a heap-allocated object (all_areas, the xframe_list) and
    2055       purify code_vectors (and update the odd case of a shared
    2056       reference to a pname.)
     2005
    20572006       
    20582007      Make the new_pure_area executable, just in case.
     
    20622011      */
    20632012
    2064     {
    2065       lispsymbol *rawsym = (lispsymbol *)(&(nrs_ALL_PACKAGES));
    2066       LispObj pkg_list = rawsym->vcell, htab, obj;
    2067       package *p;
    2068       cons *c;
    2069       natural elements, i;
    2070 
    2071       while (fulltag_of(pkg_list) == fulltag_cons) {
    2072         c = (cons *) ptr_from_lispobj(untag(pkg_list));
    2073         p = (package *) ptr_from_lispobj(untag(c->car));
    2074         pkg_list = c->cdr;
    2075         c = (cons *) ptr_from_lispobj(untag(p->itab));
    2076         htab = c->car;
    2077         elements = header_element_count(header_of(htab));
    2078         for (i = 1; i<= elements; i++) {
    2079           obj = deref(htab,i);
    2080           if (fulltag_of(obj) == fulltag_symbol) {
    2081             rawsym = (lispsymbol *) ptr_from_lispobj(untag(obj));
    2082             copy_ivector_reference(&(rawsym->pname), a->low, a->active, new_pure_area, COPY_STRINGS);
    2083           }
    2084         }
    2085         c = (cons *) ptr_from_lispobj(untag(p->etab));
    2086         htab = c->car;
    2087         elements = header_element_count(header_of(htab));
    2088         for (i = 1; i<= elements; i++) {
    2089           obj = deref(htab,i);
    2090           if (fulltag_of(obj) == fulltag_symbol) {
    2091             rawsym = (lispsymbol *) ptr_from_lispobj(untag(obj));
    2092             copy_ivector_reference(&(rawsym->pname), a->low, a->active, new_pure_area, COPY_STRINGS);
    2093           }
    2094         }
    2095       }
    2096     }
     2013
    20972014   
    2098     purify_areas(a->low, a->active, new_pure_area, FORWARD_ONLY);
     2015    purify_areas(a->low, a->active, new_pure_area);
    20992016   
    21002017    other_tcr = tcr;
    21012018    do {
    2102       purify_tcr_xframes(other_tcr, a->low, a->active, new_pure_area, FORWARD_ONLY);
    2103       purify_tcr_tlb(other_tcr, a->low, a->active, new_pure_area, FORWARD_ONLY);
     2019      purify_tcr_xframes(other_tcr, a->low, a->active, new_pure_area);
     2020      purify_tcr_tlb(other_tcr, a->low, a->active, new_pure_area);
    21042021      other_tcr = other_tcr->next;
    21052022    } while (other_tcr != tcr);
    21062023
    2107 
     2024    purify_gcable_ptrs(a->low, a->active, new_pure_area);
    21082025    {
    21092026      natural puresize = (unsigned) (new_pure_area->active-new_pure_start);
     
    21402057 
    21412058
    2142 
    2143 void
    2144 impurify_xp(ExceptionInformation *xp, LispObj low, LispObj high, int delta)
     2059void
     2060impurify_gcable_ptrs(LispObj low, LispObj high, signed_natural delta)
     2061{
     2062  LispObj *prev = &(lisp_global(GCABLE_POINTERS)), next;
     2063
     2064  while ((*prev) != (LispObj)NULL) {
     2065    impurify_noderef(prev, low, high, delta);
     2066    next = *prev;
     2067    prev = &(((xmacptr *)ptr_from_lispobj(untag(next)))->link);
     2068  }
     2069}
     2070
     2071
     2072void
     2073impurify_xp(ExceptionInformation *xp, LispObj low, LispObj high, signed_natural delta)
    21452074{
    21462075  natural *regs = (natural *) xpGPRvector(xp);
     
    21672096
    21682097void
    2169 impurify_headerless_range(LispObj *start, LispObj *end, LispObj low, LispObj high, int delta)
     2098impurify_headerless_range(LispObj *start, LispObj *end, LispObj low, LispObj high, signed_natural delta)
    21702099{
    21712100  while (start < end) {
     
    21772106
    21782107void
    2179 impurify_range(LispObj *start, LispObj *end, LispObj low, LispObj high, int delta)
     2108impurify_range(LispObj *start, LispObj *end, LispObj low, LispObj high, signed_natural delta)
    21802109{
    21812110  LispObj header;
     
    22492178
    22502179void
    2251 impurify_tcr_tlb(TCR *tcr,  LispObj low, LispObj high, int delta)
     2180impurify_tcr_tlb(TCR *tcr,  LispObj low, LispObj high, signed_natural delta)
    22522181{
    22532182  unsigned n = tcr->tlb_limit;
     
    22582187
    22592188void
    2260 impurify_tcr_xframes(TCR *tcr, LispObj low, LispObj high, int delta)
     2189impurify_tcr_xframes(TCR *tcr, LispObj low, LispObj high, signed_natural delta)
    22612190{
    22622191  xframe_list *xframes;
     
    22742203
    22752204void
    2276 impurify_tstack_area(area *a, LispObj low, LispObj high, int delta)
     2205impurify_tstack_area(area *a, LispObj low, LispObj high, signed_natural delta)
    22772206{
    22782207  LispObj
     
    22942223}
    22952224void
    2296 impurify_vstack_area(area *a, LispObj low, LispObj high, int delta)
     2225impurify_vstack_area(area *a, LispObj low, LispObj high, signed_natural delta)
    22972226{
    22982227  LispObj
     
    23052234
    23062235void
    2307 impurify_areas(LispObj low, LispObj high, int delta)
     2236impurify_areas(LispObj low, LispObj high, signed_natural delta)
    23082237{
    23092238  area *next_area;
     
    23212250     
    23222251    case AREA_CSTACK:
    2323 #ifdef PPC
    2324       impurify_cstack_area(next_area, low, high, delta);
    2325 #endif
    23262252      break;
    23272253     
     
    23372263}
    23382264
     2265#ifdef WINDOWS
     2266int
     2267impurify(TCR *tcr, signed_natural param)
     2268{
     2269}
     2270#else
    23392271int
    23402272impurify(TCR *tcr, signed_natural param)
     
    23472279      oldhigh = a->high, newhigh;
    23482280    unsigned n = ro_limit - ro_base;
    2349     int delta = oldfree-ro_base;
     2281    signed_natural delta = oldfree-ro_base;
    23502282    TCR *other_tcr;
    23512283
     
    23722304        other_tcr = other_tcr->next;
    23732305      } while (other_tcr != tcr);
     2306
     2307      impurify_gcable_ptrs(ptr_to_lispobj(ro_base), ptr_to_lispobj(ro_limit), delta);
    23742308      lisp_global(IN_GC) = 0;
    23752309    }
     
    23782312  return -1;
    23792313}
     2314#endif
Note: See TracChangeset for help on using the changeset viewer.