/[cmucl]/src/lisp/gencgc.c
ViewVC logotype

Diff of /src/lisp/gencgc.c

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.70.2.1 by rtoy, Fri Jun 9 16:05:19 2006 UTC revision 1.112 by rtoy, Sun Jan 9 00:12:36 2011 UTC
# Line 11  Line 11 
11   *   *
12   */   */
13    
14    #include <limits.h>
15  #include <stdio.h>  #include <stdio.h>
16  #include <stdlib.h>  #include <stdlib.h>
17  #include <signal.h>  #include <signal.h>
# Line 26  Line 27 
27  #include "interr.h"  #include "interr.h"
28  #include "gencgc.h"  #include "gencgc.h"
29    
30    /*
31     * This value in a hash table hash-vector means that the key uses
32     * EQ-based hashing.  That is, the key might be using EQ or EQL for
33     * the test.  This MUST match the value used in hash-new.lisp!
34     */
35    #define EQ_BASED_HASH_VALUE     0x80000000
36    
37  #define gc_abort() lose("GC invariant lost!  File \"%s\", line %d\n", \  #define gc_abort() lose("GC invariant lost!  File \"%s\", line %d\n", \
38                          __FILE__, __LINE__)                          __FILE__, __LINE__)
# Line 101  Line 108 
108  #define set_current_region_end(value) \  #define set_current_region_end(value) \
109    SetSymbolValue(CURRENT_REGION_END_ADDR, (value))    SetSymbolValue(CURRENT_REGION_END_ADDR, (value))
110    
111  #elif defined(DARWIN)  #elif defined(DARWIN) && defined(__ppc__)
112  #ifndef pseudo_atomic_InterruptedValue  #ifndef pseudo_atomic_InterruptedValue
113  #define pseudo_atomic_InterruptedValue 1  #define pseudo_atomic_InterruptedValue 1
114  #endif  #endif
# Line 143  Line 150 
150    
151  /* Define for activating assertions.  */  /* Define for activating assertions.  */
152    
153  #if defined(DARWIN)  #if defined(x86) && defined(SOLARIS)
154  #define GC_ASSERTIONS 1  #define GC_ASSERTIONS 1
155  #endif  #endif
156    
# Line 156  static void *invalid_stack_start, *inval Line 163  static void *invalid_stack_start, *inval
163  static inline void  static inline void
164  check_escaped_stack_object(lispobj * where, lispobj obj)  check_escaped_stack_object(lispobj * where, lispobj obj)
165  {  {
166  #ifndef DARWIN  #if !defined(DARWIN) && !defined(__ppc__)
167      void *p;      void *p;
168    
169      if (Pointerp(obj)      if (Pointerp(obj)
# Line 237  unsigned gencgc_verbose = 0; Line 244  unsigned gencgc_verbose = 0;
244  unsigned counters_verbose = 0;  unsigned counters_verbose = 0;
245    
246  /*  /*
247     * If true, then some debugging information is printed when scavenging
248     * static (malloc'ed) arrays.
249     */
250    boolean debug_static_array_p = 0;
251    
252    /*
253   * To enable the use of page protection to help avoid the scavenging   * To enable the use of page protection to help avoid the scavenging
254   * of pages that don't have pointers to younger generations.   * of pages that don't have pointers to younger generations.
255   */   */
# Line 311  boolean gencgc_zero_check_during_free_he Line 324  boolean gencgc_zero_check_during_free_he
324  /*  /*
325   * The minimum size for a large object.   * The minimum size for a large object.
326   */   */
327  unsigned large_object_size = 4 * PAGE_SIZE;  unsigned large_object_size = 4 * GC_PAGE_SIZE;
328    
329  /*  /*
330   * Enable the filtering of stack/register pointers. This could reduce   * Enable the filtering of stack/register pointers. This could reduce
# Line 378  static char *heap_base = NULL; Line 391  static char *heap_base = NULL;
391  /*  /*
392   * Calculate the start address for the given page number.   * Calculate the start address for the given page number.
393   */   */
394  inline char *  static char *
395  page_address(int page_num)  page_address(int page_num)
396  {  {
397      return heap_base + PAGE_SIZE * page_num;      return heap_base + GC_PAGE_SIZE * page_num;
398  }  }
399    
400  /*  /*
401   * Find the page index within the page_table for the given address.   * Find the page index within the page_table for the given address.
402   * Returns -1 on failure.   * Returns -1 on failure.
403   */   */
404  inline int  int
405  find_page_index(void *addr)  find_page_index(void *addr)
406  {  {
407      int index = (char *) addr - heap_base;      int index = (char *) addr - heap_base;
408    
409      if (index >= 0) {      if (index >= 0) {
410          index = (unsigned int) index / PAGE_SIZE;          index = (unsigned int) index / GC_PAGE_SIZE;
411          if (index < dynamic_space_pages)          if (index < dynamic_space_pages)
412              return index;              return index;
413      }      }
# Line 402  find_page_index(void *addr) Line 415  find_page_index(void *addr)
415      return -1;      return -1;
416  }  }
417    
418    /*
419     * This routine implements a write barrier used to record stores into
420     * to boxed regions outside of generation 0.  When such a store occurs
421     * this routine will be automatically invoked by the page fault
422     * handler.  If passed an address outside of the dynamic space, this
423     * routine will return immediately with a value of 0.  Otherwise, the
424     * page belonging to the address is made writable, the protection
425     * change is recorded in the garbage collector page table, and a value
426     * of 1 is returned.
427     */
428    int
429    gc_write_barrier(void *addr)
430    {
431        int page_index = find_page_index(addr);
432    
433        /* Check if the fault is within the dynamic space. */
434        if (page_index == -1) {
435             return 0;
436        }
437    
438        /* The page should have been marked write protected */
439        if (!PAGE_WRITE_PROTECTED(page_index))
440             fprintf(stderr,
441                     "*** Page fault in page not marked as write protected\n");
442    
443        /* Un-protect the page */
444        os_protect((os_vm_address_t) page_address(page_index), GC_PAGE_SIZE, OS_VM_PROT_ALL);
445        page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK;
446        page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK;
447    
448        return 1;
449    }
450    
451  /*  /*
452   * A structure to hold the state of a generation.   * A structure to hold the state of a generation.
# Line 505  unsigned int gencgc_oldest_gen_to_gc = N Line 550  unsigned int gencgc_oldest_gen_to_gc = N
550   * ALLOCATION_POINTER which is used by the room function to limit its   * ALLOCATION_POINTER which is used by the room function to limit its
551   * search of the heap. XX Gencgc obviously needs to be better   * search of the heap. XX Gencgc obviously needs to be better
552   * integrated with the lisp code.   * integrated with the lisp code.
553     *
554     * Except on sparc and ppc, there's no ALLOCATION_POINTER, so it's
555     * never updated.  So make this available (non-static).
556   */   */
557  static int last_free_page;  int last_free_page;
558    
559    
560    static void scan_weak_tables(void);
561    static void scan_weak_objects(void);
562    
563  /*  /*
564   * Misc. heap functions.   * Misc. heap functions.
# Line 618  print_generation_stats(int verbose) Line 668  print_generation_stats(int verbose)
668    
669  #if defined(i386) || defined(__x86_64)  #if defined(i386) || defined(__x86_64)
670  #define FPU_STATE_SIZE 27  #define FPU_STATE_SIZE 27
671        /*
672         * Need 512 byte area, aligned on a 16-byte boundary.  So allocate
673         * 512+16 bytes of space and let the routine adjust use the
674         * appropriate alignment.
675         */
676    #define SSE_STATE_SIZE ((512+16)/4)
677      int fpu_state[FPU_STATE_SIZE];      int fpu_state[FPU_STATE_SIZE];
678        int sse_state[SSE_STATE_SIZE];
679    
680        extern void sse_save(void *);
681        extern void sse_restore(void *);
682  #elif defined(sparc)  #elif defined(sparc)
683      /*      /*
684       * 32 (single-precision) FP registers, and the FP state register.       * 32 (single-precision) FP registers, and the FP state register.
# Line 628  print_generation_stats(int verbose) Line 688  print_generation_stats(int verbose)
688       */       */
689  #define FPU_STATE_SIZE (((32 + 32 + 1) + 1)/2)  #define FPU_STATE_SIZE (((32 + 32 + 1) + 1)/2)
690      long long fpu_state[FPU_STATE_SIZE];      long long fpu_state[FPU_STATE_SIZE];
691  #elif defined(DARWIN)  #elif defined(DARWIN) && defined(__ppc__)
692  #define FPU_STATE_SIZE 32  #define FPU_STATE_SIZE 32
693      long long fpu_state[FPU_STATE_SIZE];      long long fpu_state[FPU_STATE_SIZE];
694  #endif  #endif
# Line 639  print_generation_stats(int verbose) Line 699  print_generation_stats(int verbose)
699       */       */
700    
701      fpu_save(fpu_state);      fpu_save(fpu_state);
702    #if defined(i386) || defined(__x86_64)
703        if (fpu_mode == SSE2) {
704          sse_save(sse_state);
705        }
706    #endif
707    
708      /* Number of generations to print out. */      /* Number of generations to print out. */
709      if (verbose)      if (verbose)
# Line 648  print_generation_stats(int verbose) Line 712  print_generation_stats(int verbose)
712          gens = NUM_GENERATIONS;          gens = NUM_GENERATIONS;
713    
714      /* Print the heap stats */      /* Print the heap stats */
715      fprintf(stderr, "          Page count (%d KB)\n", PAGE_SIZE / 1024);      fprintf(stderr, "          Page count (%d KB)\n", GC_PAGE_SIZE / 1024);
716      fprintf(stderr,      fprintf(stderr,
717              "   Gen  Boxed Unboxed  LB   LUB    Alloc    Waste    Trigger   WP  GCs Mem-age\n");              "   Gen  Boxed Unboxed  LB   LUB    Alloc    Waste    Trigger   WP  GCs Mem-age\n");
718    
# Line 686  print_generation_stats(int verbose) Line 750  print_generation_stats(int verbose)
750          fprintf(stderr, " %5d: %5d %5d %5d %5d %10d %6d %10d %4d %3d %7.4f\n",          fprintf(stderr, " %5d: %5d %5d %5d %5d %10d %6d %10d %4d %3d %7.4f\n",
751                  i, boxed_cnt, unboxed_cnt, large_boxed_cnt, large_unboxed_cnt,                  i, boxed_cnt, unboxed_cnt, large_boxed_cnt, large_unboxed_cnt,
752                  generations[i].bytes_allocated,                  generations[i].bytes_allocated,
753                  PAGE_SIZE * count_generation_pages(i) -                  GC_PAGE_SIZE * count_generation_pages(i) -
754                  generations[i].bytes_allocated, generations[i].gc_trigger,                  generations[i].bytes_allocated, generations[i].gc_trigger,
755                  count_write_protect_generation_pages(i), generations[i].num_gc,                  count_write_protect_generation_pages(i), generations[i].num_gc,
756                  gen_av_mem_age(i));                  gen_av_mem_age(i));
# Line 694  print_generation_stats(int verbose) Line 758  print_generation_stats(int verbose)
758      fprintf(stderr, "   Total bytes alloc=%ld\n", bytes_allocated);      fprintf(stderr, "   Total bytes alloc=%ld\n", bytes_allocated);
759    
760      fpu_restore(fpu_state);      fpu_restore(fpu_state);
761    #if defined(i386) || defined(__x86_64)
762        if (fpu_mode == SSE2) {
763          sse_restore(sse_state);
764        }
765    #endif
766  }  }
767    
768  /* Get statistics that are kept "on the fly" out of the generation  /* Get statistics that are kept "on the fly" out of the generation
# Line 804  void *current_region_end_addr; Line 873  void *current_region_end_addr;
873  #endif  #endif
874    
875  /* The generation currently being allocated to. X */  /* The generation currently being allocated to. X */
876  static int gc_alloc_generation;  static int gc_alloc_generation = 0;
877    
878  extern void do_dynamic_space_overflow_warning(void);  extern void do_dynamic_space_overflow_warning(void);
879  extern void do_dynamic_space_overflow_error(void);  extern void do_dynamic_space_overflow_error(void);
# Line 924  gc_alloc_new_region(int nbytes, int unbo Line 993  gc_alloc_new_region(int nbytes, int unbo
993    
994              if (!(flags & PAGE_ALLOCATED_MASK)              if (!(flags & PAGE_ALLOCATED_MASK)
995                  || ((flags & mmask) == mflags &&                  || ((flags & mmask) == mflags &&
996                      page_table[first_page].bytes_used < PAGE_SIZE - 32))                      page_table[first_page].bytes_used < GC_PAGE_SIZE - 32))
997                  break;                  break;
998              first_page++;              first_page++;
999          }          }
# Line 953  gc_alloc_new_region(int nbytes, int unbo Line 1022  gc_alloc_new_region(int nbytes, int unbo
1022           * number of pages in a region.           * number of pages in a region.
1023           */           */
1024          last_page = first_page;          last_page = first_page;
1025          bytes_found = PAGE_SIZE - page_table[first_page].bytes_used;          bytes_found = GC_PAGE_SIZE - page_table[first_page].bytes_used;
1026          num_pages = 1;          num_pages = 1;
1027          while ((bytes_found < nbytes || num_pages < 2)          while ((bytes_found < nbytes || num_pages < 2)
1028                 && last_page < dynamic_space_pages - 1                 && last_page < dynamic_space_pages - 1
1029                 && !PAGE_ALLOCATED(last_page + 1)) {                 && !PAGE_ALLOCATED(last_page + 1)) {
1030              last_page++;              last_page++;
1031              num_pages++;              num_pages++;
1032              bytes_found += PAGE_SIZE;              bytes_found += GC_PAGE_SIZE;
1033              gc_assert(!PAGE_WRITE_PROTECTED(last_page));              gc_assert(!PAGE_WRITE_PROTECTED(last_page));
1034          }          }
1035    
1036          region_size = (PAGE_SIZE - page_table[first_page].bytes_used)          region_size = (GC_PAGE_SIZE - page_table[first_page].bytes_used)
1037              + PAGE_SIZE * (last_page - first_page);              + GC_PAGE_SIZE * (last_page - first_page);
1038    
1039          gc_assert(bytes_found == region_size);          gc_assert(bytes_found == region_size);
1040    
# Line 1044  gc_alloc_new_region(int nbytes, int unbo Line 1113  gc_alloc_new_region(int nbytes, int unbo
1113      if (last_page + 1 > last_free_page) {      if (last_page + 1 > last_free_page) {
1114          last_free_page = last_page + 1;          last_free_page = last_page + 1;
1115          set_alloc_pointer((lispobj) ((char *) heap_base +          set_alloc_pointer((lispobj) ((char *) heap_base +
1116                                       PAGE_SIZE * last_free_page));                                       GC_PAGE_SIZE * last_free_page));
1117    
1118      }      }
1119  }  }
# Line 1078  struct new_area { Line 1147  struct new_area {
1147      int size;      int size;
1148  };  };
1149  static struct new_area (*new_areas)[];  static struct new_area (*new_areas)[];
1150  static int new_areas_index;  static int new_areas_index = 0;
1151  int max_new_areas;  int max_new_areas;
1152    
1153  /* Add a new area to new_areas. */  /* Add a new area to new_areas. */
# Line 1105  add_new_area(int first_page, int offset, Line 1174  add_new_area(int first_page, int offset,
1174            gc_abort();            gc_abort();
1175      }      }
1176    
1177      new_area_start = PAGE_SIZE * first_page + offset;      new_area_start = GC_PAGE_SIZE * first_page + offset;
1178    
1179      /*      /*
1180       * Search backwards for a prior area that this follows from.  If       * Search backwards for a prior area that this follows from.  If
1181       * found this will save adding a new area.       * found this will save adding a new area.
1182       */       */
1183      for (i = new_areas_index - 1, c = 0; i >= 0 && c < 8; i--, c++) {      for (i = new_areas_index - 1, c = 0; i >= 0 && c < 8; i--, c++) {
1184          unsigned area_end = PAGE_SIZE * (*new_areas)[i].page          unsigned area_end = GC_PAGE_SIZE * (*new_areas)[i].page
1185              + (*new_areas)[i].offset + (*new_areas)[i].size;              + (*new_areas)[i].offset + (*new_areas)[i].size;
1186    
1187  #if 0  #if 0
# Line 1212  gc_alloc_update_page_tables(int unboxed, Line 1281  gc_alloc_update_page_tables(int unboxed,
1281           */           */
1282          more = 0;          more = 0;
1283          bytes_used = alloc_region->free_pointer - page_address(first_page);          bytes_used = alloc_region->free_pointer - page_address(first_page);
1284          if (bytes_used > PAGE_SIZE) {          if (bytes_used > GC_PAGE_SIZE) {
1285              bytes_used = PAGE_SIZE;              bytes_used = GC_PAGE_SIZE;
1286              more = 1;              more = 1;
1287          }          }
1288          page_table[first_page].bytes_used = bytes_used;          page_table[first_page].bytes_used = bytes_used;
# Line 1240  gc_alloc_update_page_tables(int unboxed, Line 1309  gc_alloc_update_page_tables(int unboxed,
1309              /* Calc. the number of bytes used in this page. */              /* Calc. the number of bytes used in this page. */
1310              more = 0;              more = 0;
1311              bytes_used = alloc_region->free_pointer - page_address(next_page);              bytes_used = alloc_region->free_pointer - page_address(next_page);
1312              if (bytes_used > PAGE_SIZE) {              if (bytes_used > GC_PAGE_SIZE) {
1313                  bytes_used = PAGE_SIZE;                  bytes_used = GC_PAGE_SIZE;
1314                  more = 1;                  more = 1;
1315              }              }
1316              page_table[next_page].bytes_used = bytes_used;              page_table[next_page].bytes_used = bytes_used;
# Line 1387  gc_alloc_large(int nbytes, int unboxed, Line 1456  gc_alloc_large(int nbytes, int unboxed,
1456    
1457                  if (!(flags & PAGE_ALLOCATED_MASK)                  if (!(flags & PAGE_ALLOCATED_MASK)
1458                      || ((flags & mmask) == mflags &&                      || ((flags & mmask) == mflags &&
1459                          page_table[first_page].bytes_used < PAGE_SIZE - 32))                          page_table[first_page].bytes_used < GC_PAGE_SIZE - 32))
1460                      break;                      break;
1461                  first_page++;                  first_page++;
1462              }              }
# Line 1409  gc_alloc_large(int nbytes, int unboxed, Line 1478  gc_alloc_large(int nbytes, int unboxed,
1478  #endif  #endif
1479    
1480          last_page = first_page;          last_page = first_page;
1481          bytes_found = PAGE_SIZE - page_table[first_page].bytes_used;          bytes_found = GC_PAGE_SIZE - page_table[first_page].bytes_used;
1482          num_pages = 1;          num_pages = 1;
1483          while (bytes_found < nbytes          while (bytes_found < nbytes
1484                 && last_page < dynamic_space_pages - 1                 && last_page < dynamic_space_pages - 1
1485                 && !PAGE_ALLOCATED(last_page + 1)) {                 && !PAGE_ALLOCATED(last_page + 1)) {
1486              last_page++;              last_page++;
1487              num_pages++;              num_pages++;
1488              bytes_found += PAGE_SIZE;              bytes_found += GC_PAGE_SIZE;
1489              gc_assert(!PAGE_WRITE_PROTECTED(last_page));              gc_assert(!PAGE_WRITE_PROTECTED(last_page));
1490          }          }
1491    
1492          region_size = (PAGE_SIZE - page_table[first_page].bytes_used)          region_size = (GC_PAGE_SIZE - page_table[first_page].bytes_used)
1493              + PAGE_SIZE * (last_page - first_page);              + GC_PAGE_SIZE * (last_page - first_page);
1494    
1495          gc_assert(bytes_found == region_size);          gc_assert(bytes_found == region_size);
1496    
# Line 1486  gc_alloc_large(int nbytes, int unboxed, Line 1555  gc_alloc_large(int nbytes, int unboxed,
1555       */       */
1556      more = 0;      more = 0;
1557      bytes_used = nbytes + orig_first_page_bytes_used;      bytes_used = nbytes + orig_first_page_bytes_used;
1558      if (bytes_used > PAGE_SIZE) {      if (bytes_used > GC_PAGE_SIZE) {
1559          bytes_used = PAGE_SIZE;          bytes_used = GC_PAGE_SIZE;
1560          more = 1;          more = 1;
1561      }      }
1562      page_table[first_page].bytes_used = bytes_used;      page_table[first_page].bytes_used = bytes_used;
# Line 1510  gc_alloc_large(int nbytes, int unboxed, Line 1579  gc_alloc_large(int nbytes, int unboxed,
1579          PAGE_FLAGS_UPDATE(next_page, mmask, mflags);          PAGE_FLAGS_UPDATE(next_page, mmask, mflags);
1580    
1581          page_table[next_page].first_object_offset =          page_table[next_page].first_object_offset =
1582              orig_first_page_bytes_used - PAGE_SIZE * (next_page - first_page);              orig_first_page_bytes_used - GC_PAGE_SIZE * (next_page - first_page);
1583    
1584          /* Calc. the number of bytes used in this page. */          /* Calc. the number of bytes used in this page. */
1585          more = 0;          more = 0;
1586          bytes_used = nbytes + orig_first_page_bytes_used - byte_cnt;          bytes_used = nbytes + orig_first_page_bytes_used - byte_cnt;
1587          if (bytes_used > PAGE_SIZE) {          if (bytes_used > GC_PAGE_SIZE) {
1588              bytes_used = PAGE_SIZE;              bytes_used = GC_PAGE_SIZE;
1589              more = 1;              more = 1;
1590          }          }
1591          page_table[next_page].bytes_used = bytes_used;          page_table[next_page].bytes_used = bytes_used;
# Line 1538  gc_alloc_large(int nbytes, int unboxed, Line 1607  gc_alloc_large(int nbytes, int unboxed,
1607      if (last_page + 1 > last_free_page) {      if (last_page + 1 > last_free_page) {
1608          last_free_page = last_page + 1;          last_free_page = last_page + 1;
1609          set_alloc_pointer((lispobj) ((char *) heap_base +          set_alloc_pointer((lispobj) ((char *) heap_base +
1610                                       PAGE_SIZE * last_free_page));                                       GC_PAGE_SIZE * last_free_page));
1611      }      }
1612    
1613      return (void *) (page_address(first_page) + orig_first_page_bytes_used);      return (void *) (page_address(first_page) + orig_first_page_bytes_used);
1614  }  }
1615    
1616  /*  /*
1617   * Allocate bytes from the boxed_region. It first checks if there is   * If the current region has more than this much space left, we don't
1618   * room, if not then it calls gc_alloc_new_region to find a new region   * want to abandon the region (wasting space), but do a "large" alloc
1619   * with enough space. A pointer to the start of the region is returned.   * to a new region.
1620   */   */
1621  static void *  
1622  gc_alloc(int nbytes)  int region_empty_threshold = 32;
1623    
1624    
1625    /*
1626     * How many consecutive large alloc we can do before we abandon the
1627     * current region.
1628     */
1629    int consecutive_large_alloc_limit = 10;
1630    
1631    
1632    /*
1633     * Statistics for the current region
1634     */
1635    struct alloc_stats
1636  {  {
1637      char *new_free_pointer;      /*
1638         * How many consecutive allocations we have tried with the current
1639         * region (in saved_region)
1640         */
1641        int consecutive_alloc;
1642        /*
1643         * How many times we tried to allocate to this region but didn't
1644         * because we didn't have enough room and did a large alloc in a
1645         * different region.
1646         */
1647        int abandon_region_count;
1648    
1649  #if 0      /*
1650      fprintf(stderr, "gc_alloc %d\n", nbytes);       * A copy of the current allocation region which we use to compare
1651  #endif       * against.
1652         */
1653        struct alloc_region saved_region;
1654    };
1655    
1656    /* Statistics for boxed and unboxed regions */
1657    struct alloc_stats boxed_stats =
1658    {0, 0,
1659     {NULL, NULL, -1, -1, NULL}};
1660    
1661    struct alloc_stats unboxed_stats =
1662    {0, 0,
1663     {NULL, NULL, -1, -1, NULL}};
1664    
1665    /*
1666     * Try to allocate from the current region.  If it's possible, do the
1667     * allocation and return the object.  If it's not possible, return
1668     * (void*) -1.
1669     */
1670    static inline void *
1671    gc_alloc_try_current_region(int nbytes, struct alloc_region *region, int unboxed,
1672                                struct alloc_stats *stats)
1673    {
1674        char *new_free_pointer;
1675    
1676      /* Check if there is room in the current alloc region. */      /* Check if there is room in the current alloc region. */
1677      new_free_pointer = boxed_region.free_pointer + nbytes;      new_free_pointer = region->free_pointer + nbytes;
1678    
1679      if (new_free_pointer <= boxed_region.end_addr) {      if (new_free_pointer <= region->end_addr) {
1680          /* If so then allocate from the current alloc region. */          /* If so then allocate from the current alloc region. */
1681          char *new_obj = boxed_region.free_pointer;          char *new_obj = region->free_pointer;
1682    
1683          boxed_region.free_pointer = new_free_pointer;          region->free_pointer = new_free_pointer;
1684    
1685          /* Check if the alloc region is almost empty. */          /* Check if the alloc region is almost empty. */
1686          if (boxed_region.end_addr - boxed_region.free_pointer <= 32) {          if (region->end_addr - region->free_pointer <= region_empty_threshold) {
1687              /* If so finished with the current region. */              /* If so finished with the current region. */
1688              gc_alloc_update_page_tables(0, &boxed_region);              gc_alloc_update_page_tables(unboxed, region);
1689              /* Setup a new region. */              /* Setup a new region. */
1690              gc_alloc_new_region(32, 0, &boxed_region);              gc_alloc_new_region(region_empty_threshold, unboxed, region);
1691          }          }
1692    
1693            stats->consecutive_alloc = 0;
1694            stats->abandon_region_count = 0;
1695            memcpy(&stats->saved_region, region, sizeof(stats->saved_region));
1696    
1697          return (void *) new_obj;          return (void *) new_obj;
1698        } else {
1699            return (void *) -1;
1700        }
1701    }
1702    
1703    /*
1704     * Allocate bytes from a boxed or unboxed region. It first checks if
1705     * there is room, if not then it calls gc_alloc_new_region to find a
1706     * new region with enough space. A pointer to the start of the region
1707     * is returned.  The parameter "unboxed" should be 0 (boxed) or 1
1708     * (unboxed).
1709     */
1710    static void *
1711    gc_alloc_region(int nbytes, struct alloc_region *region, int unboxed, struct alloc_stats *stats)
1712    {
1713        void *new_obj;
1714    
1715    #if 0
1716        fprintf(stderr, "gc_alloc %d\n", nbytes);
1717    #endif
1718    
1719        /* Check if there is room in the current alloc region. */
1720    
1721        new_obj = gc_alloc_try_current_region(nbytes, region, unboxed, stats);
1722        if (new_obj != (void *) -1) {
1723            return new_obj;
1724      }      }
1725    
1726      /* Else not enough free space in the current region. */      /* Else not enough free space in the current region. */
1727    
1728      /*      /*
1729         * If the allocation is large enough, always do a large alloc This
1730         * helps GC so we don't have to copy this object again.
1731         */
1732    
1733        if (nbytes >= large_object_size) {
1734            return gc_alloc_large(nbytes, unboxed, region);
1735        }
1736    
1737        /*
1738       * If there is a bit of room left in the current region then       * If there is a bit of room left in the current region then
1739       * allocate a large object.       * allocate a large object.
1740       */       */
     if (boxed_region.end_addr - boxed_region.free_pointer > 32)  
         return gc_alloc_large(nbytes, 0, &boxed_region);  
1741    
1742      /* Else find a new region. */      /*
1743         * This has potentially very bad behavior on sparc if the current
1744         * boxed region is too small for the allocation, but the free
1745         * space is greater than 32 (region_empty_threshold).  The
1746         * scenario is where we're always allocating something that won't
1747         * fit in the boxed region, and we keep calling gc_alloc_large.
1748         * Since gc_alloc_large doesn't change the region, the next
1749         * allocation will again be out-of-line and we hit a kernel trap
1750         * again.  And so on, so we waste all of our time doing kernel
1751         * traps to allocate small things.  This also affects ppc.
1752         *
1753         * X86 has the same issue, but the affect is less because the
1754         * out-of-line allocation is a just a function call, not a kernel
1755         * trap.
1756         *
1757         * Heuristic: If we do too many consecutive large allocations
1758         * because the current region has some space left, we give up and
1759         * abandon the region. This will prevent the bad scenario above
1760         * from killing allocation performance.
1761         *
1762         */
1763    
1764        if ((region->end_addr - region->free_pointer > region_empty_threshold)
1765            && (stats->consecutive_alloc < consecutive_large_alloc_limit)) {
1766            /*
1767             * Is the saved region the same as the current region?  If so,
1768             * update the counter.  If not, that means we did some other
1769             * (inline) allocation, so reset the counters and region to
1770             * the current region.
1771             */
1772            if (memcmp(&stats->saved_region, region, sizeof(stats->saved_region)) == 0) {
1773                ++stats->consecutive_alloc;
1774            } else {
1775                stats->consecutive_alloc = 0;
1776                stats->abandon_region_count = 0;
1777                memcpy(&stats->saved_region, region, sizeof(stats->saved_region));
1778            }
1779    
1780            return gc_alloc_large(nbytes, unboxed, region);
1781        }
1782    
1783        /*
1784         * We given up on the current region because the
1785         * consecutive_large_alloc_limit has been reached.
1786         */
1787        stats->consecutive_alloc = 0;
1788        ++stats->abandon_region_count;
1789    
1790      /* Finished with the current region. */      /* Finished with the current region. */
1791      gc_alloc_update_page_tables(0, &boxed_region);      gc_alloc_update_page_tables(unboxed, region);
1792    
1793      /* Setup a new region. */      /* Setup a new region. */
1794      gc_alloc_new_region(nbytes, 0, &boxed_region);      gc_alloc_new_region(nbytes, unboxed, region);
1795    
1796      /* Should now be enough room. */      /* Should now be enough room. */
1797    
1798      /* Check if there is room in the current region. */      new_obj = gc_alloc_try_current_region(nbytes, region, unboxed, stats);
1799      new_free_pointer = boxed_region.free_pointer + nbytes;      if (new_obj != (void *) -1) {
1800            return new_obj;
     if (new_free_pointer <= boxed_region.end_addr) {  
         /* If so then allocate from the current region. */  
         void *new_obj = boxed_region.free_pointer;  
   
         boxed_region.free_pointer = new_free_pointer;  
   
         /* Check if the current region is almost empty. */  
         if (boxed_region.end_addr - boxed_region.free_pointer <= 32) {  
             /* If so find, finished with the current region. */  
             gc_alloc_update_page_tables(0, &boxed_region);  
   
             /* Setup a new region. */  
             gc_alloc_new_region(32, 0, &boxed_region);  
         }  
   
         return (void *) new_obj;  
1801      }      }
1802    
1803      /* Shouldn't happen? */      /* Shouldn't happen? */
# Line 1623  gc_alloc(int nbytes) Line 1806  gc_alloc(int nbytes)
1806  }  }
1807    
1808  /*  /*
1809     * Allocate bytes from the boxed_region. It first checks if there is
1810     * room, if not then it calls gc_alloc_new_region to find a new region
1811     * with enough space. A pointer to the start of the region is returned.
1812     */
1813    static inline void *
1814    gc_alloc(int nbytes)
1815    {
1816        void* obj;
1817    
1818        obj = gc_alloc_region(nbytes, &boxed_region, 0, &boxed_stats);
1819    
1820        return obj;
1821    }
1822    
1823    /*
1824   * Allocate space from the boxed_region. If there is not enough free   * Allocate space from the boxed_region. If there is not enough free
1825   * space then call gc_alloc to do the job. A pointer to the start of   * space then call gc_alloc to do the job. A pointer to the start of
1826   * the region is returned.   * the region is returned.
# Line 1676  gc_quick_alloc_large(int nbytes) Line 1874  gc_quick_alloc_large(int nbytes)
1874      return gc_alloc(nbytes);      return gc_alloc(nbytes);
1875  }  }
1876    
1877    static inline void *
   
   
 static void *  
1878  gc_alloc_unboxed(int nbytes)  gc_alloc_unboxed(int nbytes)
1879  {  {
1880      char *new_free_pointer;      void *obj;
   
 #if 0  
     fprintf(stderr, "gc_alloc_unboxed %d\n", nbytes);  
 #endif  
   
     /* Check if there is room in the current region. */  
     new_free_pointer = unboxed_region.free_pointer + nbytes;  
   
     if (new_free_pointer <= unboxed_region.end_addr) {  
         /* If so then allocate from the current region. */  
         void *new_obj = unboxed_region.free_pointer;  
   
         unboxed_region.free_pointer = new_free_pointer;  
   
         /* Check if the current region is almost empty. */  
         if ((unboxed_region.end_addr - unboxed_region.free_pointer) <= 32) {  
             /* If so finished with the current region. */  
             gc_alloc_update_page_tables(1, &unboxed_region);  
   
             /* Setup a new region. */  
             gc_alloc_new_region(32, 1, &unboxed_region);  
         }  
   
         return (void *) new_obj;  
     }  
   
     /* Else not enough free space in the current region. */  
1881    
1882      /*      obj = gc_alloc_region(nbytes, &unboxed_region, 1, &unboxed_stats);
      * If there is a bit of room left in the current region then  
      * allocate a large object.  
      */  
     if (unboxed_region.end_addr - unboxed_region.free_pointer > 32)  
         return gc_alloc_large(nbytes, 1, &unboxed_region);  
   
     /* Else find a new region. */  
   
     /* Finished with the current region. */  
     gc_alloc_update_page_tables(1, &unboxed_region);  
   
     /* Setup a new region. */  
     gc_alloc_new_region(nbytes, 1, &unboxed_region);  
   
     /* Should now be enough room. */  
1883    
1884      /* Check if there is room in the current region. */      return obj;
     new_free_pointer = unboxed_region.free_pointer + nbytes;  
   
     if (new_free_pointer <= unboxed_region.end_addr) {  
         /* If so then allocate from the current region. */  
         void *new_obj = unboxed_region.free_pointer;  
   
         unboxed_region.free_pointer = new_free_pointer;  
   
         /* Check if the current region is almost empty. */  
         if ((unboxed_region.end_addr - unboxed_region.free_pointer) <= 32) {  
             /* If so find, finished with the current region. */  
             gc_alloc_update_page_tables(1, &unboxed_region);  
   
             /* Setup a new region. */  
             gc_alloc_new_region(32, 1, &unboxed_region);  
         }  
   
         return (void *) new_obj;  
     }  
   
     /* Shouldn't happen? */  
     gc_assert(0);  
     return 0;  
1885  }  }
1886    
1887  static inline void *  static inline void *
# Line 1818  static int (*sizetab[256]) (lispobj * wh Line 1948  static int (*sizetab[256]) (lispobj * wh
1948  static struct weak_pointer *weak_pointers;  static struct weak_pointer *weak_pointers;
1949  static struct scavenger_hook *scavenger_hooks = (struct scavenger_hook *) NIL;  static struct scavenger_hook *scavenger_hooks = (struct scavenger_hook *) NIL;
1950    
1951    /* Like (ceiling x y), but y is constrained to be a power of two */
1952  #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))  #define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))
1953    
1954    
# Line 1830  from_space_p(lispobj obj) Line 1961  from_space_p(lispobj obj)
1961    
1962      return page_index >= 0      return page_index >= 0
1963          && (page_index =          && (page_index =
1964              (unsigned int) page_index / PAGE_SIZE) < dynamic_space_pages              (unsigned int) page_index / GC_PAGE_SIZE) < dynamic_space_pages
1965          && PAGE_GENERATION(page_index) == from_space;          && PAGE_GENERATION(page_index) == from_space;
1966  }  }
1967    
# Line 1841  new_space_p(lispobj obj) Line 1972  new_space_p(lispobj obj)
1972    
1973      return page_index >= 0      return page_index >= 0
1974          && (page_index =          && (page_index =
1975              (unsigned int) page_index / PAGE_SIZE) < dynamic_space_pages              (unsigned int) page_index / GC_PAGE_SIZE) < dynamic_space_pages
1976          && PAGE_GENERATION(page_index) == new_space;          && PAGE_GENERATION(page_index) == new_space;
1977  }  }
1978    
1979    static inline boolean
1980    dynamic_space_p(lispobj obj)
1981    {
1982        lispobj end = DYNAMIC_0_SPACE_START + DYNAMIC_SPACE_SIZE;
1983    
1984        return (obj >= DYNAMIC_0_SPACE_START) && (obj < end);
1985    }
1986    
1987    static inline boolean
1988    static_space_p(lispobj obj)
1989    {
1990        lispobj end = SymbolValue(STATIC_SPACE_FREE_POINTER);
1991    
1992        return (obj >= STATIC_SPACE_START) && (obj < end);
1993    }
1994    
1995    static inline boolean
1996    read_only_space_p(lispobj obj)
1997    {
1998        lispobj end = SymbolValue(READ_ONLY_SPACE_FREE_POINTER);
1999    
2000        return (obj >= READ_ONLY_SPACE_START) && (obj < end);
2001    }
2002    
2003    static inline boolean
2004    control_stack_space_p(lispobj obj)
2005    {
2006        lispobj end = CONTROL_STACK_START + CONTROL_STACK_SIZE;
2007    
2008        return (obj >= CONTROL_STACK_START) && (obj < end);
2009    }
2010    
2011    static inline boolean
2012    binding_stack_space_p(lispobj obj)
2013    {
2014        lispobj end = BINDING_STACK_START + BINDING_STACK_SIZE;
2015    
2016        return (obj >= BINDING_STACK_START) && (obj < end);
2017    }
2018    
2019    static inline boolean
2020    signal_space_p(lispobj obj)
2021    {
2022    #ifdef SIGNAL_STACK_START
2023        lispobj end = SIGNAL_STACK_START + SIGSTKSZ;
2024    
2025        return (obj >= SIGNAL_STACK_START) && (obj < end);
2026    #else
2027        return FALSE;
2028    #endif
2029    }
2030    
2031    #if (defined(DARWIN) && defined(__ppc__))
2032    /*
2033     * The assembly code defines these as functions, so we make them
2034     * functions.  We only care about their addresses anyway.
2035     */
2036    extern char closure_tramp();
2037    extern char undefined_tramp();
2038    #elif defined(sparc)
2039    /* closure tramp and undefined tramp are Lisp assembly routines */
2040    #elif (defined(i386) || defined(__x86_64))
2041    /* undefined tramp are Lisp assembly routines */
2042    #else
2043    extern int undefined_tramp;
2044    #endif
2045    
2046    /*
2047     * Other random places that can't be in malloc space.  Return TRUE if
2048     * obj is in some other known space
2049     */
2050    static inline boolean
2051    other_space_p(lispobj obj)
2052    {
2053        boolean in_space = FALSE;
2054    
2055    #if defined(sparc)
2056        extern char _end;
2057    
2058        /*
2059         * Skip over any objects in the C runtime which includes the
2060         * closure_tramp and undefined_tramp objects.  There appears to be
2061         * one other object that points to somewhere in call_into_c, but I
2062         * don't know what that is.  I think that's probably all for
2063         * sparc.
2064         */
2065        if ((char*) obj <= &_end) {
2066            in_space = TRUE;
2067        }
2068    #elif defined(i386)
2069    #if defined(DARWIN) || defined(__linux__) || defined(__FreeBSD__) || defined(__NetBSD__)
2070        /*
2071         * For x86, we see some object at 0xffffffe9.  I (rtoy) am not
2072         * sure that is, but it clearly can't be in malloc space so we
2073         * want to skip that (by returning TRUE).
2074         *
2075         * Is there anything else?
2076         */
2077        if (obj == (lispobj) 0xffffffe9) {
2078            in_space = TRUE;
2079        }
2080    #endif
2081    #endif
2082    
2083        return in_space;
2084    }
2085    
2086    
2087    
2088  /* Copying Objects */  /* Copying Objects */
# Line 1904  copy_large_object(lispobj object, int nw Line 2143  copy_large_object(lispobj object, int nw
2143      gc_assert((nwords & 0x01) == 0);      gc_assert((nwords & 0x01) == 0);
2144    
2145      if (gencgc_verbose && nwords > 1024 * 1024)      if (gencgc_verbose && nwords > 1024 * 1024)
2146          fprintf(stderr, "** copy_large_object: %d\n", nwords * sizeof(lispobj));          fprintf(stderr, "** copy_large_object: %lu\n",
2147                    (unsigned long) (nwords * sizeof(lispobj)));
2148    
2149      /* Check if it's a large object. */      /* Check if it's a large object. */
2150      first_page = find_page_index((void *) object);      first_page = find_page_index((void *) object);
# Line 1930  copy_large_object(lispobj object, int nw Line 2170  copy_large_object(lispobj object, int nw
2170    
2171          next_page = first_page;          next_page = first_page;
2172          remaining_bytes = nwords * sizeof(lispobj);          remaining_bytes = nwords * sizeof(lispobj);
2173          while (remaining_bytes > PAGE_SIZE) {          while (remaining_bytes > GC_PAGE_SIZE) {
2174              gc_assert(PAGE_GENERATION(next_page) == from_space);              gc_assert(PAGE_GENERATION(next_page) == from_space);
2175              gc_assert(PAGE_ALLOCATED(next_page));              gc_assert(PAGE_ALLOCATED(next_page));
2176              gc_assert(!PAGE_UNBOXED(next_page));              gc_assert(!PAGE_UNBOXED(next_page));
2177              gc_assert(PAGE_LARGE_OBJECT(next_page));              gc_assert(PAGE_LARGE_OBJECT(next_page));
2178              gc_assert(page_table[next_page].first_object_offset ==              gc_assert(page_table[next_page].first_object_offset ==
2179                        PAGE_SIZE * (first_page - next_page));                        GC_PAGE_SIZE * (first_page - next_page));
2180              gc_assert(page_table[next_page].bytes_used == PAGE_SIZE);              gc_assert(page_table[next_page].bytes_used == GC_PAGE_SIZE);
2181    
2182              PAGE_FLAGS_UPDATE(next_page, PAGE_GENERATION_MASK, new_space);              PAGE_FLAGS_UPDATE(next_page, PAGE_GENERATION_MASK, new_space);
2183    
# Line 1946  copy_large_object(lispobj object, int nw Line 2186  copy_large_object(lispobj object, int nw
2186               * WP flag to avoid redundant calls.               * WP flag to avoid redundant calls.
2187               */               */
2188              if (PAGE_WRITE_PROTECTED(next_page)) {              if (PAGE_WRITE_PROTECTED(next_page)) {
2189                  os_protect((os_vm_address_t) page_address(next_page), PAGE_SIZE,                  os_protect((os_vm_address_t) page_address(next_page), GC_PAGE_SIZE,
2190                             OS_VM_PROT_ALL);                             OS_VM_PROT_ALL);
2191                  page_table[next_page].flags &= ~PAGE_WRITE_PROTECTED_MASK;                  page_table[next_page].flags &= ~PAGE_WRITE_PROTECTED_MASK;
2192              }              }
2193              remaining_bytes -= PAGE_SIZE;              remaining_bytes -= GC_PAGE_SIZE;
2194              next_page++;              next_page++;
2195          }          }
2196    
# Line 1978  copy_large_object(lispobj object, int nw Line 2218  copy_large_object(lispobj object, int nw
2218    
2219          /* Free any remaining pages; needs care. */          /* Free any remaining pages; needs care. */
2220          next_page++;          next_page++;
2221          while (old_bytes_used == PAGE_SIZE &&          while (old_bytes_used == GC_PAGE_SIZE &&
2222                 PAGE_FLAGS(next_page, mmask) == mflags &&                 PAGE_FLAGS(next_page, mmask) == mflags &&
2223                 page_table[next_page].first_object_offset ==                 page_table[next_page].first_object_offset ==
2224                 PAGE_SIZE * (first_page - next_page)) {                 GC_PAGE_SIZE * (first_page - next_page)) {
2225              /*              /*
2226               * Checks out OK, free the page. Don't need to both zeroing               * Checks out OK, free the page. Don't need to both zeroing
2227               * pages as this should have been done before shrinking the               * pages as this should have been done before shrinking the
# Line 2089  copy_large_unboxed_object(lispobj object Line 2329  copy_large_unboxed_object(lispobj object
2329      gc_assert((nwords & 0x01) == 0);      gc_assert((nwords & 0x01) == 0);
2330    
2331      if (gencgc_verbose && nwords > 1024 * 1024)      if (gencgc_verbose && nwords > 1024 * 1024)
2332          fprintf(stderr, "** copy_large_unboxed_object: %d\n",          fprintf(stderr, "** copy_large_unboxed_object: %lu\n",
2333                  nwords * sizeof(lispobj));                  (unsigned long) (nwords * sizeof(lispobj)));
2334    
2335      /* Check if it's a large object. */      /* Check if it's a large object. */
2336      first_page = find_page_index((void *) object);      first_page = find_page_index((void *) object);
# Line 2112  copy_large_unboxed_object(lispobj object Line 2352  copy_large_unboxed_object(lispobj object
2352    
2353          next_page = first_page;          next_page = first_page;
2354          remaining_bytes = nwords * sizeof(lispobj);          remaining_bytes = nwords * sizeof(lispobj);
2355          while (remaining_bytes > PAGE_SIZE) {          while (remaining_bytes > GC_PAGE_SIZE) {
2356              gc_assert(PAGE_GENERATION(next_page) == from_space);              gc_assert(PAGE_GENERATION(next_page) == from_space);
2357              gc_assert(PAGE_ALLOCATED(next_page));              gc_assert(PAGE_ALLOCATED(next_page));
2358              gc_assert(PAGE_LARGE_OBJECT(next_page));              gc_assert(PAGE_LARGE_OBJECT(next_page));
2359              gc_assert(page_table[next_page].first_object_offset ==              gc_assert(page_table[next_page].first_object_offset ==
2360                        PAGE_SIZE * (first_page - next_page));                        GC_PAGE_SIZE * (first_page - next_page));
2361              gc_assert(page_table[next_page].bytes_used == PAGE_SIZE);              gc_assert(page_table[next_page].bytes_used == GC_PAGE_SIZE);
2362    
2363              PAGE_FLAGS_UPDATE(next_page,              PAGE_FLAGS_UPDATE(next_page,
2364                                PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK,                                PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK,
2365                                PAGE_UNBOXED_MASK | new_space);                                PAGE_UNBOXED_MASK | new_space);
2366              remaining_bytes -= PAGE_SIZE;              remaining_bytes -= GC_PAGE_SIZE;
2367              next_page++;              next_page++;
2368          }          }
2369    
# Line 2151  copy_large_unboxed_object(lispobj object Line 2391  copy_large_unboxed_object(lispobj object
2391    
2392          /* Free any remaining pages; needs care. */          /* Free any remaining pages; needs care. */
2393          next_page++;          next_page++;
2394          while (old_bytes_used == PAGE_SIZE &&          while (old_bytes_used == GC_PAGE_SIZE &&
2395                 PAGE_FLAGS(next_page, mmask) == mflags &&                 PAGE_FLAGS(next_page, mmask) == mflags &&
2396                 page_table[next_page].first_object_offset ==                 page_table[next_page].first_object_offset ==
2397                 PAGE_SIZE * (first_page - next_page)) {                 GC_PAGE_SIZE * (first_page - next_page)) {
2398              /*              /*
2399               * Checks out OK, free the page. Don't need to both zeroing               * Checks out OK, free the page. Don't need to both zeroing
2400               * pages as this should have been done before shrinking the               * pages as this should have been done before shrinking the
# Line 2203  copy_large_unboxed_object(lispobj object Line 2443  copy_large_unboxed_object(lispobj object
2443          return (lispobj) new | tag;          return (lispobj) new | tag;
2444      }      }
2445  }  }
2446    
2447    static inline boolean
2448    maybe_static_array_p(lispobj header)
2449    {
2450        boolean result;
2451    
2452        switch (TypeOf(header)) {
2453            /*
2454             * This needs to be coordinated to the set of allowed
2455             * static vectors in make-array.
2456             */
2457          case type_SimpleString:
2458          case type_SimpleArrayUnsignedByte8:
2459          case type_SimpleArrayUnsignedByte16:
2460          case type_SimpleArrayUnsignedByte32:
2461    #ifdef type_SimpleArraySignedByte8
2462          case type_SimpleArraySignedByte8:
2463    #endif
2464    #ifdef type_SimpleArraySignedByte16
2465          case type_SimpleArraySignedByte16:
2466    #endif
2467    #ifdef type_SimpleArraySignedByte32
2468          case type_SimpleArraySignedByte32:
2469    #endif
2470          case type_SimpleArraySingleFloat:
2471          case type_SimpleArrayDoubleFloat:
2472    #ifdef type_SimpleArrayLongFloat
2473          case type_SimpleArrayLongFloat:
2474    #endif
2475    #ifdef type_SimpleArrayComplexSingleFloat
2476          case type_SimpleArrayComplexSingleFloat:
2477    #endif
2478    #ifdef type_SimpleArrayComplexDoubleFloat
2479          case type_SimpleArrayComplexDoubleFloat:
2480    #endif
2481    #ifdef type_SimpleArrayComplexLongFloat
2482          case type_SimpleArrayComplexLongFloat:
2483    #endif
2484              result = TRUE;
2485              break;
2486          default:
2487              result = FALSE;
2488        }
2489        return result;
2490    }
2491    
2492    
2493    
2494  /* Scavenging */  /* Scavenging */
# Line 2250  scavenge(void *start_obj, long nwords) Line 2536  scavenge(void *start_obj, long nwords)
2536                  if (first_word == 0x01) {                  if (first_word == 0x01) {
2537                      *start = ptr[1];                      *start = ptr[1];
2538                      words_scavenged = 1;                      words_scavenged = 1;
2539                  } else                  } else {
2540                      words_scavenged = scavtab[TypeOf(object)] (start, object);                      words_scavenged = scavtab[TypeOf(object)] (start, object);
2541              } else                  }
2542                  words_scavenged = 1;              } else if (dynamic_space_p(object) || new_space_p(object) || static_space_p(object)
2543                           || read_only_space_p(object) || control_stack_space_p(object)
2544                           || binding_stack_space_p(object) || signal_space_p(object)
2545                           || other_space_p(object)) {
2546                    words_scavenged = 1;
2547                } else {
2548                    lispobj *ptr = (lispobj *) PTR(object);
2549                    words_scavenged = 1;
2550                    if (debug_static_array_p) {
2551                        fprintf(stderr, "Not in Lisp spaces:  object = %p, ptr = %p\n",
2552                                (void*)object, ptr);
2553                    }
2554    
2555                    if (1) {
2556                        lispobj header = *ptr;
2557                        if (debug_static_array_p) {
2558                            fprintf(stderr, "  Header value = 0x%lx\n", (unsigned long) header);
2559                        }
2560    
2561                        if (maybe_static_array_p(header)) {
2562                            int static_p;
2563    
2564                            if (debug_static_array_p) {
2565                                fprintf(stderr, "Possible static vector at %p.  header = 0x%lx\n",
2566                                        ptr, (unsigned long) header);
2567                            }
2568    
2569                            static_p = (HeaderValue(header) & 1) == 1;
2570                            if (static_p) {
2571                                /*
2572                                 * We have a static vector.  Mark it as
2573                                 * reachable by setting the MSB of the header.
2574                                 */
2575                                *ptr = header | 0x80000000;
2576                                if (debug_static_array_p) {
2577                                    fprintf(stderr, "Scavenged static vector @%p, header = 0x%lx\n",
2578                                            ptr, (unsigned long) header);
2579                                }
2580                            }
2581                        }
2582                    }
2583                }
2584          } else if ((object & 3) == 0)          } else if ((object & 3) == 0)
2585              words_scavenged = 1;              words_scavenged = 1;
2586          else          else
# Line 2271  scavenge(void *start_obj, long nwords) Line 2598  scavenge(void *start_obj, long nwords)
2598  #if !(defined(i386) || defined(__x86_64))  #if !(defined(i386) || defined(__x86_64))
2599  /* Scavenging Interrupt Contexts */  /* Scavenging Interrupt Contexts */
2600    
2601  static int boxed_registers[] = BOXED_REGISTERS;  static int boxed_registers[] = BOXED_REGISTERS;
2602    
2603    /* The GC has a notion of an "interior pointer" register, an unboxed
2604     * register that typically contains a pointer to inside an object
2605     * referenced by another pointer.  The most obvious of these is the
2606     * program counter, although many compiler backends define a "Lisp
2607     * Interior Pointer" register known as reg_LIP, and various CPU
2608     * architectures have other registers that also partake of the
2609     * interior-pointer nature.  As the code for pairing an interior
2610     * pointer value up with its "base" register, and fixing it up after
2611     * scavenging is complete is horribly repetitive, a few macros paper
2612     * over the monotony.  --AB, 2010-Jul-14 */
2613    
2614    #define INTERIOR_POINTER_VARS(name) \
2615        unsigned long name;             \
2616        unsigned long name##_offset;    \
2617        int name##_register_pair
2618    
2619    #define PAIR_INTERIOR_POINTER(name, accessor)           \
2620        name = accessor;                                    \
2621        pair_interior_pointer(context, name,                \
2622                              &name##_offset,               \
2623                              &name##_register_pair)
2624    
2625    /*
2626     * Do we need to check if the register we're fixing up is in the
2627     * from-space?
2628     */
2629    #define FIXUP_INTERIOR_POINTER(name, accessor)                          \
2630        do {                                                                \
2631            if (name##_register_pair >= 0) {                                \
2632                accessor =                                                  \
2633                    PTR(SC_REG(context, name##_register_pair))              \
2634                    + name##_offset;                                        \
2635            }                                                               \
2636        } while (0)
2637    
2638    
2639    static void
2640    pair_interior_pointer(os_context_t *context, unsigned long pointer,
2641                          unsigned long *saved_offset, int *register_pair)
2642    {
2643        int i;
2644    
2645        /*
2646         * I (RLT) think this is trying to find the boxed register that is
2647         * closest to the LIP address, without going past it.  Usually, it's
2648         * reg_CODE or reg_LRA.  But sometimes, nothing can be found.
2649         */
2650        *saved_offset = 0x7FFFFFFF;
2651        *register_pair = -1;
2652        for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
2653            unsigned long reg;
2654            long offset;
2655            int index;
2656    
2657            index = boxed_registers[i];
2658            reg = SC_REG(context, index);
2659    
2660            /* An interior pointer is never relative to a non-pointer
2661             * register (an oversight in the original implementation).
2662             * The simplest argument for why this is true is to consider
2663             * the fixnum that happens by coincide to be the word-index in
2664             * memory of the header for some object plus two.  This is
2665             * happenstance would cause the register containing the fixnum
2666             * to be selected as the register_pair if the interior pointer
2667             * is to anywhere after the first two words of the object.
2668             * The fixnum won't be changed during GC, but the object might
2669             * move, thus destroying the interior pointer.  --AB,
2670             * 2010-Jul-14 */
2671    
2672            if (Pointerp(reg) && (PTR(reg) <= pointer)) {
2673                offset = pointer - PTR(reg);
2674                if (offset < *saved_offset) {
2675                    *saved_offset = offset;
2676                    *register_pair = index;
2677                }
2678            }
2679        }
2680    }
2681    
2682    
2683  static void  static void
2684  scavenge_interrupt_context(os_context_t * context)  scavenge_interrupt_context(os_context_t * context)
2685  {  {
2686      int i;      int i;
     unsigned long pc_code_offset;  
2687    
2688        INTERIOR_POINTER_VARS(pc);
2689  #ifdef reg_LIP  #ifdef reg_LIP
2690      unsigned long lip;      INTERIOR_POINTER_VARS(lip);
     unsigned long lip_offset;  
     int lip_register_pair;  
2691  #endif  #endif
2692  #ifdef reg_LR  #ifdef reg_LR
2693      unsigned long lr_code_offset;      INTERIOR_POINTER_VARS(lr);
2694  #endif  #endif
2695  #ifdef reg_CTR  #ifdef reg_CTR
2696      unsigned long ctr_code_offset;      INTERIOR_POINTER_VARS(ctr);
2697  #endif  #endif
2698  #ifdef SC_NPC  #ifdef SC_NPC
2699      unsigned long npc_code_offset;      INTERIOR_POINTER_VARS(npc);
2700  #endif  #endif
2701    
2702  #ifdef reg_LIP  #ifdef reg_LIP
2703      /* Find the LIP's register pair and calculate it's offset */      PAIR_INTERIOR_POINTER(lip, SC_REG(context, reg_LIP));
     /* before we scavenge the context. */  
   
     /*  
      * I (RLT) think this is trying to find the boxed register that is  
      * closest to the LIP address, without going past it.  Usually, it's  
      * reg_CODE or reg_LRA.  But sometimes, nothing can be found.  
      */  
     lip = SC_REG(context, reg_LIP);  
     lip_offset = 0x7FFFFFFF;  
     lip_register_pair = -1;  
     for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {  
         unsigned long reg;  
         long offset;  
         int index;  
   
         index = boxed_registers[i];  
         reg = SC_REG(context, index);  
         if (Pointerp(reg) && PTR(reg) <= lip) {  
             offset = lip - reg;  
             if (offset < lip_offset) {  
                 lip_offset = offset;  
                 lip_register_pair = index;  
             }  
         }  
     }  
2704  #endif /* reg_LIP */  #endif /* reg_LIP */
2705    
2706      /*      PAIR_INTERIOR_POINTER(pc, SC_PC(context));
2707       * Compute the PC's offset from the start of the CODE  
      * register.  
      */  
     pc_code_offset = SC_PC(context) - SC_REG(context, reg_CODE);  
2708  #ifdef SC_NPC  #ifdef SC_NPC
2709      npc_code_offset = SC_NPC(context) - SC_REG(context, reg_CODE);      PAIR_INTERIOR_POINTER(npc, SC_NPC(context));
2710  #endif /* SC_NPC */  #endif
2711    
2712  #ifdef reg_LR  #ifdef reg_LR
2713      lr_code_offset = SC_REG(context, reg_LR) - SC_REG(context, reg_CODE);      PAIR_INTERIOR_POINTER(pc, SC_REG(context, reg_LR));
2714  #endif  #endif
2715    
2716  #ifdef reg_CTR  #ifdef reg_CTR
2717      ctr_code_offset = SC_REG(context, reg_CTR) - SC_REG(context, reg_CODE);      PAIR_INTERIOR_POINTER(pc, SC_REG(context, reg_CTR));
2718  #endif  #endif
2719    
2720      /* Scanvenge all boxed registers in the context. */      /* Scanvenge all boxed registers in the context. */
# Line 2352  scavenge_interrupt_context(os_context_t Line 2730  scavenge_interrupt_context(os_context_t
2730          scavenge(&(SC_REG(context, index)), 1);          scavenge(&(SC_REG(context, index)), 1);
2731      }      }
2732    
2733        /*
2734         * Now that the scavenging is done, repair the various interior
2735         * pointers.
2736         */
2737  #ifdef reg_LIP  #ifdef reg_LIP
2738      /* Fix the LIP */      FIXUP_INTERIOR_POINTER(lip, SC_REG(context, reg_LIP));
2739    #endif
2740    
2741      /*      FIXUP_INTERIOR_POINTER(pc, SC_PC(context));
      * But what happens if lip_register_pair is -1?  SC_REG on Solaris  
      * (see solaris_register_address in solaris-os.c) will return  
      * &context->uc_mcontext.gregs[2].  But gregs[2] is REG_nPC.  Is  
      * that what we really want?  My guess is that that is not what we  
      * want, so if lip_register_pair is -1, we don't touch reg_LIP at  
      * all.  But maybe it doesn't really matter if LIP is trashed?  
      */  
     if (lip_register_pair >= 0) {  
         SC_REG(context, reg_LIP) =  
             SC_REG(context, lip_register_pair) + lip_offset;  
     }  
 #endif /* reg_LIP */  
2742    
     /* Fix the PC if it was in from space */  
     if (from_space_p(SC_PC(context))) {  
         SC_PC(context) = SC_REG(context, reg_CODE) + pc_code_offset;  
     }  
2743  #ifdef SC_NPC  #ifdef SC_NPC
2744      if (from_space_p(SC_NPC(context))) {      FIXUP_INTERIOR_POINTER(npc, SC_NPC(context));
2745          SC_NPC(context) = SC_REG(context, reg_CODE) + npc_code_offset;  #endif
     }  
 #endif /* SC_NPC */  
2746    
2747  #ifdef reg_LR  #ifdef reg_LR
2748      if (from_space_p(SC_REG(context, reg_LR))) {      FIXUP_INTERIOR_POINTER(lr, SC_REG(context, reg_LR));
2749          SC_REG(context, reg_LR) = SC_REG(context, reg_CODE) + lr_code_offset;  #endif
2750      }  
 #endif  
2751  #ifdef reg_CTR  #ifdef reg_CTR
2752      if (from_space_p(SC_REG(context, reg_CTR))) {      FIXUP_INTERIOR_POINTER(ctr, SC_REG(context, reg_CTR));
2753        SC_REG(context, reg_CTR) = SC_REG(context, reg_CODE) + ctr_code_offset;  #endif
     }  
 #endif  
2754  }  }
2755    
2756  void  void
# Line 2420  scavenge_interrupt_contexts(void) Line 2782  scavenge_interrupt_contexts(void)
2782   * Aargh!  Why is SPARC so different here?  What is the advantage of   * Aargh!  Why is SPARC so different here?  What is the advantage of
2783   * making it different from all the other ports?   * making it different from all the other ports?
2784   */   */
2785  #if defined(sparc) || defined(DARWIN)  #if defined(sparc) || (defined(DARWIN) && defined(__ppc__))
2786  #define RAW_ADDR_OFFSET 0  #define RAW_ADDR_OFFSET 0
2787  #else  #else
2788  #define RAW_ADDR_OFFSET (6 * sizeof(lispobj) - type_FunctionPointer)  #define RAW_ADDR_OFFSET (6 * sizeof(lispobj) - type_FunctionPointer)
# Line 2544  void Line 2906  void
2906  sniff_code_object(struct code *code, unsigned displacement)  sniff_code_object(struct code *code, unsigned displacement)
2907  {  {
2908      int nheader_words, ncode_words, nwords;      int nheader_words, ncode_words, nwords;
2909      void *p;      char *p;
2910      void *constants_start_addr, *constants_end_addr;      char *constants_start_addr, *constants_end_addr;
2911      void *code_start_addr, *code_end_addr;      char *code_start_addr, *code_end_addr;
2912      int fixup_found = 0;      int fixup_found = 0;
2913    
2914      if (!check_code_fixups)      if (!check_code_fixups)
# Line 2570  sniff_code_object(struct code *code, uns Line 2932  sniff_code_object(struct code *code, uns
2932      nheader_words = HeaderValue(*(lispobj *) code);      nheader_words = HeaderValue(*(lispobj *) code);
2933      nwords = ncode_words + nheader_words;      nwords = ncode_words + nheader_words;
2934    
2935      constants_start_addr = (void *) code + 5 * sizeof(lispobj);      constants_start_addr = (char *) code + 5 * sizeof(lispobj);
2936      constants_end_addr = (void *) code + nheader_words * sizeof(lispobj);      constants_end_addr = (char *) code + nheader_words * sizeof(lispobj);
2937      code_start_addr = (void *) code + nheader_words * sizeof(lispobj);      code_start_addr = (char *) code + nheader_words * sizeof(lispobj);
2938      code_end_addr = (void *) code + nwords * sizeof(lispobj);      code_end_addr = (char *) code + nwords * sizeof(lispobj);
2939    
2940      /* Work through the unboxed code. */      /* Work through the unboxed code. */
2941      for (p = code_start_addr; p < code_end_addr; p++) {      for (p = code_start_addr; p < code_end_addr; p++) {
2942          void *data = *(void **) p;          char *data = *(char **) p;
2943          unsigned d1 = *((unsigned char *) p - 1);          unsigned d1 = *((unsigned char *) p - 1);
2944          unsigned d2 = *((unsigned char *) p - 2);          unsigned d2 = *((unsigned char *) p - 2);
2945          unsigned d3 = *((unsigned char *) p - 3);          unsigned d3 = *((unsigned char *) p - 3);
# Line 2751  static void Line 3113  static void
3113  apply_code_fixups(struct code *old_code, struct code *new_code)  apply_code_fixups(struct code *old_code, struct code *new_code)
3114  {  {
3115      int nheader_words, ncode_words, nwords;      int nheader_words, ncode_words, nwords;
3116      void *constants_start_addr, *constants_end_addr;      char *constants_start_addr, *constants_end_addr;
3117      void *code_start_addr, *code_end_addr;      char *code_start_addr, *code_end_addr;
3118      lispobj fixups = NIL;      lispobj fixups = NIL;
3119      unsigned long displacement =      unsigned long displacement =
3120    
# Line 2779  apply_code_fixups(struct code *old_code, Line 3141  apply_code_fixups(struct code *old_code,
3141              "*** Compiled code object at %x: header_words=%d code_words=%d .\n",              "*** Compiled code object at %x: header_words=%d code_words=%d .\n",
3142              new_code, nheader_words, ncode_words);              new_code, nheader_words, ncode_words);
3143  #endif  #endif
3144      constants_start_addr = (void *) new_code + 5 * sizeof(lispobj);      constants_start_addr = (char *) new_code + 5 * sizeof(lispobj);
3145      constants_end_addr = (void *) new_code + nheader_words * sizeof(lispobj);      constants_end_addr = (char *) new_code + nheader_words * sizeof(lispobj);
3146      code_start_addr = (void *) new_code + nheader_words * sizeof(lispobj);      code_start_addr = (char *) new_code + nheader_words * sizeof(lispobj);
3147      code_end_addr = (void *) new_code + nwords * sizeof(lispobj);      code_end_addr = (char *) new_code + nwords * sizeof(lispobj);
3148  #if 0  #if 0
3149      fprintf(stderr,      fprintf(stderr,
3150              "*** Const. start = %x; end= %x; Code start = %x; end = %x\n",              "*** Const. start = %x; end= %x; Code start = %x; end = %x\n",
# Line 3082  scav_closure_header(lispobj * where, lis Line 3444  scav_closure_header(lispobj * where, lis
3444    
3445      closure = (struct closure *) where;      closure = (struct closure *) where;
3446      fun = closure->function - RAW_ADDR_OFFSET;      fun = closure->function - RAW_ADDR_OFFSET;
3447    #if !(defined(i386) && defined(SOLARIS))
3448      scavenge(&fun, 1);      scavenge(&fun, 1);
3449      /* The function may have moved so update the raw address. But don't      /* The function may have moved so update the raw address. But don't
3450         write unnecessarily. */         write unnecessarily. */
3451      if (closure->function != fun + RAW_ADDR_OFFSET)      if (closure->function != fun + RAW_ADDR_OFFSET)
3452          closure->function = fun + RAW_ADDR_OFFSET;          closure->function = fun + RAW_ADDR_OFFSET;
3453    #else
3454        /*
3455         * For some reason, on solaris/x86, we get closures (actually, it
3456         * appears to be funcallable instances where the closure function
3457         * is zero.  I don't know why, but they are.  They don't seem to
3458         * be created anywhere and it doesn't seem to be caused by GC
3459         * transport.
3460         *
3461         * Anyway, we check for zero and skip scavenging if so.
3462         * (Previously, we'd get a segfault scavenging the object at
3463         * address -RAW_ADDR_OFFSET.
3464         */
3465        if (closure->function) {
3466            scavenge(&fun, 1);
3467            /*
3468             * The function may have moved so update the raw address. But don't
3469             * write unnecessarily.
3470             */
3471            if (closure->function != fun + RAW_ADDR_OFFSET) {
3472    #if 0
3473                fprintf(stderr, "closure header 0x%04x moved from %p to %p\n",
3474                        closure->header, (void*) closure->function, (void*) (fun + RAW_ADDR_OFFSET));
3475    #endif
3476                closure->function = fun + RAW_ADDR_OFFSET;
3477            }
3478        }
3479    #if 0
3480         else {
3481            fprintf(stderr, "Weird closure!\n");
3482            fprintf(stderr, " where = %p, object = 0x%04x\n", where, object);
3483            fprintf(stderr, " closure->function = %p, fun = %p\n", closure->function, fun);
3484        }
3485    #endif
3486    #endif
3487      return 2;      return 2;
3488  }  }
3489    
# Line 3450  size_boxed(lispobj * where) Line 3846  size_boxed(lispobj * where)
3846  }  }
3847    
3848  /* Not needed on sparc and ppc because the raw_addr has a function lowtag */  /* Not needed on sparc and ppc because the raw_addr has a function lowtag */
3849  #if !(defined(sparc) || defined(DARWIN))  #if !(defined(sparc) || (defined(DARWIN) && defined(__ppc__)))
3850  static int  static int
3851  scav_fdefn(lispobj * where, lispobj object)  scav_fdefn(lispobj * where, lispobj object)
3852  {  {
# Line 3545  size_string(lispobj * where) Line 3941  size_string(lispobj * where)
3941    
3942      vector = (struct vector *) where;      vector = (struct vector *) where;
3943      length = fixnum_value(vector->length) + 1;      length = fixnum_value(vector->length) + 1;
3944    #ifndef UNICODE
3945  #ifdef __x86_64  #ifdef __x86_64
3946      nwords = CEILING(NWORDS(length, 8) + 2, 2);      nwords = CEILING(NWORDS(length, 8) + 2, 2);
3947  #else  #else
3948      nwords = CEILING(NWORDS(length, 4) + 2, 2);      nwords = CEILING(NWORDS(length, 4) + 2, 2);
3949  #endif  #endif
3950    #else
3951        /*
3952         * Strings are just like arrays with 16-bit elements, and contain
3953         * one more element than the slot length indicates.
3954         */
3955        nwords = CEILING(NWORDS(length, 2) + 2, 2);
3956    #endif
3957      return nwords;      return nwords;
3958  }  }
3959    
# Line 3592  struct hash_table { Line 3996  struct hash_table {
3996      lispobj index_vector;      lispobj index_vector;
3997      lispobj next_vector;      lispobj next_vector;
3998      lispobj hash_vector;        /* 15 */      lispobj hash_vector;        /* 15 */
3999        lispobj next_weak_table;
4000  };  };
4001    
4002  /* The size of a hash-table in Lisp objects.  */  /* The size of a hash-table in Lisp objects.  */
# Line 3605  struct hash_table { Line 4010  struct hash_table {
4010    
4011  /* List of weak hash tables chained through their WEAK-P slot.  Set to  /* List of weak hash tables chained through their WEAK-P slot.  Set to
4012     NIL at the start of a collection.     NIL at the start of a collection.
4013    
4014     This is not optimal because, when a table is tenured, it won't be     This is not optimal because, when a table is tenured, it won't be
4015     processed automatically; only the yougest generation is GC'd by     processed automatically; only the yougest generation is GC'd by
4016     default.  On the other hand, all applications will need an     default.  On the other hand, all applications will need an
# Line 3652  u32_vector(lispobj obj, unsigned *length Line 4057  u32_vector(lispobj obj, unsigned *length
4057  static inline void  static inline void
4058  free_hash_entry(struct hash_table *hash_table, int hash_index, int kv_index)  free_hash_entry(struct hash_table *hash_table, int hash_index, int kv_index)
4059  {  {
4060      unsigned *index_vector = u32_vector(hash_table->index_vector, 0);      unsigned length = UINT_MAX; // to compare to
4061        unsigned *index_vector = u32_vector(hash_table->index_vector, &length);
4062      unsigned *next_vector = u32_vector(hash_table->next_vector, 0);      unsigned *next_vector = u32_vector(hash_table->next_vector, 0);
4063      int free_p = 1;      int free_p = 1;
4064    
4065        gc_assert(length != UINT_MAX);
4066    
4067      if (index_vector[hash_index] == kv_index)      if (index_vector[hash_index] == kv_index)
4068          /* The entry is the first in the collinion chain.          /* The entry is the first in the collinion chain.
# Line 3676  free_hash_entry(struct hash_table *hash_ Line 4084  free_hash_entry(struct hash_table *hash_
4084    
4085      if (free_p) {      if (free_p) {
4086          unsigned count = fixnum_value(hash_table->number_entries);          unsigned count = fixnum_value(hash_table->number_entries);
4087            lispobj* kv_vector = (lispobj *) PTR(hash_table->table);
4088            unsigned *hash_vector = u32_vector(hash_table->hash_vector, 0);
4089            unsigned hash_index;
4090            lispobj empty_symbol;
4091    
4092          gc_assert(count > 0);          gc_assert(count > 0);
4093          hash_table->number_entries = make_fixnum(count - 1);          hash_table->number_entries = make_fixnum(count - 1);
4094          next_vector[kv_index] = fixnum_value(hash_table->next_free_kv);          next_vector[kv_index] = fixnum_value(hash_table->next_free_kv);
4095          hash_table->next_free_kv = make_fixnum(kv_index);          hash_table->next_free_kv = make_fixnum(kv_index);
4096            /*
4097             * I (rtoy) think we also need to clear out the key and value
4098             * in the kv-vector.  If we don't, maphash and
4099             * with-hash-table-iterator thinks this entry is not empty.
4100             */
4101    
4102            kv_vector += 2;         /* Skip over vector header and length slots */
4103            empty_symbol = kv_vector[1];
4104    
4105            hash_index = EQ_HASH(kv_vector[2 * kv_index]) % length;
4106    
4107            kv_vector[2 * kv_index] = empty_symbol;
4108            kv_vector[2 * kv_index + 1] = empty_symbol;
4109            if (hash_vector) {
4110                hash_vector[hash_index] = EQ_BASED_HASH_VALUE;
4111            }
4112      }      }
4113  }  }
4114    
# Line 3719  record_for_rehashing(struct hash_table * Line 4147  record_for_rehashing(struct hash_table *
4147      }      }
4148  }  }
4149    
4150    static inline boolean
4151    eq_based_hash_vector(unsigned int* hash_vector, unsigned int index)
4152    {
4153        return (hash_vector == 0) || (hash_vector[index] == EQ_BASED_HASH_VALUE);
4154    }
4155    
4156    static inline boolean
4157    removable_weak_key(lispobj old_key, unsigned int index_value, boolean eq_hash_p)
4158    {
4159      return (!survives_gc(old_key)
4160              && eq_hash_p
4161              && (index_value != 0));
4162    }
4163    
4164    static inline boolean
4165    removable_weak_value(lispobj value, unsigned int index_value)
4166    {
4167        /*
4168         * The entry can be removed if the value can be GCed.
4169         */
4170        return (!survives_gc(value)
4171                && (index_value != 0));
4172    }
4173    
4174    static inline boolean
4175    removable_weak_key_and_value(lispobj old_key, lispobj value, unsigned int index_value,
4176                                 boolean eq_hash_p)
4177    {
4178      boolean removable_key;
4179      boolean removable_val;
4180    
4181      removable_key = (!survives_gc(old_key)
4182                       && eq_hash_p
4183                       && (index_value != 0));
4184      removable_val = (!survives_gc(value)
4185                       && (index_value != 0));
4186    
4187      /*
4188       * The entry must stay if the key and value are alive.  In other
4189       * words, the entry can be removed if the key or value can be GCed.
4190       */
4191      return removable_key || removable_val;
4192    }
4193    
4194    static inline boolean
4195    removable_weak_key_or_value(lispobj old_key, lispobj value, unsigned int index_value,
4196                                boolean eq_hash_p)
4197    {
4198      boolean removable_key;
4199      boolean removable_val;
4200    
4201      removable_key = (!survives_gc(old_key)
4202                       && eq_hash_p
4203                       && (index_value != 0));
4204      removable_val = (!survives_gc(value)
4205                       && (index_value != 0));
4206    
4207      /*
4208       * The entry must be kept if either the key or value is alive.  In
4209       * other words, the entry can be removed only if both the key and
4210       * value can be GCed.
4211       */
4212      return (removable_key && removable_val);
4213    }
4214    
4215    static void
4216    maybe_record_for_rehashing(struct hash_table *hash_table, lispobj* kv_vector,
4217                               unsigned int length,
4218                               unsigned int old_index,
4219                               unsigned int i,
4220                               boolean eq_hash_p,
4221                               unsigned int index_value)
4222    {
4223        lispobj new_key;
4224        unsigned int new_index;
4225        lispobj empty_symbol;
4226        lispobj value;
4227    
4228        new_key = kv_vector[2 * i];
4229        value = kv_vector[2 * i + 1];
4230        new_index = EQ_HASH(new_key) % length;
4231        empty_symbol = kv_vector[1];
4232    
4233        if (old_index != new_index
4234            && eq_hash_p
4235            && index_value != 0
4236            && (new_key != empty_symbol
4237                || (value != empty_symbol))) {
4238            record_for_rehashing(hash_table, old_index, i);
4239        }
4240    }
4241    
4242  /* Scavenge the keys and values of hash-table HASH_TABLE.  WEAK  /* Scavenge the keys and values of hash-table HASH_TABLE.  WEAK
4243     non-zero means this function is called for a weak hash-table at the     non-zero means this function is called for a weak hash-table at the
4244     end of a GC.  WEAK zero means this function is called for     end of a GC.  WEAK zero means this function is called for
# Line 3726  record_for_rehashing(struct hash_table * Line 4246  record_for_rehashing(struct hash_table *
4246     scheduled for rehashing or removed.  */     scheduled for rehashing or removed.  */
4247    
4248  static void  static void
4249  scav_hash_entries(struct hash_table *hash_table, int weak)  scav_hash_entries(struct hash_table *hash_table, lispobj weak, int removep)
4250  {  {
4251      unsigned kv_length;      unsigned kv_length;
4252      lispobj *kv_vector;      lispobj *kv_vector;
     unsigned *index_vector, *next_vector, *hash_vector;  
     unsigned length;  
4253      lispobj empty_symbol;      lispobj empty_symbol;
4254      unsigned next_vector_length;      unsigned *index_vector, *next_vector, *hash_vector;
4255        unsigned length = UINT_MAX;
4256        unsigned next_vector_length = UINT_MAX;
4257      unsigned i;      unsigned i;
4258    
4259      kv_vector = (lispobj *) PTR(hash_table->table);      kv_vector = (lispobj *) PTR(hash_table->table);
# Line 3746  scav_hash_entries(struct hash_table *has Line 4266  scav_hash_entries(struct hash_table *has
4266      next_vector = u32_vector(hash_table->next_vector, &next_vector_length);      next_vector = u32_vector(hash_table->next_vector, &next_vector_length);
4267      hash_vector = u32_vector(hash_table->hash_vector, 0);      hash_vector = u32_vector(hash_table->hash_vector, 0);
4268    
4269        gc_assert(length != UINT_MAX);
4270        gc_assert(next_vector_length != UINT_MAX);
4271    
4272      gc_assert(index_vector && next_vector);      gc_assert(index_vector && next_vector);
4273      gc_assert(next_vector_length * 2 == kv_length);      gc_assert(next_vector_length * 2 == kv_length);
4274    
4275      for (i = 1; i < next_vector_length; i++) {      for (i = 1; i < next_vector_length; i++) {
4276          lispobj old_key = kv_vector[2 * i];          lispobj old_key = kv_vector[2 * i];
4277            lispobj value = kv_vector[2 * i + 1];
4278          unsigned int old_index = EQ_HASH(old_key) % length;          unsigned int old_index = EQ_HASH(old_key) % length;
4279          lispobj new_key;          boolean eq_hash_p = eq_based_hash_vector(hash_vector, i);
4280          unsigned int new_index;          unsigned int index_value = index_vector[old_index];
4281    
4282          if (weak && !survives_gc(old_key)          if (((weak == KEY)
4283              && index_vector[old_index] != 0               && removable_weak_key(old_key, index_value,
4284              && (hash_vector == 0 || hash_vector[i] == 0x80000000))                                     eq_hash_p))
4285              free_hash_entry(hash_table, old_index, i);              || ((weak == VALUE)
4286          else {                  && removable_weak_value(value, index_value))
4287                || ((weak == KEY_AND_VALUE)
4288                    && removable_weak_key_and_value(old_key, value, index_value, eq_hash_p))
4289                || ((weak == KEY_OR_VALUE)
4290                    && removable_weak_key_or_value(old_key, value, index_value, eq_hash_p))) {
4291                if (removep) {
4292                    free_hash_entry(hash_table, old_index, i);
4293                }
4294            } else {
4295              /* If the key is EQ-hashed and moves, schedule it for rehashing. */              /* If the key is EQ-hashed and moves, schedule it for rehashing. */
4296              scavenge(&kv_vector[2 * i], 2);              scavenge(&kv_vector[2 * i], 2);
4297    #if 0
4298              new_key = kv_vector[2 * i];              new_key = kv_vector[2 * i];
4299              new_index = EQ_HASH(new_key) % length;              new_index = EQ_HASH(new_key) % length;
4300    
4301              if (old_index != new_index              if (old_index != new_index
4302                  && index_vector[old_index] != 0                  && eq_hash_p
4303                  && (hash_vector == 0 || hash_vector[i] == 0x80000000)                  && index_value != 0
4304                  && (new_key != empty_symbol                  && (new_key != empty_symbol
4305                      || kv_vector[2 * i + 1] != empty_symbol))                      || (value != empty_symbol))) {
4306                      record_for_rehashing(hash_table, old_index, i);                  record_for_rehashing(hash_table, old_index, i);
4307                }
4308    #endif
4309                maybe_record_for_rehashing(hash_table, kv_vector, length, old_index, i, eq_hash_p,
4310                                           index_value);
4311          }          }
4312      }      }
4313  }  }
4314    
4315    static inline boolean
4316    weak_key_survives(lispobj old_key, unsigned index_value, unsigned int eq_hash_p)
4317    {
4318        return (survives_gc(old_key)
4319                && index_value != 0
4320                && eq_hash_p);
4321    }
4322    
4323    static inline boolean
4324    weak_value_survives(lispobj value)
4325    {
4326        return (survives_gc(value));
4327    }
4328    
4329  /* Scavenge entries of the weak hash-table HASH_TABLE that haven't  /* Scavenge entries of the weak hash-table HASH_TABLE that haven't
4330     been already.  Value is 1 if anything new has been scavenged, 0     been already.  Value is 1 if anything new has been scavenged, 0
4331     otherwise.  */     otherwise.  */
# Line 3784  scav_weak_entries(struct hash_table *has Line 4335  scav_weak_entries(struct hash_table *has
4335  {  {
4336      lispobj *kv_vector;      lispobj *kv_vector;
4337      unsigned *index_vector, *hash_vector;      unsigned *index_vector, *hash_vector;
4338      unsigned length;      unsigned length = UINT_MAX;
4339      unsigned next_vector_length;      unsigned next_vector_length = UINT_MAX;
4340      unsigned i, scavenged = 0;      unsigned i, scavenged = 0;
4341    
4342      kv_vector = (lispobj *) PTR(hash_table->table) + 2;      kv_vector = (lispobj *) PTR(hash_table->table) + 2;
# Line 3794  scav_weak_entries(struct hash_table *has Line 4345  scav_weak_entries(struct hash_table *has
4345      u32_vector(hash_table->next_vector, &next_vector_length);      u32_vector(hash_table->next_vector, &next_vector_length);
4346      hash_vector = u32_vector(hash_table->hash_vector, 0);      hash_vector = u32_vector(hash_table->hash_vector, 0);
4347    
4348        gc_assert(length != UINT_MAX);
4349        gc_assert(next_vector_length != UINT_MAX);
4350    
4351      for (i = 1; i < next_vector_length; i++) {      for (i = 1; i < next_vector_length; i++) {
4352          lispobj old_key = kv_vector[2 * i];          lispobj old_key = kv_vector[2 * i];
4353            lispobj value = kv_vector[2 * i + 1];
4354          unsigned int old_index = EQ_HASH(old_key) % length;          unsigned int old_index = EQ_HASH(old_key) % length;
4355            boolean eq_hash_p = eq_based_hash_vector(hash_vector, i);
4356            boolean key_survives = weak_key_survives(old_key,
4357                                                     index_vector[old_index], eq_hash_p);
4358            boolean value_survives = weak_value_survives(value);
4359    
4360    
4361          /* If the key survives, scavenge its value, for the case that          if ((hash_table->weak_p == KEY)
4362             the only reference to a key in a weak table is a value in              && key_survives
4363             another weak table.  Don't scavenge the value twice;              && !survives_gc(value)) {
4364             scan_weak_tables calls this function more than once for the              /*
4365             same hash table.  */               * For a weak key hash table, if the key survives,
4366          if (survives_gc(old_key)               * scavenge its value, for the case that the only
4367              && index_vector[old_index] != 0               * reference to a key in a weak table is a value in
4368              && (hash_vector == 0 || hash_vector[old_index] == 0x80000000)               * another weak table.  Don't scavenge the value twice;
4369              && !survives_gc(kv_vector[2 * i + 1])) {               * scan_weak_tables calls this function more than once for
4370                 * the same hash table.
4371                 */
4372              scavenge(&kv_vector[2 * i + 1], 1);              scavenge(&kv_vector[2 * i + 1], 1);
4373              scavenged = 1;              scavenged = 1;
4374            } else if ((hash_table->weak_p == VALUE)
4375                       && value_survives
4376                       && !survives_gc(old_key)) {
4377                /*
4378                 * For a weak value hash table, scavenge the key, if the
4379                 * value survives gc.
4380                 */
4381                scavenge(&kv_vector[2 * i], 1);
4382                maybe_record_for_rehashing(hash_table, kv_vector, length, old_index, i, eq_hash_p,
4383                                           index_vector[old_index]);
4384                scavenged = 1;
4385            } else if ((hash_table->weak_p == KEY_AND_VALUE)
4386                       && key_survives && value_survives) {
4387                /* There's nothing to do for key-and-value.  Both are already alive */
4388            } else if ((hash_table->weak_p == KEY_OR_VALUE)
4389                       && (key_survives || value_survives)) {
4390                /* For key-or-value, make sure the other is scavenged */
4391                if (key_survives && !survives_gc(value)) {
4392                    scavenge(&kv_vector[2 * i + 1], 1);
4393                    scavenged = 1;
4394                }
4395                if (value_survives && !survives_gc(old_key)) {
4396                    scavenge(&kv_vector[2 * i], 1);
4397                    maybe_record_for_rehashing(hash_table, kv_vector, length, old_index, i,
4398                                               eq_hash_p,
4399                                               index_vector[old_index]);
4400                    scavenged = 1;
4401                }
4402          }          }
4403      }      }
4404    
4405      return scavenged;      return scavenged;
4406  }  }
4407    
 /* Process weak hash-tables at the end of a GC.  */  
   
4408  static void  static void
4409  scan_weak_tables(void)  scav_weak_tables(void)
4410  {  {
4411      lispobj table, next;      lispobj table, next;
4412      int more_scavenged;      int more_scavenged;
# Line 3832  scan_weak_tables(void) Line 4420  scan_weak_tables(void)
4420          for (table = weak_hash_tables; table != NIL; table = next) {          for (table = weak_hash_tables; table != NIL; table = next) {
4421              struct hash_table *ht = (struct hash_table *) PTR(table);              struct hash_table *ht = (struct hash_table *) PTR(table);
4422    
4423              next = ht->weak_p;              next = ht->next_weak_table;
4424              if (scav_weak_entries(ht))              if (scav_weak_entries(ht))
4425                  more_scavenged = 1;                  more_scavenged = 1;
4426          }          }
# Line 3842  scan_weak_tables(void) Line 4430  scan_weak_tables(void)
4430      for (table = weak_hash_tables; table != NIL; table = next) {      for (table = weak_hash_tables; table != NIL; table = next) {
4431          struct hash_table *ht = (struct hash_table *) PTR(table);          struct hash_table *ht = (struct hash_table *) PTR(table);
4432    
4433          next = ht->weak_p;          next = ht->next_weak_table;
4434          ht->weak_p = T;          scav_hash_entries(ht, ht->weak_p, 0);
4435          scav_hash_entries(ht, 1);      }
4436    }
4437    
4438    
4439    /* Process weak hash-tables at the end of a GC.  */
4440    
4441    static void
4442    scan_weak_tables(void)
4443    {
4444        lispobj table, next;
4445    
4446        for (table = weak_hash_tables; table != NIL; table = next) {
4447            struct hash_table *ht = (struct hash_table *) PTR(table);
4448    
4449            next = ht->next_weak_table;
4450            /* We're done with the table, so reset the link! */
4451            ht->next_weak_table = NIL;
4452            /*
4453             * Remove the entries in the table.  (This probably does too
4454             * much work!)
4455             */
4456            scav_hash_entries(ht, ht->weak_p, 1);
4457      }      }
4458    
4459      weak_hash_tables = NIL;      weak_hash_tables = NIL;
# Line 3902  scav_hash_vector(lispobj * where, lispob Line 4511  scav_hash_vector(lispobj * where, lispob
4511      }      }
4512  #endif  #endif
4513    
4514  #if !(defined(sparc) || defined(DARWIN))  #if !(defined(sparc) || (defined(DARWIN) && defined(__ppc__)))
4515      gc_assert(where == (lispobj *) PTR(hash_table->table));      gc_assert(where == (lispobj *) PTR(hash_table->table));
4516  #endif  #endif
4517      gc_assert(TypeOf(hash_table->instance_header) == type_InstanceHeader);      gc_assert(TypeOf(hash_table->instance_header) == type_InstanceHeader);
# Line 3910  scav_hash_vector(lispobj * where, lispob Line 4519  scav_hash_vector(lispobj * where, lispob
4519    
4520      /* Scavenging the hash table which fix the positions of the other      /* Scavenging the hash table which fix the positions of the other
4521         needed objects.  */         needed objects.  */
4522      scavenge((lispobj *) hash_table, HASH_TABLE_SIZE);  #if 0
4523        if (hash_table >= (void*) 0x40000000) {
4524            fprintf(stderr, "scav_hash_vector: scavenge table %p\n", hash_table);
4525        }
4526    #endif
4527    
4528      /* Testing for T here instead of NIL automatially makes sure we      scavenge((lispobj *) hash_table, HASH_TABLE_SIZE);
        don't add the same table twice to the list of weak tables, should  
        this function ever be called twice for the same object.  */  
     if (hash_table->weak_p == T) {  
         hash_table->weak_p = weak_hash_tables;  
         weak_hash_tables = hash_table_obj;  
     } else  
         scav_hash_entries(hash_table, 0);  
4529    
4530        if (hash_table->weak_p == NIL) {
4531            scav_hash_entries(hash_table, hash_table->weak_p, 1);
4532        } else if (hash_table->next_weak_table == NIL) {
4533            /*
4534             * Make sure we only add the table once, which means
4535             * next_weak_table is NIL if it isn't already on the list.
4536             */
4537            hash_table->next_weak_table = weak_hash_tables;
4538            weak_hash_tables = hash_table_obj;
4539        }
4540    
4541      return CEILING(kv_length + 2, 2);      return CEILING(kv_length + 2, 2);
4542  }  }
4543    
# Line 4234  trans_vector_long_float(lispobj object) Line 4851  trans_vector_long_float(lispobj object)
4851  }  }
4852  #endif  #endif
4853    
4854    #ifdef type_SimpleArrayDoubleDoubleFloat
4855    static int
4856    size_vector_double_double_float(lispobj * where)
4857    {
4858        struct vector *vector;
4859        int length, nwords;
4860    
4861        vector = (struct vector *) where;
4862        length = fixnum_value(vector->length);
4863        nwords = CEILING(length * 4 + 2, 2);
4864    
4865        return nwords;
4866    }
4867    
4868    static int
4869    scav_vector_double_double_float(lispobj * where, lispobj object)
4870    {
4871        return size_vector_double_double_float(where);
4872    }
4873    
4874    static lispobj
4875    trans_vector_double_double_float(lispobj object)
4876    {
4877        gc_assert(Pointerp(object));
4878        return copy_large_unboxed_object(object,
4879                                         size_vector_double_double_float((lispobj *)
4880                                                                PTR(object)));
4881    }
4882    #endif
4883    
4884  #ifdef type_SimpleArrayComplexSingleFloat  #ifdef type_SimpleArrayComplexSingleFloat
4885  static int  static int
# Line 4341  trans_vector_complex_long_float(lispobj Line 4987  trans_vector_complex_long_float(lispobj
4987                                                                      (object)));                                                                      (object)));
4988  }  }
4989  #endif  #endif
4990    
4991    #ifdef type_SimpleArrayComplexDoubleDoubleFloat
4992    static int
4993    size_vector_complex_double_double_float(lispobj * where)
4994    {
4995        struct vector *vector;
4996        int length, nwords;
4997    
4998        vector = (struct vector *) where;
4999        length = fixnum_value(vector->length);
5000        nwords = length * 8 + 2;
5001    
5002        return nwords;
5003    }
5004    
5005    static int
5006    scav_vector_complex_double_double_float(lispobj * where, lispobj object)
5007    {
5008        return size_vector_complex_double_double_float(where);
5009    }
5010    
5011    static lispobj
5012    trans_vector_complex_double_double_float(lispobj object)
5013    {
5014        gc_assert(Pointerp(object));
5015        return copy_large_unboxed_object(object,
5016                                         size_vector_complex_double_double_float((lispobj *)
5017                                                                                 PTR
5018                                                                                 (object)));
5019    }
5020    #endif
5021    
5022    
5023    
5024  /* Weak Pointers */  /* Weak Pointers */
# Line 4372  scav_weak_pointer(lispobj * where, lispo Line 5050  scav_weak_pointer(lispobj * where, lispo
5050  static lispobj  static lispobj
5051  trans_weak_pointer(lispobj object)  trans_weak_pointer(lispobj object)
5052  {  {
5053        lispobj copy;
5054    
5055      gc_assert(Pointerp(object));      gc_assert(Pointerp(object));
5056      return copy_object(object, WEAK_POINTER_NWORDS);      copy = copy_object(object, WEAK_POINTER_NWORDS);
5057    #if 0
5058        fprintf(stderr, "Transport weak pointer %p to %p\n", object, copy);
5059    #endif
5060        return copy;
5061  }  }
5062    
5063  static int  static int
# Line 4536  gc_init_tables(void) Line 5220  gc_init_tables(void)
5220  #ifdef type_ComplexLongFloat  #ifdef type_ComplexLongFloat
5221      scavtab[type_ComplexLongFloat] = scav_unboxed;      scavtab[type_ComplexLongFloat] = scav_unboxed;
5222  #endif  #endif
5223    #ifdef type_ComplexDoubleDoubleFloat
5224        scavtab[type_ComplexDoubleDoubleFloat] = scav_unboxed;
5225    #endif
5226      scavtab[type_SimpleArray] = scav_boxed;      scavtab[type_SimpleArray] = scav_boxed;
5227      scavtab[type_SimpleString] = scav_string;      scavtab[type_SimpleString] = scav_string;
5228      scavtab[type_SimpleBitVector] = scav_vector_bit;      scavtab[type_SimpleBitVector] = scav_vector_bit;
# Line 4562  gc_init_tables(void) Line 5249  gc_init_tables(void)
5249  #ifdef type_SimpleArrayLongFloat  #ifdef type_SimpleArrayLongFloat
5250      scavtab[type_SimpleArrayLongFloat] = scav_vector_long_float;      scavtab[type_SimpleArrayLongFloat] = scav_vector_long_float;
5251  #endif  #endif
5252    #ifdef type_SimpleArrayDoubleDoubleFloat
5253        scavtab[type_SimpleArrayDoubleDoubleFloat] = scav_vector_double_double_float;
5254    #endif
5255  #ifdef type_SimpleArrayComplexSingleFloat  #ifdef type_SimpleArrayComplexSingleFloat
5256      scavtab[type_SimpleArrayComplexSingleFloat] =      scavtab[type_SimpleArrayComplexSingleFloat] =
5257          scav_vector_complex_single_float;          scav_vector_complex_single_float;
# Line 4573  gc_init_tables(void) Line 5263  gc_init_tables(void)
5263  #ifdef type_SimpleArrayComplexLongFloat  #ifdef type_SimpleArrayComplexLongFloat
5264      scavtab[type_SimpleArrayComplexLongFloat] = scav_vector_complex_long_float;      scavtab[type_SimpleArrayComplexLongFloat] = scav_vector_complex_long_float;
5265  #endif  #endif
5266    #ifdef type_SimpleArrayComplexDoubleDoubleFloat
5267        scavtab[type_SimpleArrayComplexDoubleDoubleFloat] =
5268            scav_vector_complex_double_double_float;
5269    #endif
5270      scavtab[type_ComplexString] = scav_boxed;      scavtab[type_ComplexString] = scav_boxed;
5271      scavtab[type_ComplexBitVector] = scav_boxed;      scavtab[type_ComplexBitVector] = scav_boxed;
5272      scavtab[type_ComplexVector] = scav_boxed;      scavtab[type_ComplexVector] = scav_boxed;
# Line 4588  gc_init_tables(void) Line 5282  gc_init_tables(void)
5282      scavtab[type_FuncallableInstanceHeader] = scav_closure_header;      scavtab[type_FuncallableInstanceHeader] = scav_closure_header;
5283      scavtab[type_ByteCodeFunction] = scav_closure_header;      scavtab[type_ByteCodeFunction] = scav_closure_header;
5284      scavtab[type_ByteCodeClosure] = scav_closure_header;      scavtab[type_ByteCodeClosure] = scav_closure_header;
5285    #ifdef type_DylanFunctionHeader
5286      scavtab[type_DylanFunctionHeader] = scav_closure_header;      scavtab[type_DylanFunctionHeader] = scav_closure_header;
5287    #endif
5288  #else  #else
5289      scavtab[type_ClosureHeader] = scav_boxed;      scavtab[type_ClosureHeader] = scav_boxed;
5290      scavtab[type_FuncallableInstanceHeader] = scav_boxed;      scavtab[type_FuncallableInstanceHeader] = scav_boxed;
5291      scavtab[type_ByteCodeFunction] = scav_boxed;      scavtab[type_ByteCodeFunction] = scav_boxed;
5292      scavtab[type_ByteCodeClosure] = scav_boxed;      scavtab[type_ByteCodeClosure] = scav_boxed;
5293    #ifdef type_DylanFunctionHeader
5294      scavtab[type_DylanFunctionHeader] = scav_boxed;      scavtab[type_DylanFunctionHeader] = scav_boxed;
5295  #endif  #endif
5296    #endif
5297      scavtab[type_ValueCellHeader] = scav_boxed;      scavtab[type_ValueCellHeader] = scav_boxed;
5298      scavtab[type_SymbolHeader] = scav_boxed;      scavtab[type_SymbolHeader] = scav_boxed;
5299      scavtab[type_BaseChar] = scav_immediate;      scavtab[type_BaseChar] = scav_immediate;
# Line 4607  gc_init_tables(void) Line 5305  gc_init_tables(void)
5305       * Note: for sparc and ppc we don't have to do anything special       * Note: for sparc and ppc we don't have to do anything special
5306       * for fdefns, cause the raw-addr has a function lowtag.       * for fdefns, cause the raw-addr has a function lowtag.
5307       */       */
5308  #if !(defined(sparc) || defined(DARWIN))  #if !(defined(sparc) || (defined(DARWIN) && defined(__ppc__)))
5309      scavtab[type_Fdefn] = scav_fdefn;      scavtab[type_Fdefn] = scav_fdefn;
5310  #else  #else
5311      scavtab[type_Fdefn] = scav_boxed;      scavtab[type_Fdefn] = scav_boxed;
# Line 4639  gc_init_tables(void) Line 5337  gc_init_tables(void)
5337  #ifdef type_ComplexLongFloat  #ifdef type_ComplexLongFloat
5338      transother[type_ComplexLongFloat] = trans_unboxed;      transother[type_ComplexLongFloat] = trans_unboxed;
5339  #endif  #endif
5340    #ifdef type_ComplexDoubleDoubleFloat
5341        transother[type_ComplexDoubleDoubleFloat] = trans_unboxed;
5342    #endif
5343      transother[type_SimpleArray] = trans_boxed_large;      transother[type_SimpleArray] = trans_boxed_large;
5344      transother[type_SimpleString] = trans_string;      transother[type_SimpleString] = trans_string;
5345      transother[type_SimpleBitVector] = trans_vector_bit;      transother[type_SimpleBitVector] = trans_vector_bit;
# Line 4665  gc_init_tables(void) Line 5366  gc_init_tables(void)
5366  #ifdef type_SimpleArrayLongFloat  #ifdef type_SimpleArrayLongFloat
5367      transother[type_SimpleArrayLongFloat] = trans_vector_long_float;      transother[type_SimpleArrayLongFloat] = trans_vector_long_float;
5368  #endif  #endif
5369    #ifdef type_SimpleArrayDoubleDoubleFloat
5370        transother[type_SimpleArrayDoubleDoubleFloat] = trans_vector_double_double_float;
5371    #endif
5372  #ifdef type_SimpleArrayComplexSingleFloat  #ifdef type_SimpleArrayComplexSingleFloat
5373      transother[type_SimpleArrayComplexSingleFloat] =      transother[type_SimpleArrayComplexSingleFloat] =
5374          trans_vector_complex_single_float;          trans_vector_complex_single_float;
# Line 4677  gc_init_tables(void) Line 5381  gc_init_tables(void)
5381      transother[type_SimpleArrayComplexLongFloat] =      transother[type_SimpleArrayComplexLongFloat] =
5382          trans_vector_complex_long_float;          trans_vector_complex_long_float;
5383  #endif  #endif
5384    #ifdef type_SimpleArrayComplexDoubleDoubleFloat
5385        transother[type_SimpleArrayComplexDoubleDoubleFloat] =
5386            trans_vector_complex_double_double_float;
5387    #endif
5388      transother[type_ComplexString] = trans_boxed;      transother[type_ComplexString] = trans_boxed;
5389      transother[type_ComplexBitVector] = trans_boxed;      transother[type_ComplexBitVector] = trans_boxed;
5390      transother[type_ComplexVector] = trans_boxed;      transother[type_ComplexVector] = trans_boxed;
# Line 4735  gc_init_tables(void) Line 5443  gc_init_tables(void)
5443  #ifdef type_ComplexLongFloat  #ifdef type_ComplexLongFloat
5444      sizetab[type_ComplexLongFloat] = size_unboxed;      sizetab[type_ComplexLongFloat] = size_unboxed;
5445  #endif  #endif
5446    #ifdef type_ComplexDoubleDoubleFloat
5447        sizetab[type_ComplexDoubleDoubleFloat] = size_unboxed;
5448    #endif
5449      sizetab[type_SimpleArray] = size_boxed;      sizetab[type_SimpleArray] = size_boxed;
5450      sizetab[type_SimpleString] = size_string;      sizetab[type_SimpleString] = size_string;
5451      sizetab[type_SimpleBitVector] = size_vector_bit;      sizetab[type_SimpleBitVector] = size_vector_bit;
# Line 4761  gc_init_tables(void) Line 5472  gc_init_tables(void)
5472  #ifdef type_SimpleArrayLongFloat  #ifdef type_SimpleArrayLongFloat
5473      sizetab[type_SimpleArrayLongFloat] = size_vector_long_float;      sizetab[type_SimpleArrayLongFloat] = size_vector_long_float;
5474  #endif  #endif
5475    #ifdef type_SimpleArrayDoubleDoubleFloat
5476        sizetab[type_SimpleArrayDoubleDoubleFloat] = size_vector_double_double_float;
5477    #endif
5478  #ifdef type_SimpleArrayComplexSingleFloat  #ifdef type_SimpleArrayComplexSingleFloat
5479      sizetab[type_SimpleArrayComplexSingleFloat] =      sizetab[type_SimpleArrayComplexSingleFloat] =
5480          size_vector_complex_single_float;          size_vector_complex_single_float;
# Line 4772  gc_init_tables(void) Line 5486  gc_init_tables(void)
5486  #ifdef type_SimpleArrayComplexLongFloat  #ifdef type_SimpleArrayComplexLongFloat
5487      sizetab[type_SimpleArrayComplexLongFloat] = size_vector_complex_long_float;      sizetab[type_SimpleArrayComplexLongFloat] = size_vector_complex_long_float;
5488  #endif  #endif
5489    #ifdef type_SimpleArrayComplexDoubleDoubleFloat
5490        sizetab[type_SimpleArrayComplexDoubleDoubleFloat] =
5491            size_vector_complex_double_double_float;
5492    #endif
5493      sizetab[type_ComplexString] = size_boxed;      sizetab[type_ComplexString] = size_boxed;
5494      sizetab[type_ComplexBitVector] = size_boxed;      sizetab[type_ComplexBitVector] = size_boxed;
5495      sizetab[type_ComplexVector] = size_boxed;      sizetab[type_ComplexVector] = size_boxed;
# Line 4918  valid_dynamic_space_pointer(lispobj * po Line 5636  valid_dynamic_space_pointer(lispobj * po
5636              case type_FuncallableInstanceHeader:              case type_FuncallableInstanceHeader:
5637              case type_ByteCodeFunction:              case type_ByteCodeFunction:
5638              case type_ByteCodeClosure:              case type_ByteCodeClosure:
5639    #ifdef type_DylanFunctionHeader
5640              case type_DylanFunctionHeader:              case type_DylanFunctionHeader:
5641    #endif
5642                  if ((size_t) pointer !=                  if ((size_t) pointer !=
5643                      (size_t) start_addr + type_FunctionPointer) {                      (size_t) start_addr + type_FunctionPointer) {
5644                      return FALSE;                      return FALSE;
# Line 4971  valid_dynamic_space_pointer(lispobj * po Line 5691  valid_dynamic_space_pointer(lispobj * po
5691              case type_FuncallableInstanceHeader:              case type_FuncallableInstanceHeader:
5692              case type_ByteCodeFunction:              case type_ByteCodeFunction:
5693              case type_ByteCodeClosure:              case type_ByteCodeClosure:
5694    #ifdef type_DylanFunctionHeader
5695              case type_DylanFunctionHeader:              case type_DylanFunctionHeader:
5696    #endif
5697                  return FALSE;                  return FALSE;
5698    
5699              case type_InstanceHeader:              case type_InstanceHeader:
# Line 4990  valid_dynamic_space_pointer(lispobj * po Line 5712  valid_dynamic_space_pointer(lispobj * po
5712  #ifdef type_ComplexLongFloat  #ifdef type_ComplexLongFloat
5713              case type_ComplexLongFloat:              case type_ComplexLongFloat:
5714  #endif  #endif
5715    #ifdef type_ComplexDoubleDoubleFloat
5716                case type_ComplexDoubleDoubleFloat:
5717    #endif
5718              case type_SimpleArray:              case type_SimpleArray:
5719              case type_ComplexString:              case type_ComplexString:
5720              case type_ComplexBitVector:              case type_ComplexBitVector:
# Line 5032  valid_dynamic_space_pointer(lispobj * po Line 5757  valid_dynamic_space_pointer(lispobj * po
5757  #ifdef type_SimpleArrayLongFloat  #ifdef type_SimpleArrayLongFloat
5758              case type_SimpleArrayLongFloat:              case type_SimpleArrayLongFloat:
5759  #endif  #endif
5760    #ifdef type_SimpleArrayDoubleDoubleFloat
5761                case type_SimpleArrayDoubleDoubleFloat:
5762    #endif
5763  #ifdef type_SimpleArrayComplexSingleFloat  #ifdef type_SimpleArrayComplexSingleFloat
5764              case type_SimpleArrayComplexSingleFloat:              case type_SimpleArrayComplexSingleFloat:
5765  #endif  #endif
# Line 5041  valid_dynamic_space_pointer(lispobj * po Line 5769  valid_dynamic_space_pointer(lispobj * po
5769  #ifdef type_SimpleArrayComplexLongFloat  #ifdef type_SimpleArrayComplexLongFloat
5770              case type_SimpleArrayComplexLongFloat:              case type_SimpleArrayComplexLongFloat:
5771  #endif  #endif
5772    #ifdef type_SimpleArrayComplexDoubleDoubleFloat
5773                case type_SimpleArrayComplexDoubleDoubleFloat:
5774    #endif
5775              case type_Sap:              case type_Sap:
5776              case type_WeakPointer:              case type_WeakPointer:
5777              case type_ScavengerHook:              case type_ScavengerHook:
# Line 5111  maybe_adjust_large_object(lispobj * wher Line 5842  maybe_adjust_large_object(lispobj * wher
5842  #ifdef type_SimpleArrayLongFloat  #ifdef type_SimpleArrayLongFloat
5843        case type_SimpleArrayLongFloat:        case type_SimpleArrayLongFloat:
5844  #endif  #endif
5845    #ifdef type_SimpleArrayDoubleDoubleFloat
5846          case type_SimpleArrayDoubleDoubleFloat:
5847    #endif
5848  #ifdef type_SimpleArrayComplexSingleFloat  #ifdef type_SimpleArrayComplexSingleFloat
5849        case type_SimpleArrayComplexSingleFloat:        case type_SimpleArrayComplexSingleFloat:
5850  #endif  #endif
# Line 5120  maybe_adjust_large_object(lispobj * wher Line 5854  maybe_adjust_large_object(lispobj * wher
5854  #ifdef type_SimpleArrayComplexLongFloat  #ifdef type_SimpleArrayComplexLongFloat
5855        case type_SimpleArrayComplexLongFloat:        case type_SimpleArrayComplexLongFloat:
5856  #endif  #endif
5857    #ifdef type_SimpleArrayComplexDoubleDoubleFloat
5858          case type_SimpleArrayComplexDoubleDoubleFloat:
5859    #endif
5860            unboxed = TRUE;            unboxed = TRUE;
5861            break;            break;
5862        default:        default:
# Line 5143  maybe_adjust_large_object(lispobj * wher Line 5880  maybe_adjust_large_object(lispobj * wher
5880    
5881      next_page = first_page;      next_page = first_page;
5882      remaining_bytes = nwords * sizeof(lispobj);      remaining_bytes = nwords * sizeof(lispobj);
5883      while (remaining_bytes > PAGE_SIZE) {      while (remaining_bytes > GC_PAGE_SIZE) {
5884          gc_assert(PAGE_GENERATION(next_page) == from_space);          gc_assert(PAGE_GENERATION(next_page) == from_space);
5885          gc_assert(PAGE_ALLOCATED(next_page));          gc_assert(PAGE_ALLOCATED(next_page));
5886          gc_assert(PAGE_LARGE_OBJECT(next_page));          gc_assert(PAGE_LARGE_OBJECT(next_page));
5887          gc_assert(page_table[next_page].first_object_offset ==          gc_assert(page_table[next_page].first_object_offset ==
5888                    PAGE_SIZE * (first_page - next_page));                    GC_PAGE_SIZE * (first_page - next_page));
5889          gc_assert(page_table[next_page].bytes_used == PAGE_SIZE);          gc_assert(page_table[next_page].bytes_used == GC_PAGE_SIZE);
5890    
5891          PAGE_FLAGS_UPDATE(next_page, PAGE_UNBOXED_MASK,          PAGE_FLAGS_UPDATE(next_page, PAGE_UNBOXED_MASK,
5892                            unboxed << PAGE_UNBOXED_SHIFT);                            unboxed << PAGE_UNBOXED_SHIFT);
# Line 5159  maybe_adjust_large_object(lispobj * wher Line 5896  maybe_adjust_large_object(lispobj * wher
5896           * pages aren't.           * pages aren't.
5897           */           */
5898          gc_assert(!PAGE_WRITE_PROTECTED(next_page));          gc_assert(!PAGE_WRITE_PROTECTED(next_page));
5899          remaining_bytes -= PAGE_SIZE;          remaining_bytes -= GC_PAGE_SIZE;
5900          next_page++;          next_page++;
5901      }      }
5902    
# Line 5187  maybe_adjust_large_object(lispobj * wher Line 5924  maybe_adjust_large_object(lispobj * wher
5924    
5925      /* Free any remaining pages; needs care. */      /* Free any remaining pages; needs care. */
5926      next_page++;      next_page++;
5927      while (old_bytes_used == PAGE_SIZE &&      while (old_bytes_used == GC_PAGE_SIZE &&
5928             PAGE_FLAGS(next_page, mmask) == mflags &&             PAGE_FLAGS(next_page, mmask) == mflags &&
5929             page_table[next_page].first_object_offset == PAGE_SIZE * (first_page             page_table[next_page].first_object_offset == GC_PAGE_SIZE * (first_page
5930                                                                       -                                                                       -
5931                                                                       next_page))                                                                       next_page))
5932      {      {
# Line 5273  preserve_pointer(void *addr) Line 6010  preserve_pointer(void *addr)
6010      while (page_table[first_page].first_object_offset != 0) {      while (page_table[first_page].first_object_offset != 0) {
6011          first_page--;          first_page--;
6012          /* Do some checks */          /* Do some checks */
6013          gc_assert(page_table[first_page].bytes_used == PAGE_SIZE);          gc_assert(page_table[first_page].bytes_used == GC_PAGE_SIZE);
6014          gc_assert(PAGE_GENERATION(first_page) == from_space);          gc_assert(PAGE_GENERATION(first_page) == from_space);
6015          gc_assert(PAGE_ALLOCATED(first_page));          gc_assert(PAGE_ALLOCATED(first_page));
6016          gc_assert(PAGE_UNBOXED(first_page) == region_unboxed);          gc_assert(PAGE_UNBOXED(first_page) == region_unboxed);
# Line 5335  preserve_pointer(void *addr) Line 6072  preserve_pointer(void *addr)
6072          gc_assert(!PAGE_WRITE_PROTECTED(i));          gc_assert(!PAGE_WRITE_PROTECTED(i));
6073    
6074          /* Check if this is the last page in this contiguous block */          /* Check if this is the last page in this contiguous block */
6075          if (page_table[i].bytes_used < PAGE_SIZE          if (page_table[i].bytes_used < GC_PAGE_SIZE
6076              /* Or it is PAGE_SIZE and is the last in the block */              /* Or it is GC_PAGE_SIZE and is the last in the block */
6077              || !PAGE_ALLOCATED(i + 1)              || !PAGE_ALLOCATED(i + 1)
6078              || page_table[i + 1].bytes_used == 0        /* Next page free */              || page_table[i + 1].bytes_used == 0        /* Next page free */
6079              || PAGE_GENERATION(i + 1) != from_space     /* Diff. gen */              || PAGE_GENERATION(i + 1) != from_space     /* Diff. gen */
# Line 5477  update_page_write_prot(unsigned page) Line 6214  update_page_write_prot(unsigned page)
6214          fprintf(stderr, "* WP page %d of gen %d\n", page, gen);          fprintf(stderr, "* WP page %d of gen %d\n", page, gen);
6215  #endif  #endif
6216    
6217          os_protect((os_vm_address_t) page_addr, PAGE_SIZE,          os_protect((os_vm_address_t) page_addr, GC_PAGE_SIZE,
6218                     OS_VM_PROT_READ | OS_VM_PROT_EXECUTE);                     OS_VM_PROT_READ | OS_VM_PROT_EXECUTE);
6219    
6220          /* Note the page as protected in the page tables */          /* Note the page as protected in the page tables */
# Line 5555  scavenge_generation(int generation) Line 6292  scavenge_generation(int generation)
6292               */               */
6293              for (last_page = i;; last_page++)              for (last_page = i;; last_page++)
6294                  /* Check if this is the last page in this contiguous block */                  /* Check if this is the last page in this contiguous block */
6295                  if (page_table[last_page].bytes_used < PAGE_SIZE                  if (page_table[last_page].bytes_used < GC_PAGE_SIZE
6296                      /* Or it is PAGE_SIZE and is the last in the block */                      /* Or it is GC_PAGE_SIZE and is the last in the block */
6297                      || !PAGE_ALLOCATED(last_page + 1)                      || !PAGE_ALLOCATED(last_page + 1)
6298                      || PAGE_UNBOXED(last_page + 1)                      || PAGE_UNBOXED(last_page + 1)
6299                      || page_table[last_page + 1].bytes_used == 0                      || page_table[last_page + 1].bytes_used == 0
# Line 5581  scavenge_generation(int generation) Line 6318  scavenge_generation(int generation)
6318  #endif  #endif
6319                  {                  {
6320                      scavenge(page_address(i), (page_table[last_page].bytes_used                      scavenge(page_address(i), (page_table[last_page].bytes_used
6321                                                 + PAGE_SIZE * (last_page -                                                 + GC_PAGE_SIZE * (last_page -
6322                                                                i)) /                                                                i)) /
6323                               sizeof(lispobj));                               sizeof(lispobj));
6324    
# Line 5688  scavenge_newspace_generation_one_scan(in Line 6425  scavenge_newspace_generation_one_scan(in
6425               */               */
6426              for (last_page = i;; last_page++)              for (last_page = i;; last_page++)
6427                  /* Check if this is the last page in this contiguous block */                  /* Check if this is the last page in this contiguous block */
6428                  if (page_table[last_page].bytes_used < PAGE_SIZE                  if (page_table[last_page].bytes_used < GC_PAGE_SIZE
6429                      /* Or it is PAGE_SIZE and is the last in the block */                      /* Or it is GC_PAGE_SIZE and is the last in the block */
6430                      || !PAGE_ALLOCATED(last_page + 1)                      || !PAGE_ALLOCATED(last_page + 1)
6431                      || PAGE_UNBOXED(last_page + 1)                      || PAGE_UNBOXED(last_page + 1)
6432                      || page_table[last_page + 1].bytes_used == 0                      || page_table[last_page + 1].bytes_used == 0
# Line 5725  scavenge_newspace_generation_one_scan(in Line 6462  scavenge_newspace_generation_one_scan(in
6462                      else                      else
6463                          size =                          size =
6464                              (page_table[last_page].bytes_used +                              (page_table[last_page].bytes_used +
6465                               PAGE_SIZE * (last_page - i) -                               GC_PAGE_SIZE * (last_page - i) -
6466                               page_table[i].first_object_offset) /                               page_table[i].first_object_offset) /
6467                              sizeof(lispobj);                              sizeof(lispobj);
6468    
# Line 5769  scavenge_newspace_generation_one_scan(in Line 6506  scavenge_newspace_generation_one_scan(in
6506              i = last_page;              i = last_page;
6507          }          }
6508      }      }
6509    #if 0
6510        fprintf(stderr, "Finished one full scan of newspace generation %d\n",
6511                generation);
6512    #endif
6513    }
6514    
6515    /* Scan all weak objects and reset weak object lists */
6516    static void
6517    scan_weak_objects(void)
6518    {
6519        scan_weak_tables();
6520        scan_weak_pointers();
6521    
6522        /* Re-initialise the weak pointer and weak tables lists. */
6523        weak_pointers = NULL;
6524        weak_hash_tables = NIL;
6525  }  }
6526    
6527  /* Do a complete scavenge of the newspace generation */  /* Do a complete scavenge of the newspace generation */
# Line 5785  scavenge_newspace_generation(int generat Line 6538  scavenge_newspace_generation(int generat
6538      struct new_area (*previous_new_areas)[] = NULL;      struct new_area (*previous_new_areas)[] = NULL;
6539      int previous_new_areas_index;      int previous_new_areas_index;
6540    
6541    #if 0
6542        fprintf(stderr, "Start scavenge_newspace_generation %d\n", generation);
6543    #endif
6544    
6545  #define SC_NS_GEN_CK 0  #define SC_NS_GEN_CK 0
6546  #if SC_NS_GEN_CK  #if SC_NS_GEN_CK
6547      /* Clear the write_protected_cleared flags on all pages */      /* Clear the write_protected_cleared flags on all pages */
# Line 5809  scavenge_newspace_generation(int generat Line 6566  scavenge_newspace_generation(int generat
6566      /* Start with a full scavenge */      /* Start with a full scavenge */
6567      scavenge_newspace_generation_one_scan(generation);      scavenge_newspace_generation_one_scan(generation);
6568    
6569        /*
6570         * XXX: Do we need to scan weak tables here, before the region is
6571         * updated?  We do it in the code below for other cases before the
6572         * regions are updated, so it seems to make sense to do it here as
6573         * well.
6574         */
6575        scav_weak_tables();
6576    
6577    
6578      /* Record all new areas now. */      /* Record all new areas now. */
6579      record_new_objects = 2;      record_new_objects = 2;
6580    
# Line 5822  scavenge_newspace_generation(int generat Line 6588  scavenge_newspace_generation(int generat
6588  #if 0  #if 0
6589      fprintf(stderr, "First scan finished; current_new_areas_index=%d\n",      fprintf(stderr, "First scan finished; current_new_areas_index=%d\n",
6590              current_new_areas_index);              current_new_areas_index);
6591        if (current_new_areas_index > 0) {
6592            fprintf(stderr, "Start rescans\n");
6593        }
6594  #endif  #endif
6595    
6596      while (current_new_areas_index > 0) {      while (current_new_areas_index > 0) {
# Line 5863  scavenge_newspace_generation(int generat Line 6632  scavenge_newspace_generation(int generat
6632               */               */
6633              record_new_objects = 1;              record_new_objects = 1;
6634    
6635    #if 0
6636                fprintf(stderr, " Rescan generation %d\n", generation);
6637    #endif
6638              scavenge_newspace_generation_one_scan(generation);              scavenge_newspace_generation_one_scan(generation);
6639    
6640                /*
6641                 * Not sure this call is needed, but I (rtoy) am putting
6642                 * this here anyway on the assumption that since we do it
6643                 * below after scavenging some stuff, we should do it here
6644                 * also because scavenge_newspace_generation_one_scan
6645                 * scavenges stuff too.
6646                 */
6647    
6648                scav_weak_tables();
6649    
6650              /* Record all new areas now. */              /* Record all new areas now. */
6651              record_new_objects = 2;              record_new_objects = 2;
6652    
# Line 5883  scavenge_newspace_generation(int generat Line 6665  scavenge_newspace_generation(int generat
6665  #if 0  #if 0
6666                  fprintf(stderr, "*S page %d offset %d size %d\n", page, offset,                  fprintf(stderr, "*S page %d offset %d size %d\n", page, offset,
6667                          size * sizeof(lispobj));                          size * sizeof(lispobj));
6668                    fprintf(stderr, "  scavenge(%p, %d)\n", page_address(page) + offset, size);
6669  #endif  #endif
6670                  scavenge(page_address(page) + offset, size);                  scavenge(page_address(page) + offset, size);
6671              }              }
6672    
6673                /*
6674                 * I (rtoy) am not sure this is 100% correct.  But if we
6675                 * don't scan the weak tables here (or somewhere near
6676                 * here, perhaps), we get problems like live weak pointers
6677                 * that haven't been transported out of oldspace.  Then
6678                 * anything referring to this pointer causes a crash when
6679                 * GC happens later on.
6680                 *
6681                 * This fixes a bug with weak hash tables, reported by
6682                 * Lynn Quam, cmucl-imp, 2006-07-04.
6683                 */
6684                scav_weak_tables();
6685    
6686              /* Flush the current regions updating the tables. */              /* Flush the current regions updating the tables. */
6687              gc_alloc_update_page_tables(0, &boxed_region);              gc_alloc_update_page_tables(0, &boxed_region);
6688              gc_alloc_update_page_tables(1, &unboxed_region);              gc_alloc_update_page_tables(1, &unboxed_region);
# Line 5901  scavenge_newspace_generation(int generat Line 6697  scavenge_newspace_generation(int generat
6697  #endif  #endif
6698      }      }
6699    
6700    #if 0
6701        fprintf(stderr, "All rescans finished\n");
6702    #endif
6703    
6704      /* Turn off recording of areas allocated by gc_alloc */      /* Turn off recording of areas allocated by gc_alloc */
6705      record_new_objects = 0;      record_new_objects = 0;
6706    
# Line 5918  scavenge_newspace_generation(int generat Line 6718  scavenge_newspace_generation(int generat
6718                      "*** scav.new.gen. %d: write protected page %d written to? dont_move=%d\n",                      "*** scav.new.gen. %d: write protected page %d written to? dont_move=%d\n",
6719                      generation, i, PAGE_DONT_MOVE(i));                      generation, i, PAGE_DONT_MOVE(i));
6720  #endif  #endif
6721    #if 0
6722        fprintf(stderr, "Finished scavenge_newspace_generation %d\n", generation);
6723    #endif
6724  }  }
6725    
6726    
# Line 5947  unprotect_oldspace(void) Line 6750  unprotect_oldspace(void)
6750               * WP flag to avoid redundant calls.               * WP flag to avoid redundant calls.
6751               */               */
6752              if (PAGE_WRITE_PROTECTED(i)) {              if (PAGE_WRITE_PROTECTED(i)) {
6753                  os_protect((os_vm_address_t) page_start, PAGE_SIZE,                  os_protect((os_vm_address_t) page_start, GC_PAGE_SIZE,
6754                             OS_VM_PROT_ALL);                             OS_VM_PROT_ALL);
6755                  page_table[i].flags &= ~PAGE_WRITE_PROTECTED_MASK;                  page_table[i].flags &= ~PAGE_WRITE_PROTECTED_MASK;
6756              }              }
# Line 5970  free_oldspace(void) Line 6773  free_oldspace(void)
6773    
6774      do {      do {
6775          /* Find a first page for the next region of pages. */          /* Find a first page for the next region of pages. */
6776          while (first_page < last_free_page && (!PAGE_ALLOCATED(first_page)          while ((first_page < last_free_page)
6777                                                 || page_table[first_page].                 && (!PAGE_ALLOCATED(first_page)
6778                                                 bytes_used == 0                     || page_table[first_page].bytes_used == 0
6779                                                 || PAGE_GENERATION(first_page) !=                     || PAGE_GENERATION(first_page) != from_space)) {
6780                                                 from_space)) first_page++;              first_page++;
6781            }
6782    
6783          if (first_page >= last_free_page)          if (first_page >= last_free_page)
6784              break;              break;
# Line 5998  free_oldspace(void) Line 6802  free_oldspace(void)
6802                  void *page_start = (void *) page_address(last_page);                  void *page_start = (void *) page_address(last_page);
6803    
6804                  if (PAGE_WRITE_PROTECTED(last_page)) {                  if (PAGE_WRITE_PROTECTED(last_page)) {
6805                      os_protect((os_vm_address_t) page_start, PAGE_SIZE,                      os_protect((os_vm_address_t) page_start, GC_PAGE_SIZE,
6806                                 OS_VM_PROT_ALL);                                 OS_VM_PROT_ALL);
6807                      page_table[last_page].flags &= ~PAGE_WRITE_PROTECTED_MASK;                      page_table[last_page].flags &= ~PAGE_WRITE_PROTECTED_MASK;
6808                  }                  }
# Line 6016  free_oldspace(void) Line 6820  free_oldspace(void)
6820              page_start = page_address(first_page);              page_start = page_address(first_page);
6821    
6822              os_invalidate((os_vm_address_t) page_start,              os_invalidate((os_vm_address_t) page_start,
6823                            PAGE_SIZE * (last_page - first_page));                            GC_PAGE_SIZE * (last_page - first_page));
6824              addr =              addr =
6825                  (char *) os_validate((os_vm_address_t) page_start,                  (char *) os_validate((os_vm_address_t) page_start,
6826                                       PAGE_SIZE * (last_page - first_page));                                       GC_PAGE_SIZE * (last_page - first_page));
6827              if (addr == NULL || addr != page_start)              if (addr == NULL || addr != page_start)
6828                  fprintf(stderr, "gc_zero: page moved, 0x%08lx ==> 0x%08lx!\n",                  fprintf(stderr, "gc_zero: page moved, 0x%08lx ==> 0x%08lx!\n",
6829                          (unsigned long) page_start, (unsigned long) addr);                          (unsigned long) page_start, (unsigned long) addr);
# Line 6027  free_oldspace(void) Line 6831  free_oldspace(void)
6831              int *page_start;              int *page_start;
6832    
6833              page_start = (int *) page_address(first_page);              page_start = (int *) page_address(first_page);
6834              memset(page_start, 0, PAGE_SIZE * (last_page - first_page));              memset(page_start, 0, GC_PAGE_SIZE * (last_page - first_page));
6835          }          }
6836    
6837          first_page = last_page;          first_page = last_page;
# Line 6041  free_oldspace(void) Line 6845  free_oldspace(void)
6845    
6846    
6847  /* Print out some information about a pointer at the given address. */  /* Print out some information about a pointer at the given address. */
6848  static void  void
6849  print_ptr(lispobj * addr)  print_ptr(lispobj * addr)
6850  {  {
6851      /* If addr is in the dynamic space then print out the page information. */      /* If addr is in the dynamic space then print out the page information. */
# Line 6059  print_ptr(lispobj * addr) Line 6863  print_ptr(lispobj * addr)
6863              *(addr + 2), *(addr + 3), *(addr + 4));              *(addr + 2), *(addr + 3), *(addr + 4));
6864  }  }
6865    
6866  #if defined(sparc)  void
 extern char closure_tramp;  
 #elif defined(DARWIN)  
 extern char closure_tramp;  
 extern char undefined_tramp;  
 #else  
 extern int undefined_tramp;  
 #endif  
   
 static void  
6867  verify_space(lispobj * start, size_t words)  verify_space(lispobj * start, size_t words)
6868  {  {
6869      int dynamic_space = (find_page_index((void *) start) != -1);      int dynamic_space = (find_page_index((void *) start) != -1);
# Line 6135  verify_space(lispobj * start, size_t wor Line 6930  verify_space(lispobj * start, size_t wor
6930  #endif  #endif
6931              } else {              } else {
6932                  /* Verify that it points to another valid space */                  /* Verify that it points to another valid space */
6933                  if (!to_readonly_space && !to_static_space &&                  if (!to_readonly_space && !to_static_space
6934  #if defined(sparc)  #if (defined(DARWIN) && defined(__ppc__))
6935                      thing != (int) &closure_tramp  
6936  #elif defined(DARWIN)                      && !((thing == (int) &closure_tramp) ||
6937                      !((thing == (int) &closure_tramp) ||                           (thing == (int) &undefined_tramp))
6938                        (thing == (int) &undefined_tramp))  #elif defined(sparc) || defined(i386) || defined(__x86_64)
6939                        /* Nothing for since these are Lisp assembly routines */
6940  #else  #else
6941                      thing != (int) &undefined_tramp                      && thing != (int) &undefined_tramp
6942  #endif  #endif
6943                      ) {                      ) {
6944    #if !(defined(sparc) || defined(i386) || defined(__x86_64))
6945                      fprintf(stderr,                      fprintf(stderr,
6946                              "*** Ptr %lx @ %lx sees Junk (%s = %lx)\n",                              "*** Ptr %lx @ %lx sees Junk (undefined_tramp = %lx)",
6947                              (unsigned long) thing, (unsigned long) start,                              (unsigned long) thing, (unsigned long) start,
6948  #if defined(sparc)                              (unsigned long) &undefined_tramp);
6949                              "closure_tramp",  #endif
6950                              (unsigned long) &closure_tramp  #if (defined(DARWIN) && defined(__ppc__))
6951  #else                      fprintf(stderr, " (closure_tramp = %lx)",
6952                              "undefined_tramp",                              (unsigned long) &closure_tramp);
                             (unsigned long) &undefined_tramp  
6953  #endif  #endif
6954                          );                      fprintf(stderr, "\n");
6955                      print_ptr(start);                      print_ptr(start);
6956                  }                  }
6957              }              }
# Line 6175  verify_space(lispobj * start, size_t wor Line 6971  verify_space(lispobj * start, size_t wor
6971                case type_FuncallableInstanceHeader:                case type_FuncallableInstanceHeader:
6972                case type_ByteCodeFunction:                case type_ByteCodeFunction:
6973                case type_ByteCodeClosure:                case type_ByteCodeClosure:
6974    #ifdef type_DylanFunctionHeader
6975                case type_DylanFunctionHeader:                case type_DylanFunctionHeader:
6976    #endif
6977                case type_ValueCellHeader:                case type_ValueCellHeader:
6978                case type_SymbolHeader:                case type_SymbolHeader:
6979                case type_BaseChar:                case type_BaseChar:
# Line 6241  verify_space(lispobj * start, size_t wor Line 7039  verify_space(lispobj * start, size_t wor
7039  #ifdef type_ComplexLongFloat  #ifdef type_ComplexLongFloat
7040                case type_LongFloat:                case type_LongFloat:
7041  #endif  #endif
7042    #ifdef type_DoubleDoubleFloat
7043                  case type_DoubleDoubleFloat:
7044    #endif
7045  #ifdef type_ComplexSingleFloat  #ifdef type_ComplexSingleFloat
7046                case type_ComplexSingleFloat:                case type_ComplexSingleFloat:
7047  #endif  #endif
# Line 6250  verify_space(lispobj * start, size_t wor Line 7051  verify_space(lispobj * start, size_t wor
7051  #ifdef type_ComplexLongFloat  #ifdef type_ComplexLongFloat
7052                case type_ComplexLongFloat:                case type_ComplexLongFloat:
7053  #endif  #endif
7054    #ifdef type_ComplexDoubleDoubleFloat
7055                  case type_ComplexDoubleDoubleFloat:
7056    #endif
7057                case type_SimpleString:                case type_SimpleString:
7058                case type_SimpleBitVector:                case type_SimpleBitVector:
7059                case type_SimpleArrayUnsignedByte2:                case type_SimpleArrayUnsignedByte2:
# Line 6271  verify_space(lispobj * start, size_t wor Line 7075  verify_space(lispobj * start, size_t wor
7075  #endif  #endif
7076                case type_SimpleArraySingleFloat:                case type_SimpleArraySingleFloat:
7077                case type_SimpleArrayDoubleFloat:                case type_SimpleArrayDoubleFloat:
7078    #ifdef type_SimpleArrayDoubleDoubleFloat
7079                  case type_SimpleArrayDoubleDoubleFloat:
7080    #endif
7081  #ifdef type_SimpleArrayComplexLongFloat  #ifdef type_SimpleArrayComplexLongFloat
7082                case type_SimpleArrayLongFloat:                case type_SimpleArrayLongFloat:
7083  #endif  #endif
# Line 6283  verify_space(lispobj * start, size_t wor Line 7090  verify_space(lispobj * start, size_t wor
7090  #ifdef type_SimpleArrayComplexLongFloat  #ifdef type_SimpleArrayComplexLongFloat
7091                case type_SimpleArrayComplexLongFloat:                case type_SimpleArrayComplexLongFloat:
7092  #endif  #endif
7093    #ifdef type_SimpleArrayComplexDoubleDoubleFloat
7094                  case type_SimpleArrayComplexDoubleDoubleFloat:
7095    #endif
7096                case type_Sap:                case type_Sap:
7097                case type_WeakPointer:                case type_WeakPointer:
7098                    count = (sizetab[TypeOf(*start)]) (start);                    count = (sizetab[TypeOf(*start)]) (start);
# Line 6296  verify_space(lispobj * start, size_t wor Line 7106  verify_space(lispobj * start, size_t wor
7106      }      }
7107  }  }
7108    
7109  static void  void
7110  verify_gc(void)  verify_gc(void)
7111  {  {
7112      int read_only_space_size =      int read_only_space_size =
# Line 6311  verify_gc(void) Line 7121  verify_gc(void)
7121      verify_space((lispobj *) READ_ONLY_SPACE_START, read_only_space_size);      verify_space((lispobj *) READ_ONLY_SPACE_START, read_only_space_size);
7122      verify_space((lispobj *) static_space, static_space_size);      verify_space((lispobj *) static_space, static_space_size);
7123      verify_space((lispobj *) BINDING_STACK_START, binding_stack_size);      verify_space((lispobj *) BINDING_STACK_START, binding_stack_size);
7124      verify_space((lispobj *) & scavenger_hooks, 1);      verify_space((lispobj *) (void *) &scavenger_hooks, 1);
7125  }  }
7126    
7127  static void  static void
# Line 6340  verify_generation(int generation) Line 7150  verify_generation(int generation)
7150               */               */
7151              for (last_page = i;; last_page++)              for (last_page = i;; last_page++)
7152                  /* Check if this is the last page in this contiguous block */                  /* Check if this is the last page in this contiguous block */
7153                  if (page_table[last_page].bytes_used < PAGE_SIZE                  if (page_table[last_page].bytes_used < GC_PAGE_SIZE
7154                      /* Or it is PAGE_SIZE and is the last in the block */                      /* Or it is GC_PAGE_SIZE and is the last in the block */
7155                      || !PAGE_ALLOCATED(last_page + 1)                      || !PAGE_ALLOCATED(last_page + 1)
7156                      || PAGE_UNBOXED(last_page + 1) != region_unboxed                      || PAGE_UNBOXED(last_page + 1) != region_unboxed
7157                      || page_table[last_page + 1].bytes_used == 0                      || page_table[last_page + 1].bytes_used == 0
# Line 6351  verify_generation(int generation) Line 7161  verify_generation(int generation)
7161    
7162              verify_space((lispobj *) page_address(i),              verify_space((lispobj *) page_address(i),
7163                           (page_table[last_page].bytes_used +                           (page_table[last_page].bytes_used +
7164                            PAGE_SIZE * (last_page - i)) / sizeof(lispobj));                            GC_PAGE_SIZE * (last_page - i)) / sizeof(lispobj));
7165              i = last_page;              i = last_page;
7166          }          }
7167      }      }
# Line 6375  verify_zero_fill(void) Line 7185  verify_zero_fill(void)
7185                      fprintf(stderr, "** free page not zero @ %lx\n",                      fprintf(stderr, "** free page not zero @ %lx\n",
7186                              (unsigned long) (start_addr + i));                              (unsigned long) (start_addr + i));
7187          } else {          } else {
7188              int free_bytes = PAGE_SIZE - page_table[page].bytes_used;              int free_bytes = GC_PAGE_SIZE - page_table[page].bytes_used;
7189    
7190              if (free_bytes > 0) {              if (free_bytes > 0) {
7191                  unsigned long *start_addr =                  unsigned long *start_addr =
# Line 6441  write_protect_generation_pages(int gener Line 7251  write_protect_generation_pages(int gener
7251    
7252              page_start = (void *) page_address(i);              page_start = (void *) page_address(i);
7253    
7254              os_protect((os_vm_address_t) page_start, PAGE_SIZE,              os_protect((os_vm_address_t) page_start, GC_PAGE_SIZE,
7255                         OS_VM_PROT_READ | OS_VM_PROT_EXECUTE);                         OS_VM_PROT_READ | OS_VM_PROT_EXECUTE);
7256    
7257              /* Note the page as protected in the page tables */              /* Note the page as protected in the page tables */
# Line 6476  scavenge_interrupt_handlers(void) Line 7286  scavenge_interrupt_handlers(void)
7286    
7287  #if !(defined(i386) || defined(__x86_64))  #if !(defined(i386) || defined(__x86_64))
7288  static void  static void
7289  scavenge_control_stack()  scavenge_control_stack(void)
7290  {  {
7291      unsigned long control_stack_size;      unsigned long control_stack_size;
7292    
# Line 6572  garbage_collect_generation(int generatio Line 7382  garbage_collect_generation(int generatio
7382          lispobj **ptr;          lispobj **ptr;
7383    
7384          for (ptr = (lispobj **) CONTROL_STACK_END - 1;          for (ptr = (lispobj **) CONTROL_STACK_END - 1;
7385               ptr > (lispobj **) & raise; ptr--)               ptr > (lispobj **) (void *) &raise; ptr--)
7386              preserve_pointer(*ptr);              preserve_pointer(*ptr);
7387      }      }
7388  #endif  #endif
# Line 6586  garbage_collect_generation(int generatio Line 7396  garbage_collect_generation(int generatio
7396    
7397          fprintf(stderr,          fprintf(stderr,
7398                  "Non-movable pages due to conservative pointers = %d, %d bytes\n",                  "Non-movable pages due to conservative pointers = %d, %d bytes\n",
7399                  num_dont_move_pages, PAGE_SIZE * num_dont_move_pages);                  num_dont_move_pages, GC_PAGE_SIZE * num_dont_move_pages);
7400  #if !(defined(i386) || defined(__x86_64))  #if !(defined(i386) || defined(__x86_64))
7401          /*          /*
7402           * There shouldn't be any non-movable pages because we don't have           * There shouldn't be any non-movable pages because we don't have
# Line 6672  garbage_collect_generation(int generatio Line 7482  garbage_collect_generation(int generatio
7482       */       */
7483      scavenge_newspace_generation(new_space);      scavenge_newspace_generation(new_space);
7484    
7485        /* I think we should do this *before* the rescan check */
7486        scan_weak_objects();
7487    
7488  #define RESCAN_CHECK 0  #define RESCAN_CHECK 0
7489  #if RESCAN_CHECK  #if RESCAN_CHECK
7490      /*      /*
# Line 6700  garbage_collect_generation(int generatio Line 7513  garbage_collect_generation(int generatio
7513      }      }
7514  #endif  #endif
7515    
     scan_weak_pointers();  
     scan_weak_tables();  
   
7516      /* Flush the current regions, updating the tables. */      /* Flush the current regions, updating the tables. */
7517      gc_alloc_update_page_tables(0, &boxed_region);      gc_alloc_update_page_tables(0, &boxed_region);
7518      gc_alloc_update_page_tables(1, &unboxed_region);      gc_alloc_update_page_tables(1, &unboxed_region);
# Line 6766  update_dynamic_space_free_pointer(void) Line 7576  update_dynamic_space_free_pointer(void)
7576      last_free_page = last_page + 1;      last_free_page = last_page + 1;
7577    
7578      set_alloc_pointer((lispobj)      set_alloc_pointer((lispobj)
7579                        ((char *) heap_base + PAGE_SIZE * last_free_page));                        ((char *) heap_base + GC_PAGE_SIZE * last_free_page));
7580  }  }
7581    
7582    
# Line 6960  gc_free_heap(void) Line 7770  gc_free_heap(void)
7770              page_start = (void *) page_address(page);              page_start = (void *) page_address(page);
7771    
7772              /* First remove any write protection */              /* First remove any write protection */
7773              os_protect((os_vm_address_t) page_start, PAGE_SIZE, OS_VM_PROT_ALL);              os_protect((os_vm_address_t) page_start, GC_PAGE_SIZE, OS_VM_PROT_ALL);
7774              page_table[page].flags &= ~PAGE_WRITE_PROTECTED_MASK;              page_table[page].flags &= ~PAGE_WRITE_PROTECTED_MASK;
7775    
7776              os_invalidate((os_vm_address_t) page_start, PAGE_SIZE);              os_invalidate((os_vm_address_t) page_start, GC_PAGE_SIZE);
7777              addr =              addr =
7778                  (char *) os_validate((os_vm_address_t) page_start, PAGE_SIZE);                  (char *) os_validate((os_vm_address_t) page_start, GC_PAGE_SIZE);
7779              if (addr == NULL || addr != page_start)              if (addr == NULL || addr != page_start)
7780                  fprintf(stderr, "gc_zero: page moved, 0x%08lx ==> 0x%08lx!\n",                  fprintf(stderr, "gc_zero: page moved, 0x%08lx ==> 0x%08lx!\n",
7781                          (unsigned long) page_start, (unsigned long) addr);                          (unsigned long) page_start, (unsigned long) addr);
# Line 7043  gc_init(void) Line 7853  gc_init(void)
7853      heap_base = (void *) DYNAMIC_0_SPACE_START;      heap_base = (void *) DYNAMIC_0_SPACE_START;
7854    
7855      /* The number of pages needed for the dynamic space - rounding up. */      /* The number of pages needed for the dynamic space - rounding up. */
7856      dynamic_space_pages = (dynamic_space_size + (PAGE_SIZE - 1)) / PAGE_SIZE;      dynamic_space_pages = (dynamic_space_size + (GC_PAGE_SIZE - 1)) / GC_PAGE_SIZE;
7857    
7858      page_table =      page_table =
7859            (struct page *) malloc(dynamic_space_pages * sizeof(struct page));
         (struct page *) malloc(dynamic_space_pages * sizeof(struct page));  
7860      if (page_table == NULL) {      if (page_table == NULL) {
7861          fprintf(stderr, "Unable to allocate page table.\n");          fprintf(stderr, "Unable to allocate page table.\n");
7862          exit(1);          exit(1);
# Line 7057  gc_init(void) Line 7866  gc_init(void)
7866    
7867      for (i = 0; i < dynamic_space_pages; i++) {      for (i = 0; i < dynamic_space_pages; i++) {
7868          /* Initial all pages as free. */          /* Initial all pages as free. */
7869            page_table[i].flags = 0;
7870          page_table[i].flags &= ~PAGE_ALLOCATED_MASK;          page_table[i].flags &= ~PAGE_ALLOCATED_MASK;
7871          page_table[i].bytes_used = 0;          page_table[i].bytes_used = 0;
7872    
# Line 7122  gencgc_pickup_dynamic(void) Line 7932  gencgc_pickup_dynamic(void)
7932          page_table[page].flags |= PAGE_ALLOCATED_MASK;          page_table[page].flags |= PAGE_ALLOCATED_MASK;
7933          page_table[page].flags &= ~(PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK          page_table[page].flags &= ~(PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK
7934                                      | PAGE_LARGE_OBJECT_MASK);                                      | PAGE_LARGE_OBJECT_MASK);
7935          page_table[page].bytes_used = PAGE_SIZE;          page_table[page].bytes_used = GC_PAGE_SIZE;
7936          page_table[page].first_object_offset =          page_table[page].first_object_offset =
7937              (char *) DYNAMIC_0_SPACE_START - page_address(page);              (char *) DYNAMIC_0_SPACE_START - page_address(page);
7938          addr += PAGE_SIZE;          addr += GC_PAGE_SIZE;
7939          page++;          page++;
7940      }      }
7941      while (addr < alloc_ptr);      while (addr < alloc_ptr);
7942    
7943      generations[0].bytes_allocated = PAGE_SIZE * page;      generations[0].bytes_allocated = GC_PAGE_SIZE * page;
7944      bytes_allocated = PAGE_SIZE * page;      bytes_allocated = GC_PAGE_SIZE * page;
7945    
7946      set_current_region_free((lispobj) boxed_region.free_pointer);      set_current_region_free((lispobj) boxed_region.free_pointer);
7947      set_current_region_end((lispobj) boxed_region.end_addr);      set_current_region_end((lispobj) boxed_region.end_addr);
# Line 7163  void do_pending_interrupt(void); Line 7973  void do_pending_interrupt(void);
7973  char *  char *
7974  alloc(int nbytes)  alloc(int nbytes)
7975  {  {
7976  #if !(defined(sparc) || defined(DARWIN))  #if !(defined(sparc) || (defined(DARWIN) && defined(__ppc__)))
7977      /*      /*
7978       * *current-region-free-pointer* is the same as alloc-tn (=       * *current-region-free-pointer* is the same as alloc-tn (=
7979       * current_dynamic_space_free_pointer) and therefore contains the       * current_dynamic_space_free_pointer) and therefore contains the
# Line 7305  get_bytes_allocated_lower(void) Line 8115  get_bytes_allocated_lower(void)
8115      }      }
8116    
8117      if (counters_verbose)      if (counters_verbose)
8118          fprintf(stderr, ">%10d%10d%10d%10d%10d (max%d @0x%lX)\n", size,          fprintf(stderr, ">%10d%10d%10lu%10lu%10lu (max%lu @0x%lX)\n", size,
8119                  previous != -1 ? size - previous : -1,                  previous != -1 ? size - previous : -1,
8120                  (size_t) current_region_free_pointer -                  (unsigned long) ((size_t) current_region_free_pointer -
8121                  (size_t) boxed_region.start_addr,                                   (size_t) boxed_region.start_addr),
8122                  (size_t) boxed_region.free_pointer -                  (unsigned long) ((size_t) boxed_region.free_pointer -
8123                  (size_t) boxed_region.start_addr,                                   (size_t) boxed_region.start_addr),
8124                  (size_t) unboxed_region.free_pointer -                  (unsigned long) ((size_t) unboxed_region.free_pointer -
8125                  (size_t) unboxed_region.start_addr,                                   (size_t) unboxed_region.start_addr),
8126                  (size_t) boxed_region.end_addr -                  (unsigned long) ((size_t) boxed_region.end_addr -
8127                  (size_t) boxed_region.start_addr,                                   (size_t) boxed_region.start_addr),
8128                  (unsigned long) boxed_region.start_addr);                  (unsigned long) boxed_region.start_addr);
8129    
8130      previous = size;      previous = size;
# Line 7367  print_bytes_allocated_sum(void) Line 8177  print_bytes_allocated_sum(void)
8177       */       */
8178  #endif  #endif
8179  }  }
8180    
8181    /*
8182     * Let Lisp get at the page table entry and return the flags and the
8183     * bytes used
8184     */
8185    void
8186    get_page_table_info(int page, int* flags, int* bytes)
8187    {
8188        *flags = page_table[page].flags;
8189        *bytes = page_table[page].bytes_used;
8190    }

Legend:
Removed from v.1.70.2.1  
changed lines
  Added in v.1.112

  ViewVC Help
Powered by ViewVC 1.1.5