/[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.32 by gerd, Thu Mar 27 12:42:10 2003 UTC revision 1.32.4.1 by toy, Fri Aug 15 20:45:40 2003 UTC
# Line 28  Line 28 
28  #define gc_abort() lose("GC invariant lost!  File \"%s\", line %d\n", \  #define gc_abort() lose("GC invariant lost!  File \"%s\", line %d\n", \
29                          __FILE__, __LINE__)                          __FILE__, __LINE__)
30    
31  #if 0  #undef GC_DEBUG
32    
33    #if defined(i386)
34    #define set_alloc_pointer(value)  SetSymbolValue(ALLOCATION_POINTER, value)
35    #define get_alloc_pointer()       SymbolValue(ALLOCATION_POINTER)
36    #define get_binding_stack_pointer()     SymbolValue(BINDING_STACK_POINTER)
37    #define get_pseudo_atomic_atomic()      SymbolValue(PSEUDO_ATOMIC_ATOMIC)
38    #define set_pseudo_atomic_atomic()      SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0));
39    #define clr_pseudo_atomic_atomic()      SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1));
40    #define get_pseudo_atomic_interrupted() SymbolValue(PSEUDO_ATOMIC_INTERRUPTED)
41    #define clr_pseudo_atomic_interrupted() SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0))
42    #elif defined(sparc)
43    #define set_alloc_pointer(value)  (current_dynamic_space_free_pointer = (value))
44    #define get_alloc_pointer()       (current_dynamic_space_free_pointer)
45    #define get_binding_stack_pointer()     (current_binding_stack_pointer)
46    #define get_pseudo_atomic_atomic() \
47         ((unsigned long)current_dynamic_space_free_pointer & 4)
48    #define set_pseudo_atomic_atomic() \
49         (current_dynamic_space_free_pointer \
50           = (lispobj*) ((unsigned long)current_dynamic_space_free_pointer | 4))
51    #define clr_pseudo_atomic_atomic() \
52         (current_dynamic_space_free_pointer \
53           = (lispobj*) ((unsigned long) current_dynamic_space_free_pointer & ~4))
54    #define get_pseudo_atomic_interrupted() ((unsigned long) current_dynamic_space_free_pointer & 1)
55    #define clr_pseudo_atomic_interrupted() \
56         (current_dynamic_space_free_pointer \
57           = (lispobj*) ((unsigned long) current_dynamic_space_free_pointer & ~1))
58    #else
59    #endif
60    
61    #if 1
62  #define gc_assert(ex) do { \  #define gc_assert(ex) do { \
63          if (!(ex)) gc_abort(); \          if (!(ex)) gc_abort(); \
64  } while (0)  } while (0)
# Line 48  Line 78 
78   * The verbose level. All non-error messages are disabled at level 0;   * The verbose level. All non-error messages are disabled at level 0;
79   * and only a few rare messages are printed at level 1.   * and only a few rare messages are printed at level 1.
80   */   */
81  unsigned gencgc_verbose = 0;  unsigned gencgc_verbose = 2;
82  unsigned counters_verbose = 0;  unsigned counters_verbose = 0;
83    
84  /*  /*
# Line 78  boolean pre_verify_gen_0 = FALSE; Line 108  boolean pre_verify_gen_0 = FALSE;
108  /*  /*
109   * Enable checking for bad pointers after gc_free_heap called from purify.   * Enable checking for bad pointers after gc_free_heap called from purify.
110   */   */
111  boolean verify_after_free_heap = FALSE;  boolean verify_after_free_heap = TRUE;
112    
113  /*  /*
114   * Enable the printing of a note when code objects are found in the   * Enable the printing of a note when code objects are found in the
115   * dynamic space during a heap verify.   * dynamic space during a heap verify.
116   */   */
117  boolean verify_dynamic_code_check = FALSE;  boolean verify_dynamic_code_check = TRUE;
118    
119  /*  /*
120   * Enable the checking of code objects for fixup errors after they are   * Enable the checking of code objects for fixup errors after they are
121   * transported.   * transported.
122   */   */
123  boolean check_code_fixups = FALSE;  boolean check_code_fixups = TRUE;
124    
125  /*  /*
126   * To enable unmapping of a page and re-mmaping it to have it zero filled.   * To enable unmapping of a page and re-mmaping it to have it zero filled.
# Line 106  boolean gencgc_unmap_zero = TRUE; Line 136  boolean gencgc_unmap_zero = TRUE;
136  /*  /*
137   * Enable checking that newly allocated regions are zero filled.   * Enable checking that newly allocated regions are zero filled.
138   */   */
139  boolean gencgc_zero_check = FALSE;  boolean gencgc_zero_check = TRUE;
140    
141  boolean gencgc_enable_verify_zero_fill = FALSE;  boolean gencgc_enable_verify_zero_fill = TRUE;
142    
143  /*  /*
144   * Enable checking that free pages are zero filled during gc_free_heap   * Enable checking that free pages are zero filled during gc_free_heap
145   * called after purify.   * called after purify.
146   */   */
147  boolean gencgc_zero_check_during_free_heap = FALSE;  boolean gencgc_zero_check_during_free_heap = TRUE;
148    
149  /*  /*
150   * The minimum size for a large object.   * The minimum size for a large object.
# Line 409  void print_generation_stats(int  verbose Line 439  void print_generation_stats(int  verbose
439     * This code uses the FP instructions which may be setup for Lisp so     * This code uses the FP instructions which may be setup for Lisp so
440     * they need to the saved and reset for C.     * they need to the saved and reset for C.
441     */     */
442    #ifdef i386
443    fpu_save(fpu_state);    fpu_save(fpu_state);
444    #endif
445    
446    /* Number of generations to print out. */    /* Number of generations to print out. */
447    if (verbose)    if (verbose)
448      gens = NUM_GENERATIONS + 1;      gens = NUM_GENERATIONS + 1;
# Line 462  void print_generation_stats(int  verbose Line 494  void print_generation_stats(int  verbose
494    }    }
495    fprintf(stderr, "   Total bytes alloc=%ld\n", bytes_allocated);    fprintf(stderr, "   Total bytes alloc=%ld\n", bytes_allocated);
496    
497    #ifdef i386
498    fpu_restore(fpu_state);    fpu_restore(fpu_state);
499    #endif
500  }  }
501    
502  /* 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 605  static void gc_alloc_new_region(int nbyt Line 639  static void gc_alloc_new_region(int nbyt
639    int i;    int i;
640    int mmask, mflags;    int mmask, mflags;
641    
642  #if 0  #if defined(GC_DEBUG)
643    fprintf(stderr, "alloc_new_region for %d bytes from gen %d\n",    fprintf(stderr, "alloc_new_region for %d bytes from gen %d\n",
644            nbytes, gc_alloc_generation);            nbytes, gc_alloc_generation);
645  #endif  #endif
# Line 660  static void gc_alloc_new_region(int nbyt Line 694  static void gc_alloc_new_region(int nbyt
694    
695      gc_assert(!PAGE_WRITE_PROTECTED(first_page));      gc_assert(!PAGE_WRITE_PROTECTED(first_page));
696    
697  #if 0  #if defined(GC_DEBUG)
698      fprintf(stderr, "  first_page=%d bytes_used=%d\n",      fprintf(stderr, "  first_page=%d bytes_used=%d\n",
699              first_page, page_table[first_page].bytes_used);              first_page, page_table[first_page].bytes_used);
700  #endif  #endif
# Line 688  static void gc_alloc_new_region(int nbyt Line 722  static void gc_alloc_new_region(int nbyt
722    
723      gc_assert(bytes_found == region_size);      gc_assert(bytes_found == region_size);
724    
725  #if 0  #if defined(GC_DEBUG)
726      fprintf(stderr, "  last_page=%d bytes_found=%d num_pages=%d\n",      fprintf(stderr, "  last_page=%d bytes_found=%d num_pages=%d\n",
727              last_page, bytes_found, num_pages);              last_page, bytes_found, num_pages);
728  #endif  #endif
# Line 706  static void gc_alloc_new_region(int nbyt Line 740  static void gc_alloc_new_region(int nbyt
740      exit(1);      exit(1);
741    }    }
742    
743  #if 0  #if defined(GC_DEBUG)
744    fprintf(stderr, "gc_alloc_new_region gen %d: %d bytes: from pages %d to %d: addr=%x\n",    fprintf(stderr, "gc_alloc_new_region gen %d: %d bytes: from pages %d to %d: addr=%x\n",
745            gc_alloc_generation, bytes_found, first_page, last_page,            gc_alloc_generation, bytes_found, first_page, last_page,
746            page_address(first_page));            page_address(first_page));
# Line 757  static void gc_alloc_new_region(int nbyt Line 791  static void gc_alloc_new_region(int nbyt
791    /* Bump up the last_free_page */    /* Bump up the last_free_page */
792    if (last_page + 1 > last_free_page) {    if (last_page + 1 > last_free_page) {
793      last_free_page = last_page + 1;      last_free_page = last_page + 1;
794      SetSymbolValue(ALLOCATION_POINTER,      set_alloc_pointer((lispobj) ((char *) heap_base +
795                     (lispobj) ((char *) heap_base +                                 PAGE_SIZE * last_free_page));
796                                PAGE_SIZE * last_free_page));  
797    }    }
798  }  }
799    
# Line 827  static void add_new_area(int first_page, Line 861  static void add_new_area(int first_page,
861    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++) {
862      unsigned area_end = PAGE_SIZE * (*new_areas)[i].page      unsigned area_end = PAGE_SIZE * (*new_areas)[i].page
863        + (*new_areas)[i].offset + (*new_areas)[i].size;        + (*new_areas)[i].offset + (*new_areas)[i].size;
864  #if 0  #if defined(GC_DEBUG)
865      fprintf(stderr, "*S1 %d %d %d %d\n", i, c, new_area_start, area_end);      fprintf(stderr, "*S1 %d %d %d %d\n", i, c, new_area_start, area_end);
866  #endif  #endif
867      if (new_area_start == area_end) {      if (new_area_start == area_end) {
868  #if 0  #if defined(GC_DEBUG)
869        fprintf(stderr, "-> Adding to [%d] %d %d %d with %d %d %d:\n",        fprintf(stderr, "-> Adding to [%d] %d %d %d with %d %d %d:\n",
870                i, (*new_areas)[i].page, (*new_areas)[i].offset ,                i, (*new_areas)[i].page, (*new_areas)[i].offset ,
871                (*new_areas)[i].size, first_page, offset, size);                (*new_areas)[i].size, first_page, offset, size);
# Line 840  static void add_new_area(int first_page, Line 874  static void add_new_area(int first_page,
874        return;        return;
875      }      }
876    }    }
877  #if 0  #if defined(GC_DEBUG)
878    fprintf(stderr, "*S1 %d %d %d\n",i,c,new_area_start);    fprintf(stderr, "*S1 %d %d %d\n",i,c,new_area_start);
879  #endif  #endif
880    
881    (*new_areas)[new_areas_index].page = first_page;    (*new_areas)[new_areas_index].page = first_page;
882    (*new_areas)[new_areas_index].offset = offset;    (*new_areas)[new_areas_index].offset = offset;
883    (*new_areas)[new_areas_index].size = size;    (*new_areas)[new_areas_index].size = size;
884  #if 0  #if defined(GC_DEBUG)
885    fprintf(stderr, "  new_area %d page %d offset %d size %d\n",    fprintf(stderr, "  new_area %d page %d offset %d size %d\n",
886            new_areas_index, first_page, offset, size);            new_areas_index, first_page, offset, size);
887  #endif  #endif
# Line 879  void gc_alloc_update_page_tables(int unb Line 913  void gc_alloc_update_page_tables(int unb
913    int region_size;    int region_size;
914    int byte_cnt;    int byte_cnt;
915    
916  #if 0  #if defined(GC_DEBUG)
917    fprintf(stderr, "gc_alloc_update_page_tables to gen %d: ",    fprintf(stderr, "gc_alloc_update_page_tables to gen %d: ",
918            gc_alloc_generation);            gc_alloc_generation);
919  #endif  #endif
# Line 903  void gc_alloc_update_page_tables(int unb Line 937  void gc_alloc_update_page_tables(int unb
937    
938      /* Update the first page. */      /* Update the first page. */
939    
940  #if 0  #if defined(GC_DEBUG)
941      fprintf(stderr, "0");      fprintf(stderr, "0");
942  #endif  #endif
943    
# Line 937  void gc_alloc_update_page_tables(int unb Line 971  void gc_alloc_update_page_tables(int unb
971       * the bytes_used.       * the bytes_used.
972       */       */
973      while (more) {      while (more) {
974  #if 0  #if defined(GC_DEBUG)
975        fprintf(stderr, "+")        fprintf(stderr, "+");
976  #endif  #endif
977        gc_assert(PAGE_ALLOCATED(next_page));        gc_assert(PAGE_ALLOCATED(next_page));
978        gc_assert(PAGE_UNBOXED_VAL(next_page) == unboxed);        gc_assert(PAGE_UNBOXED_VAL(next_page) == unboxed);
# Line 981  void gc_alloc_update_page_tables(int unb Line 1015  void gc_alloc_update_page_tables(int unb
1015      if (!unboxed)      if (!unboxed)
1016        add_new_area(first_page, orig_first_page_bytes_used, region_size);        add_new_area(first_page, orig_first_page_bytes_used, region_size);
1017    
1018  #if 0  #if defined(GC_DEBUG)
1019      fprintf(stderr, "  gc_alloc_update_page_tables update %d bytes to gen %d\n",      fprintf(stderr, "  gc_alloc_update_page_tables update %d bytes to gen %d\n",
1020              region_size, gc_alloc_generation);              region_size, gc_alloc_generation);
1021  #endif  #endif
# Line 1007  void gc_alloc_update_page_tables(int unb Line 1041  void gc_alloc_update_page_tables(int unb
1041    alloc_region->free_pointer = page_address(0);    alloc_region->free_pointer = page_address(0);
1042    alloc_region->end_addr = page_address(0);    alloc_region->end_addr = page_address(0);
1043    
1044  #if 0  #if defined(GC_DEBUG)
1045    fprintf(stderr, "\n");    fprintf(stderr, "\n");
1046  #endif  #endif
1047  }  }
# Line 1036  static void *gc_alloc_large(int  nbytes, Line 1070  static void *gc_alloc_large(int  nbytes,
1070    int large = (nbytes >= large_object_size);    int large = (nbytes >= large_object_size);
1071    int mmask, mflags;    int mmask, mflags;
1072    
1073  #if 0  #if defined(GC_DEBUG)
1074    if (nbytes > 200000)    if (nbytes > 200000)
1075      fprintf(stderr, "*** alloc_large %d\n", nbytes);      fprintf(stderr, "*** alloc_large %d\n", nbytes);
1076  #endif  #endif
1077    
1078  #if 0  #if defined(GC_DEBUG)
1079    fprintf(stderr, "gc_alloc_large for %d bytes from gen %d\n",    fprintf(stderr, "gc_alloc_large for %d bytes from gen %d\n",
1080            nbytes, gc_alloc_generation);            nbytes, gc_alloc_generation);
1081  #endif  #endif
# Line 1108  static void *gc_alloc_large(int  nbytes, Line 1142  static void *gc_alloc_large(int  nbytes,
1142    
1143      gc_assert(!PAGE_WRITE_PROTECTED(first_page));      gc_assert(!PAGE_WRITE_PROTECTED(first_page));
1144    
1145  #if 0  #if defined(GC_DEBUG)
1146      fprintf(stderr, "  first_page=%d bytes_used=%d\n",      fprintf(stderr, "  first_page=%d bytes_used=%d\n",
1147              first_page, page_table[first_page].bytes_used);              first_page, page_table[first_page].bytes_used);
1148  #endif  #endif
# Line 1130  static void *gc_alloc_large(int  nbytes, Line 1164  static void *gc_alloc_large(int  nbytes,
1164    
1165      gc_assert(bytes_found == region_size);      gc_assert(bytes_found == region_size);
1166    
1167  #if 0  #if defined(GC_DEBUG)
1168      fprintf(stderr, "  last_page=%d bytes_found=%d num_pages=%d\n",      fprintf(stderr, "  last_page=%d bytes_found=%d num_pages=%d\n",
1169              last_page, bytes_found, num_pages);              last_page, bytes_found, num_pages);
1170  #endif  #endif
# Line 1148  static void *gc_alloc_large(int  nbytes, Line 1182  static void *gc_alloc_large(int  nbytes,
1182      exit(1);      exit(1);
1183    }    }
1184    
1185  #if 0  #if defined(GC_DEBUG)
1186    if (large)    if (large)
1187      fprintf(stderr, "gc_alloc_large gen %d: %d of %d bytes: from pages %d to %d: addr=%x\n",      fprintf(stderr, "gc_alloc_large gen %d: %d of %d bytes: from pages %d to %d: addr=%x\n",
1188              gc_alloc_generation, nbytes, bytes_found,              gc_alloc_generation, nbytes, bytes_found,
# Line 1205  static void *gc_alloc_large(int  nbytes, Line 1239  static void *gc_alloc_large(int  nbytes,
1239     * the bytes_used.     * the bytes_used.
1240     */     */
1241    while (more) {    while (more) {
1242  #if 0  #if defined(GC_DEBUG)
1243      fprintf(stderr, "+");      fprintf(stderr, "+");
1244  #endif  #endif
1245    
# Line 1241  static void *gc_alloc_large(int  nbytes, Line 1275  static void *gc_alloc_large(int  nbytes,
1275    /* Bump up the last_free_page */    /* Bump up the last_free_page */
1276    if (last_page + 1 > last_free_page) {    if (last_page + 1 > last_free_page) {
1277      last_free_page = last_page + 1;      last_free_page = last_page + 1;
1278      SetSymbolValue(ALLOCATION_POINTER,      set_alloc_pointer((lispobj) ((char *) heap_base +
1279                     (lispobj) ((char *) heap_base +                                 PAGE_SIZE * last_free_page));
                               PAGE_SIZE * last_free_page));  
1280    }    }
1281    
1282    return (void *) (page_address(first_page) + orig_first_page_bytes_used);    return (void *) (page_address(first_page) + orig_first_page_bytes_used);
# Line 1258  static void *gc_alloc(int nbytes) Line 1291  static void *gc_alloc(int nbytes)
1291  {  {
1292    void *new_free_pointer;    void *new_free_pointer;
1293    
1294  #if 0  #if defined(GC_DEBUG)
1295    fprintf(stderr, "gc_alloc %d\n",nbytes);    fprintf(stderr, "gc_alloc %d\n",nbytes);
1296  #endif  #endif
1297    
# Line 1381  static void *gc_alloc_unboxed(int nbytes Line 1414  static void *gc_alloc_unboxed(int nbytes
1414  {  {
1415    void *new_free_pointer;    void *new_free_pointer;
1416    
1417  #if 0  #if defined(GC_DEBUG)
1418    fprintf(stderr, "gc_alloc_unboxed %d\n",nbytes);    fprintf(stderr, "gc_alloc_unboxed %d\n",nbytes);
1419  #endif  #endif
1420    
# Line 1937  static void scavenge(lispobj *start, lon Line 1970  static void scavenge(lispobj *start, lon
1970  }  }
1971    
1972    
1973    #ifndef x86
1974    /* Scavenging Interrupt Contexts */
1975    
1976    static int boxed_registers[] = BOXED_REGISTERS;
1977    
1978    static void scavenge_interrupt_context(struct sigcontext *context)
1979    {
1980      int i;
1981    #ifdef reg_LIP
1982      unsigned long lip;
1983      unsigned long lip_offset;
1984      int lip_register_pair;
1985    #endif
1986      unsigned long pc_code_offset;
1987    #ifdef SC_NPC
1988      unsigned long npc_code_offset;
1989    #endif
1990    
1991      /* Find the LIP's register pair and calculate it's offset */
1992      /* before we scavenge the context. */
1993    #ifdef reg_LIP
1994      lip = SC_REG(context, reg_LIP);
1995      lip_offset = 0x7FFFFFFF;
1996      lip_register_pair = -1;
1997      for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++)
1998        {
1999          unsigned long reg;
2000          long offset;
2001          int index;
2002    
2003          index = boxed_registers[i];
2004          reg = SC_REG(context, index);
2005          if (Pointerp(reg) && PTR(reg) <= lip) {
2006            offset = lip - reg;
2007            if (offset < lip_offset) {
2008              lip_offset = offset;
2009              lip_register_pair = index;
2010            }
2011          }
2012        }
2013    #endif /* reg_LIP */
2014    
2015      /* Compute the PC's offset from the start of the CODE */
2016      /* register. */
2017      pc_code_offset = SC_PC(context) - SC_REG(context, reg_CODE);
2018    #ifdef SC_NPC
2019      npc_code_offset = SC_NPC(context) - SC_REG(context, reg_CODE);
2020    #endif /* SC_NPC */
2021    
2022      /* Scanvenge all boxed registers in the context. */
2023      for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++)
2024        {
2025          int index;
2026          lispobj foo;
2027    
2028          index = boxed_registers[i];
2029          foo = SC_REG(context,index);
2030          scavenge((lispobj *) &foo, 1);
2031          SC_REG(context,index) = foo;
2032    
2033          scavenge((lispobj *) &(SC_REG(context, index)), 1);
2034        }
2035    
2036    #ifdef reg_LIP
2037      /* Fix the LIP */
2038      SC_REG(context, reg_LIP) =
2039        SC_REG(context, lip_register_pair) + lip_offset;
2040    #endif /* reg_LIP */
2041    
2042      /* Fix the PC if it was in from space */
2043      if (from_space_p(SC_PC(context)))
2044        SC_PC(context) = SC_REG(context, reg_CODE) + pc_code_offset;
2045    #ifdef SC_NPC
2046      if (from_space_p(SC_NPC(context)))
2047        SC_NPC(context) = SC_REG(context, reg_CODE) + npc_code_offset;
2048    #endif /* SC_NPC */
2049    }
2050    
2051    void scavenge_interrupt_contexts(void)
2052    {
2053      int i, index;
2054      struct sigcontext *context;
2055    
2056      index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX));
2057    #define DEBUG_PRINT_CONTEXT_INDEX
2058    #if defined(DEBUG_PRINT_CONTEXT_INDEX)
2059      printf("Number of active contexts: %d\n", index);
2060    #endif
2061    
2062      for (i = 0; i < index; i++)
2063        {
2064          context = lisp_interrupt_contexts[i];
2065          scavenge_interrupt_context(context);
2066        }
2067    }
2068    #endif
2069    
2070  /* Code and Code-Related Objects */  /* Code and Code-Related Objects */
2071    
2072    /*
2073     * Aargh!  Why is SPARC so different here?  What is the advantage of
2074     * making it different from all the other ports?
2075     */
2076    #ifdef sparc
2077    #define RAW_ADDR_OFFSET 0
2078    #else
2079  #define RAW_ADDR_OFFSET (6 * sizeof(lispobj) - type_FunctionPointer)  #define RAW_ADDR_OFFSET (6 * sizeof(lispobj) - type_FunctionPointer)
2080    #endif
2081    
2082  static lispobj trans_function_header(lispobj object);  static lispobj trans_function_header(lispobj object);
2083  static lispobj trans_boxed(lispobj object);  static lispobj trans_boxed(lispobj object);
# Line 2069  void sniff_code_object(struct code *code Line 2207  void sniff_code_object(struct code *code
2207     * be a fixnum if it's x86 compiled code - check.     * be a fixnum if it's x86 compiled code - check.
2208     */     */
2209    if (code->trace_table_offset & 0x3) {    if (code->trace_table_offset & 0x3) {
2210  #if 0  #if defined(GC_DEBUG)
2211      fprintf(stderr, "*** Sniffing byte compiled code object at %x.\n",code);      fprintf(stderr, "*** Sniffing byte compiled code object at %x.\n",code);
2212  #endif  #endif
2213      return;      return;
# Line 2238  static void apply_code_fixups(struct cod Line 2376  static void apply_code_fixups(struct cod
2376     * be a fixnum if it's x86 compiled code - check.     * be a fixnum if it's x86 compiled code - check.
2377     */     */
2378    if (new_code->trace_table_offset & 0x3) {    if (new_code->trace_table_offset & 0x3) {
2379  #if 0  #if defined(GC_DEBUG)
2380      fprintf(stderr, "*** Byte compiled code object at %x.\n", new_code);      fprintf(stderr, "*** Byte compiled code object at %x.\n", new_code);
2381  #endif  #endif
2382      return;      return;
# Line 2248  static void apply_code_fixups(struct cod Line 2386  static void apply_code_fixups(struct cod
2386    ncode_words = fixnum_value(new_code->code_size);    ncode_words = fixnum_value(new_code->code_size);
2387    nheader_words = HeaderValue(*(lispobj *) new_code);    nheader_words = HeaderValue(*(lispobj *) new_code);
2388    nwords = ncode_words + nheader_words;    nwords = ncode_words + nheader_words;
2389  #if 0  #if defined(GC_DEBUG)
2390    fprintf(stderr, "*** Compiled code object at %x: header_words=%d code_words=%d .\n",    fprintf(stderr, "*** Compiled code object at %x: header_words=%d code_words=%d .\n",
2391            new_code, nheader_words, ncode_words);            new_code, nheader_words, ncode_words);
2392  #endif  #endif
# Line 2256  static void apply_code_fixups(struct cod Line 2394  static void apply_code_fixups(struct cod
2394    constants_end_addr = (void *) new_code + nheader_words * 4;    constants_end_addr = (void *) new_code + nheader_words * 4;
2395    code_start_addr = (void *) new_code + nheader_words * 4;    code_start_addr = (void *) new_code + nheader_words * 4;
2396    code_end_addr = (void *)new_code + nwords*4;    code_end_addr = (void *)new_code + nwords*4;
2397  #if 0  #if defined(GC_DEBUG)
2398    fprintf(stderr, "*** Const. start = %x; end= %x; Code start = %x; end = %x\n",    fprintf(stderr, "*** Const. start = %x; end= %x; Code start = %x; end = %x\n",
2399            constants_start_addr, constants_end_addr,            constants_start_addr, constants_end_addr,
2400            code_start_addr, code_end_addr);            code_start_addr, code_end_addr);
# Line 2277  static void apply_code_fixups(struct cod Line 2415  static void apply_code_fixups(struct cod
2415      if (check_code_fixups)      if (check_code_fixups)
2416        sniff_code_object(new_code, displacement);        sniff_code_object(new_code, displacement);
2417    
2418  #if 0  #if defined(GC_DEBUG)
2419      fprintf(stderr, "Fixups for code object not found!?\n");      fprintf(stderr, "Fixups for code object not found!?\n");
2420      fprintf(stderr, "*** Compiled code object at %x: header_words=%d code_words=%d .\n",      fprintf(stderr, "*** Compiled code object at %x: header_words=%d code_words=%d .\n",
2421              new_code, nheader_words, ncode_words);              new_code, nheader_words, ncode_words);
# Line 2293  static void apply_code_fixups(struct cod Line 2431  static void apply_code_fixups(struct cod
2431    /* Could be pointing to a forwarding pointer. */    /* Could be pointing to a forwarding pointer. */
2432    if (Pointerp(fixups) && find_page_index((void*) fixups_vector) != -1    if (Pointerp(fixups) && find_page_index((void*) fixups_vector) != -1
2433        && fixups_vector->header == 0x01) {        && fixups_vector->header == 0x01) {
2434  #if 0  #if defined(GC_DEBUG)
2435      fprintf(stderr, "* FF\n");      fprintf(stderr, "* FF\n");
2436  #endif  #endif
2437      /* If so then follow it. */      /* If so then follow it. */
2438      fixups_vector = (struct vector *) PTR((lispobj) fixups_vector->length);      fixups_vector = (struct vector *) PTR((lispobj) fixups_vector->length);
2439    }    }
2440    
2441  #if 0  #if defined(GC_DEBUG)
2442    fprintf(stderr, "Got the fixups\n");    fprintf(stderr, "Got the fixups\n");
2443  #endif  #endif
2444    
# Line 2349  static struct code * trans_code(struct c Line 2487  static struct code * trans_code(struct c
2487    unsigned long displacement;    unsigned long displacement;
2488    lispobj fheaderl, *prev_pointer;    lispobj fheaderl, *prev_pointer;
2489    
2490  #if 0  #if 0 || defined(GC_DEBUG)
2491    fprintf(stderr, "\nTransporting code object located at 0x%08x.\n",    fprintf(stderr, "\nTransporting code object located at 0x%08x.\n",
2492            (unsigned long) code);            (unsigned long) code);
2493  #endif  #endif
2494    
2495    /* If object has already been transported, just return pointer */    /* If object has already been transported, just return pointer */
2496    if (*(lispobj *) code == 0x01)    if (*(lispobj *) code == 0x01)
2497      return (struct code*) (((lispobj *) code)[1]);      {
2498    #if 0
2499          fprintf(stderr, "Code has already been transported\n");
2500    #endif
2501          return (struct code*) (((lispobj *) code)[1]);
2502        }
2503    
2504    
2505    gc_assert(TypeOf(code->header) == type_CodeHeader);    gc_assert(TypeOf(code->header) == type_CodeHeader);
2506    
# Line 2371  static struct code * trans_code(struct c Line 2515  static struct code * trans_code(struct c
2515    l_new_code = copy_large_object(l_code, nwords);    l_new_code = copy_large_object(l_code, nwords);
2516    new_code = (struct code *) PTR(l_new_code);    new_code = (struct code *) PTR(l_new_code);
2517    
2518    #if 0 || defined(GC_DEBUG)
2519      fprintf(stderr, "Old code object at 0x%08x, new code object at 0x%08x.\n",
2520              (unsigned long) code, (unsigned long) new_code);
2521      fprintf(stderr, "Code object is %d words long.\n", nwords);
2522    #endif
2523    
2524    /* May not have been moved. */    /* May not have been moved. */
2525    if (new_code == code)    if (new_code == code)
2526      return new_code;      return new_code;
2527    
2528    displacement = l_new_code - l_code;    displacement = l_new_code - l_code;
2529    
 #if 0  
   fprintf(stderr, "Old code object at 0x%08x, new code object at 0x%08x.\n",  
           (unsigned long) code, (unsigned long) new_code);  
   fprintf(stderr, "Code object is %d words long.\n", nwords);  
 #endif  
   
2530    /* set forwarding pointer */    /* set forwarding pointer */
2531    ((lispobj *) code)[0] = 0x01;    ((lispobj *) code)[0] = 0x01;
2532    ((lispobj *) code)[1] = l_new_code;    ((lispobj *) code)[1] = l_new_code;
# Line 2421  static struct code * trans_code(struct c Line 2565  static struct code * trans_code(struct c
2565      prev_pointer = &nfheaderp->next;      prev_pointer = &nfheaderp->next;
2566    }    }
2567    
2568  #if 0  #ifdef x86
2569    sniff_code_object(new_code, displacement);    sniff_code_object(new_code, displacement);
 #endif  
2570    apply_code_fixups(code, new_code);    apply_code_fixups(code, new_code);
2571    #else
2572      /* From gc.c */
2573    #ifndef MACH
2574      os_flush_icache((os_vm_address_t) (((int *)new_code) + nheader_words),
2575                      ncode_words * sizeof(int));
2576    #endif
2577    #endif
2578    
2579    return new_code;    return new_code;
2580  }  }
# Line 2504  static lispobj trans_return_pc_header(li Line 2654  static lispobj trans_return_pc_header(li
2654    unsigned long offset;    unsigned long offset;
2655    struct code *code, *ncode;    struct code *code, *ncode;
2656    
2657    fprintf(stderr, "*** trans_return_pc_header: will this work?\n");  #if 0
2658      fprintf(stderr, "*** trans_return_pc_header at %lx: will this work?\n", object);
2659    
2660      reset_printer();
2661      print(object);
2662    #endif
2663    
2664    return_pc = (struct function *) PTR(object);    return_pc = (struct function *) PTR(object);
2665    offset = HeaderValue(return_pc->header) * 4;    offset = HeaderValue(return_pc->header) * 4;
2666    
2667    /* Transport the whole code object */    /* Transport the whole code object */
2668    code = (struct code *) ((unsigned long) return_pc - offset);    code = (struct code *) ((unsigned long) return_pc - offset);
2669    #if 0
2670      fprintf(stderr, "*** trans_return_pc_header transporting %lx (ra = %lx, offset = %d bytes)\n",
2671              code, return_pc, offset);
2672      print(code);
2673    #endif
2674    
2675    ncode = trans_code(code);    ncode = trans_code(code);
2676    #if 0
2677      fprintf(stderr, "*** trans_return_pc_header new location %lx, returning %lx\n",
2678              ncode, ((lispobj) ncode + offset) | type_OtherPointer);
2679    #endif
2680    return ((lispobj) ncode + offset) | type_OtherPointer;    return ((lispobj) ncode + offset) | type_OtherPointer;
2681  }  }
2682    
# Line 2561  static lispobj trans_function_header(lis Line 2725  static lispobj trans_function_header(lis
2725    code = (struct code *) ((unsigned long) fheader - offset);    code = (struct code *) ((unsigned long) fheader - offset);
2726    ncode = trans_code(code);    ncode = trans_code(code);
2727    
2728    #if 0
2729      printf("trans_function_header %lx\n", object);
2730      printf("  self = %lx\n", fheader->self);
2731      reset_printer();
2732      print(object);
2733      printf("  old, new code = %lx, %lx\n", code, ncode);
2734    #endif
2735    
2736    return ((lispobj) ncode + offset) | type_FunctionPointer;    return ((lispobj) ncode + offset) | type_FunctionPointer;
2737  }  }
2738    
# Line 2833  static int scav_boxed(lispobj *where, li Line 3005  static int scav_boxed(lispobj *where, li
3005    
3006  static lispobj trans_boxed(lispobj object)  static lispobj trans_boxed(lispobj object)
3007  {  {
3008          lispobj header;    lispobj header;
3009          unsigned long length;    unsigned long length;
3010    
3011          gc_assert(Pointerp(object));    gc_assert(Pointerp(object));
3012    
3013          header = *((lispobj *) PTR(object));    header = *((lispobj *) PTR(object));
3014          length = HeaderValue(header) + 1;    length = HeaderValue(header) + 1;
3015          length = CEILING(length, 2);    length = CEILING(length, 2);
3016    
3017          return copy_object(object, length);    return copy_object(object, length);
3018  }  }
3019    
3020  static lispobj trans_boxed_large(lispobj object)  static lispobj trans_boxed_large(lispobj object)
# Line 3301  scav_hash_vector (lispobj *where, lispob Line 3473  scav_hash_vector (lispobj *where, lispob
3473    unsigned int kv_length;    unsigned int kv_length;
3474    lispobj *kv_vector;    lispobj *kv_vector;
3475    lispobj empty_symbol, hash_table_obj;    lispobj empty_symbol, hash_table_obj;
3476      lispobj save_kv_vector[2];
3477    struct hash_table *hash_table;    struct hash_table *hash_table;
3478    
3479    if (HeaderValue (object) != subtype_VectorValidHashing)    if (HeaderValue (object) != subtype_VectorValidHashing)
# Line 3311  scav_hash_vector (lispobj *where, lispob Line 3484  scav_hash_vector (lispobj *where, lispob
3484       length.  The first value is the symbol :empty, the first key is a       length.  The first value is the symbol :empty, the first key is a
3485       reference to the hash-table containing the key/value vector.       reference to the hash-table containing the key/value vector.
3486       (See hash-new.lisp, MAKE-HASH-TABLE.)  */       (See hash-new.lisp, MAKE-HASH-TABLE.)  */
3487    
3488    #if 0
3489      fprintf(stderr, "**** Scavenging VectorValidHashing (hash-table)\n");
3490    #endif
3491    kv_length = fixnum_value (where[1]);    kv_length = fixnum_value (where[1]);
3492    kv_vector = where + 2;    kv_vector = where + 2;
3493    
3494      save_kv_vector[0] = kv_vector[0];
3495      save_kv_vector[1] = kv_vector[1];
3496    
3497    scavenge (kv_vector, 2);    scavenge (kv_vector, 2);
3498    
3499    gc_assert (Pointerp (kv_vector[0]));    gc_assert (Pointerp (kv_vector[0]));
# Line 3323  scav_hash_vector (lispobj *where, lispob Line 3503  scav_hash_vector (lispobj *where, lispob
3503    hash_table = (struct hash_table *) PTR (hash_table_obj);    hash_table = (struct hash_table *) PTR (hash_table_obj);
3504    empty_symbol = kv_vector[1];    empty_symbol = kv_vector[1];
3505    
3506    #if 1
3507      if (where != (lispobj *) PTR (hash_table->table))
3508        {
3509          fprintf(stderr, "save_kv_vector = %lx %lx\n",
3510                  save_kv_vector[0], save_kv_vector[1]);
3511          fprintf(stderr, "where = %lx\n", where);
3512          fprintf(stderr, "hash_table = %lx\n", hash_table);
3513          fprintf(stderr, "hash_table->table = %lx\n", PTR(hash_table->table));
3514          reset_printer();
3515    #if 0
3516          print(object);
3517          abort();
3518    #endif
3519        }
3520    #endif
3521    #if 0
3522    gc_assert (where == (lispobj *) PTR (hash_table->table));    gc_assert (where == (lispobj *) PTR (hash_table->table));
3523    #endif
3524    gc_assert (TypeOf (hash_table->instance_header) == type_InstanceHeader);    gc_assert (TypeOf (hash_table->instance_header) == type_InstanceHeader);
3525    gc_assert (TypeOf (*(lispobj *) PTR (empty_symbol)) == type_SymbolHeader);    gc_assert (TypeOf (*(lispobj *) PTR (empty_symbol)) == type_SymbolHeader);
3526    
# Line 3926  static int scav_scavenger_hook(lispobj * Line 4123  static int scav_scavenger_hook(lispobj *
4123    struct scavenger_hook *scav_hook = (struct scavenger_hook *) where;    struct scavenger_hook *scav_hook = (struct scavenger_hook *) where;
4124    lispobj old_value = scav_hook->value;    lispobj old_value = scav_hook->value;
4125    
4126  #if 0  #if defined(GC_DEBUG)
4127    fprintf(stderr, "scav scav_hook %x; value %x\n", where, old_value);    fprintf(stderr, "scav scav_hook %x; value %x\n", where, old_value);
4128  #endif  #endif
4129    
# Line 3935  static int scav_scavenger_hook(lispobj * Line 4132  static int scav_scavenger_hook(lispobj *
4132    
4133    if (scav_hook->value != old_value) {    if (scav_hook->value != old_value) {
4134      /* Value object has moved */      /* Value object has moved */
4135  #if 0  #if defined(GC_DEBUG)
4136      fprintf(stderr, "   value object moved to %x\n", scav_hook->value);      fprintf(stderr, "   value object moved to %x\n", scav_hook->value);
4137  #endif  #endif
4138    
4139      /* Check if this hook is already noted. */      /* Check if this hook is already noted. */
4140  #if 0  #if defined(GC_DEBUG)
4141      fprintf(stderr, "   next=%x sh hooks=%x\n",      fprintf(stderr, "   next=%x sh hooks=%x\n",
4142              scav_hook->next, scavenger_hooks);              scav_hook->next, scavenger_hooks);
4143  #endif  #endif
4144      if (scav_hook->next == NULL) {      if (scav_hook->next == NULL) {
4145  #if 0  #if defined(GC_DEBUG)
4146        fprintf(stderr, "   adding to scavenger_hooks\n");        fprintf(stderr, "   adding to scavenger_hooks\n");
4147  #endif  #endif
4148        scav_hook->next = scavenger_hooks;        scav_hook->next = scavenger_hooks;
# Line 3962  static lispobj trans_scavenger_hook(lisp Line 4159  static lispobj trans_scavenger_hook(lisp
4159  {  {
4160    lispobj copy;    lispobj copy;
4161    gc_assert(Pointerp(object));    gc_assert(Pointerp(object));
4162  #if 0  #if defined(GC_DEBUG)
4163    printf("Transporting scav pointer from 0x%08x\n", object);    printf("Transporting scav pointer from 0x%08x\n", object);
4164  #endif  #endif
4165    copy = copy_object(object, SCAVENGER_HOOK_NWORDS);    copy = copy_object(object, SCAVENGER_HOOK_NWORDS);
# Line 4079  static void gc_init_tables(void) Line 4276  static void gc_init_tables(void)
4276          scavtab[type_ComplexVector] = scav_boxed;          scavtab[type_ComplexVector] = scav_boxed;
4277          scavtab[type_ComplexArray] = scav_boxed;          scavtab[type_ComplexArray] = scav_boxed;
4278          scavtab[type_CodeHeader] = scav_code_header;          scavtab[type_CodeHeader] = scav_code_header;
4279          /*scavtab[type_FunctionHeader] = scav_function_header;*/  #ifndef i386
4280          /*scavtab[type_ClosureFunctionHeader] = scav_function_header;*/          scavtab[type_FunctionHeader] = scav_function_header;
4281          /*scavtab[type_ReturnPcHeader] = scav_return_pc_header;*/          scavtab[type_ClosureFunctionHeader] = scav_function_header;
4282            scavtab[type_ReturnPcHeader] = scav_return_pc_header;
4283    #endif
4284  #ifdef i386  #ifdef i386
4285          scavtab[type_ClosureHeader] = scav_closure_header;          scavtab[type_ClosureHeader] = scav_closure_header;
4286          scavtab[type_FuncallableInstanceHeader] = scav_closure_header;          scavtab[type_FuncallableInstanceHeader] = scav_closure_header;
# Line 4102  static void gc_init_tables(void) Line 4301  static void gc_init_tables(void)
4301          scavtab[type_UnboundMarker] = scav_immediate;          scavtab[type_UnboundMarker] = scav_immediate;
4302          scavtab[type_WeakPointer] = scav_weak_pointer;          scavtab[type_WeakPointer] = scav_weak_pointer;
4303          scavtab[type_InstanceHeader] = scav_boxed;          scavtab[type_InstanceHeader] = scav_boxed;
4304            /*
4305             * Note: on the sparc we don't have to do anything special for
4306             * fdefns, cause the raw-addr has a function lowtag.
4307             */
4308    #ifndef sparc
4309          scavtab[type_Fdefn] = scav_fdefn;          scavtab[type_Fdefn] = scav_fdefn;
4310    #else
4311            scavtab[type_Fdefn] = scav_boxed;
4312    #endif
4313    
4314          scavtab[type_ScavengerHook] = scav_scavenger_hook;          scavtab[type_ScavengerHook] = scav_scavenger_hook;
4315    
4316          /* Transport Other Table */          /* Transport Other Table */
# Line 4299  static lispobj* search_space(lispobj *st Line 4507  static lispobj* search_space(lispobj *st
4507      /* Check if the pointer is within this object? */      /* Check if the pointer is within this object? */
4508      if (pointer >= start && pointer < start + count) {      if (pointer >= start && pointer < start + count) {
4509        /* Found it. */        /* Found it. */
4510  #if 0  #if defined(GC_DEBUG)
4511        fprintf(stderr, "* Found %x in %x %x\n", pointer, start, thing);        fprintf(stderr, "* Found %x in %x %x\n", pointer, start, thing);
4512  #endif  #endif
4513        return start;        return start;
# Line 4772  static void preserve_pointer(void *addr) Line 4980  static void preserve_pointer(void *addr)
4980    
4981      /* Mark the page static */      /* Mark the page static */
4982      page_table[i].flags |= PAGE_DONT_MOVE_MASK;      page_table[i].flags |= PAGE_DONT_MOVE_MASK;
4983  #if 0  #if defined(GC_DEBUG)
4984      fprintf(stderr, "#%d,", i);      fprintf(stderr, "#%d,", i);
4985  #endif  #endif
4986    
# Line 4918  static int update_page_write_prot(unsign Line 5126  static int update_page_write_prot(unsign
5126    
5127    if (wp_it == 1) {    if (wp_it == 1) {
5128      /* Write protect the page */      /* Write protect the page */
5129  #if 0  #if defined(GC_DEBUG)
5130      fprintf(stderr, "* WP page %d of gen %d\n", page, gen);      fprintf(stderr, "* WP page %d of gen %d\n", page, gen);
5131  #endif  #endif
5132    
# Line 5099  static void scavenge_newspace_generation Line 5307  static void scavenge_newspace_generation
5307  {  {
5308    int i;    int i;
5309    
5310  #if 0  #if defined(GC_DEBUG)
5311    fprintf(stderr, "Starting one full scan of newspace generation %d\n",    fprintf(stderr, "Starting one full scan of newspace generation %d\n",
5312            generation);            generation);
5313  #endif  #endif
# Line 5167  static void scavenge_newspace_generation Line 5375  static void scavenge_newspace_generation
5375  #if SC_NS_GEN_CK  #if SC_NS_GEN_CK
5376                int a1 = bytes_allocated;                int a1 = bytes_allocated;
5377  #endif  #endif
5378  #if 0  #if defined(GC_DEBUG)
5379                fprintf(stderr, "scavenge(%x,%d)\n",                fprintf(stderr, "scavenge(%x,%d)\n",
5380                        page_address(i) + page_table[i].first_object_offset,                        page_address(i) + page_table[i].first_object_offset,
5381                        size);                        size);
# Line 5250  static void scavenge_newspace_generation Line 5458  static void scavenge_newspace_generation
5458    /* Grab new_areas_index */    /* Grab new_areas_index */
5459    current_new_areas_index = new_areas_index;    current_new_areas_index = new_areas_index;
5460    
5461  #if 0  #if defined(GC_DEBUG)
5462    fprintf(stderr, "First scan finished; current_new_areas_index=%d\n",    fprintf(stderr, "First scan finished; current_new_areas_index=%d\n",
5463            current_new_areas_index);            current_new_areas_index);
5464  #endif  #endif
# Line 5310  static void scavenge_newspace_generation Line 5518  static void scavenge_newspace_generation
5518          int size = (*previous_new_areas)[i].size / 4;          int size = (*previous_new_areas)[i].size / 4;
5519          gc_assert((*previous_new_areas)[i].size % 4 == 0);          gc_assert((*previous_new_areas)[i].size % 4 == 0);
5520    
5521  #if 0  #if defined(GC_DEBUG)
5522          fprintf(stderr, "*S page %d offset %d size %d\n",page,offset,size*4);          fprintf(stderr, "*S page %d offset %d size %d\n",page,offset,size*4);
5523  #endif  #endif
5524          scavenge(page_address(page)+offset, size);          scavenge(page_address(page)+offset, size);
# Line 5324  static void scavenge_newspace_generation Line 5532  static void scavenge_newspace_generation
5532      /* Grab new_areas_index */      /* Grab new_areas_index */
5533      current_new_areas_index = new_areas_index;      current_new_areas_index = new_areas_index;
5534    
5535  #if 0  #if defined(GC_DEBUG)
5536      fprintf(stderr, "Re-scan finished; current_new_areas_index=%d\n",      fprintf(stderr, "Re-scan finished; current_new_areas_index=%d\n",
5537              current_new_areas_index);              current_new_areas_index);
5538  #endif  #endif
# Line 5387  static void unprotect_oldspace(void) Line 5595  static void unprotect_oldspace(void)
5595   * generation. Bytes_allocated and the generation bytes_allocated   * generation. Bytes_allocated and the generation bytes_allocated
5596   * counter are updated.  The number of bytes freed is returned.   * counter are updated.  The number of bytes freed is returned.
5597   */   */
5598    #ifdef i386
5599  extern void i586_bzero(void *addr, int nbytes);  extern void i586_bzero(void *addr, int nbytes);
5600    #else
5601    #define i586_bzero(addr, nbytes)        memset(addr, 0, nbytes)
5602    #endif
5603  static int free_oldspace(void)  static int free_oldspace(void)
5604  {  {
5605    int bytes_freed = 0;    int bytes_freed = 0;
# Line 5483  static void print_ptr(lispobj *addr) Line 5695  static void print_ptr(lispobj *addr)
5695            *(addr + 1), *(addr + 2), *(addr + 3), *(addr + 4));            *(addr + 1), *(addr + 2), *(addr + 3), *(addr + 4));
5696  }  }
5697    
5698    #ifdef sparc
5699    extern char  closure_tramp;
5700    #else
5701  extern int  undefined_tramp;  extern int  undefined_tramp;
5702    #endif
5703    
5704  static void verify_space(lispobj*start, size_t words)  static void verify_space(lispobj*start, size_t words)
5705  {  {
# Line 5536  static void verify_space(lispobj*start, Line 5752  static void verify_space(lispobj*start,
5752           * Does it point to a plausible object? This check slows it           * Does it point to a plausible object? This check slows it
5753           * down a lot.           * down a lot.
5754           */           */
5755  #if 0  #if 1
5756          if (!valid_dynamic_space_pointer((lispobj *) thing)) {          if (!valid_dynamic_space_pointer((lispobj *) thing)) {
5757            fprintf(stderr, "*** Ptr %x to invalid object %x\n", thing, start);            fprintf(stderr, "*** Ptr %x to invalid object %x\n", thing, start);
5758            print_ptr(start);            print_ptr(start);
5759          }          }
5760  #endif  #endif
5761        } else        } else {
5762          /* Verify that it points to another valid space */          /* Verify that it points to another valid space */
5763          if (!to_readonly_space && !to_static_space          if (!to_readonly_space && !to_static_space &&
5764              && thing != (int) &undefined_tramp) {  #if defined(sparc)
5765            fprintf(stderr, "*** Ptr %lx @ %lx sees Junk\n",              thing != (int) &closure_tramp
5766                    (unsigned long) thing, (unsigned long) start);  #else
5767            print_ptr(start);              thing != (int) &undefined_tramp
5768          }  #endif
5769                )
5770              {
5771                fprintf(stderr, "*** Ptr %lx @ %lx sees Junk (undefined_tramp = %lx)\n",
5772                        (unsigned long) thing, (unsigned long) start,
5773    #if defined(sparc)
5774                        (unsigned long) &closure_tramp
5775    #else
5776                        (unsigned long) &undefined_tramp
5777    #endif
5778                        );
5779                print_ptr(start);
5780              }
5781          }
5782    
5783      } else      } else
5784        if (thing & 0x3) /* Skip fixnums */        if (thing & 0x3) /* Skip fixnums */
5785          switch(TypeOf(*start)) {          switch(TypeOf(*start)) {
# Line 5694  static void verify_gc(void) Line 5924  static void verify_gc(void)
5924      (lispobj*) SymbolValue(STATIC_SPACE_FREE_POINTER)      (lispobj*) SymbolValue(STATIC_SPACE_FREE_POINTER)
5925      - (lispobj*) static_space;      - (lispobj*) static_space;
5926    int binding_stack_size =    int binding_stack_size =
5927      (lispobj*) SymbolValue(BINDING_STACK_POINTER)      (lispobj*) get_binding_stack_pointer()
5928      - (lispobj*) BINDING_STACK_START;      - (lispobj*) BINDING_STACK_START;
5929    
5930    verify_space((lispobj*) READ_ONLY_SPACE_START, read_only_space_size);    verify_space((lispobj*) READ_ONLY_SPACE_START, read_only_space_size);
# Line 5897  static void    garbage_collect_generation(i Line 6127  static void    garbage_collect_generation(i
6127    unprotect_oldspace();    unprotect_oldspace();
6128    
6129    /* Scavenge the stacks conservative roots. */    /* Scavenge the stacks conservative roots. */
6130    #ifdef i386
6131    {    {
6132      lispobj **ptr;      lispobj **ptr;
6133      for (ptr = (lispobj **) CONTROL_STACK_END - 1;      for (ptr = (lispobj **) CONTROL_STACK_END - 1;
6134           ptr > (lispobj **) &raise; ptr--)           ptr > (lispobj **) &raise; ptr--)
6135        preserve_pointer(*ptr);        preserve_pointer(*ptr);
6136    }    }
6137    #endif
6138    
6139  #ifdef CONTROL_STACKS  #ifdef CONTROL_STACKS
6140    scavenge_thread_stacks();    scavenge_thread_stacks();
6141  #endif  #endif
# Line 5911  static void    garbage_collect_generation(i Line 6144  static void    garbage_collect_generation(i
6144      int num_dont_move_pages = count_dont_move_pages();      int num_dont_move_pages = count_dont_move_pages();
6145      fprintf(stderr, "Non-movable pages due to conservative pointers = %d, %d bytes\n",      fprintf(stderr, "Non-movable pages due to conservative pointers = %d, %d bytes\n",
6146              num_dont_move_pages, PAGE_SIZE * num_dont_move_pages);              num_dont_move_pages, PAGE_SIZE * num_dont_move_pages);
6147    #ifndef i386
6148        /*
6149         * There shouldn't be any non-movable pages because we don't have
6150         * any conservative pointers!
6151         */
6152        gc_assert(num_dont_move_pages == 0);
6153    #endif
6154    }    }
6155    
6156    /* Scavenge all the rest of the roots. */    /* Scavenge all the rest of the roots. */
# Line 5920  static void    garbage_collect_generation(i Line 6160  static void    garbage_collect_generation(i
6160     * care to avoid SIG_DFL, SIG_IGN.     * care to avoid SIG_DFL, SIG_IGN.
6161     */     */
6162    
6163    #ifndef x86
6164    #ifdef PRINTNOISE
6165      printf("Scavenging interrupt contexts ...\n");
6166    #endif
6167      scavenge_interrupt_contexts();
6168    #ifdef PRINTNOISE
6169      printf("Scavenging interrupt handlers (%d bytes) ...\n",
6170             sizeof(interrupt_handlers));
6171    #endif
6172      scavenge((lispobj *) interrupt_handlers,
6173               sizeof(interrupt_handlers) / sizeof(lispobj));
6174      {
6175        unsigned long control_stack_size;
6176    
6177        control_stack_size = current_control_stack_pointer - control_stack;
6178    #ifdef PRINTNOISE
6179        printf("Scavenging the control stack (%d bytes) ...\n",
6180               control_stack_size * sizeof(lispobj));
6181    #endif
6182        scavenge(control_stack, control_stack_size);
6183    #ifdef PRINTNOISE
6184        printf("Done scavenging the control stack.\n");
6185    #endif
6186      }
6187    
6188    #else
6189    for (i = 0; i < NSIG; i++) {    for (i = 0; i < NSIG; i++) {
6190      union interrupt_handler handler = interrupt_handlers[i];      union interrupt_handler handler = interrupt_handlers[i];
6191      if (handler.c != (void (*) (HANDLER_ARGS)) SIG_IGN      if (handler.c != (void (*) (HANDLER_ARGS)) SIG_IGN
6192          && handler.c != (void (*) (HANDLER_ARGS)) SIG_DFL)          && handler.c != (void (*) (HANDLER_ARGS)) SIG_DFL)
6193        scavenge((lispobj *) (interrupt_handlers + i), 1);        scavenge((lispobj *) (interrupt_handlers + i), 1);
6194    }    }
6195    #endif
6196    
6197    #ifdef PRINTNOISE
6198        printf("Scavenging the binding stack (%d bytes) ...\n",
6199               ((lispobj *) get_binding_stack_pointer() - binding_stack) * sizeof(lispobj));
6200    #endif
6201    /* Scavenge the binding stack. */    /* Scavenge the binding stack. */
6202    scavenge(binding_stack,    scavenge(binding_stack,
6203             (lispobj *) SymbolValue(BINDING_STACK_POINTER) - binding_stack);             (lispobj *) get_binding_stack_pointer() - binding_stack);
6204    
6205    #ifdef PRINTNOISE
6206        printf("Done scavenging the binding stack.\n");
6207    #endif
6208    /*    /*
6209     * Scavenge the scavenge_hooks in case this refers to a hook added     * Scavenge the scavenge_hooks in case this refers to a hook added
6210     * in a prior generation GC. From here on the scavenger_hook will     * in a prior generation GC. From here on the scavenger_hook will
# Line 5938  static void    garbage_collect_generation(i Line 6212  static void    garbage_collect_generation(i
6212     * doing here.     * doing here.
6213     */     */
6214    
6215    #ifdef PRINTNOISE
6216        printf("Scavenging the scavenger hooks ...\n");
6217    #endif
6218    scavenge((lispobj *) &scavenger_hooks, 1);    scavenge((lispobj *) &scavenger_hooks, 1);
6219    #ifdef PRINTNOISE
6220        printf("Done scavenging the scavenger hooks.\n");
6221    #endif
6222    
6223    if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) {    if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) {
6224      read_only_space_size = (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER)      read_only_space_size = (lispobj *) SymbolValue(READ_ONLY_SPACE_FREE_POINTER)
# Line 5970  static void    garbage_collect_generation(i Line 6250  static void    garbage_collect_generation(i
6250     */     */
6251    scavenge_newspace_generation(new_space);    scavenge_newspace_generation(new_space);
6252    
6253  #define RESCAN_CHECK 0  #define RESCAN_CHECK 1
6254  #if RESCAN_CHECK  #if RESCAN_CHECK
6255    /*    /*
6256     * As a check re-scavenge the newspace once; no new objects should     * As a check re-scavenge the newspace once; no new objects should
# Line 5978  static void    garbage_collect_generation(i Line 6258  static void    garbage_collect_generation(i
6258     */     */
6259    {    {
6260      int old_bytes_allocated = bytes_allocated;      int old_bytes_allocated = bytes_allocated;
6261      int bytes_allocated;      int bytes_allocated_diff;
6262    
6263      /* Start with a full scavenge */      /* Start with a full scavenge */
6264      scavenge_newspace_generation_one_scan(new_space);      scavenge_newspace_generation_one_scan(new_space);
# Line 5989  static void    garbage_collect_generation(i Line 6269  static void    garbage_collect_generation(i
6269      gc_alloc_update_page_tables(0, &boxed_region);      gc_alloc_update_page_tables(0, &boxed_region);
6270      gc_alloc_update_page_tables(1, &unboxed_region);      gc_alloc_update_page_tables(1, &unboxed_region);
6271    
6272      bytes_allocated = bytes_allocated - old_bytes_allocated;      bytes_allocated_diff = bytes_allocated - old_bytes_allocated;
6273    
6274      if (bytes_allocated != 0)      if (bytes_allocated_diff != 0)
6275        fprintf(stderr, "*** rescan of new_space allocated % more bytes?\n",        fprintf(stderr, "*** rescan of new_space allocated %d more bytes? (%ld vs %ld)\n",
6276                bytes_allocated);                bytes_allocated_diff, old_bytes_allocated, bytes_allocated);
6277    }    }
6278  #endif  #endif
6279    
# Line 6058  void   update_x86_dynamic_space_free_point Line 6338  void   update_x86_dynamic_space_free_point
6338    
6339    last_free_page = last_page + 1;    last_free_page = last_page + 1;
6340    
6341    SetSymbolValue(ALLOCATION_POINTER,    set_alloc_pointer((lispobj) ((char *) heap_base + PAGE_SIZE * last_free_page));
                  (lispobj) ((char *) heap_base + PAGE_SIZE * last_free_page));  
6342  }  }
6343    
6344    
# Line 6199  void   collect_garbage(unsigned last_gen) Line 6478  void   collect_garbage(unsigned last_gen)
6478      for (sh = (struct scavenger_hook *) PTR((int) scavenger_hooks);      for (sh = (struct scavenger_hook *) PTR((int) scavenger_hooks);
6479           sh != (struct scavenger_hook *) PTR(NIL);) {           sh != (struct scavenger_hook *) PTR(NIL);) {
6480        struct scavenger_hook *sh_next = (struct scavenger_hook *) PTR((int) sh->next);        struct scavenger_hook *sh_next = (struct scavenger_hook *) PTR((int) sh->next);
6481  #if 0  #if defined(GC_DEBUG)
6482        fprintf(stderr, "Scav hook %x; next %x; calling scav hook fn %x\n",        fprintf(stderr, "Scav hook %x; next %x; calling scav hook fn %x\n",
6483                sh, sh_next, sh->function);                sh, sh_next, sh->function);
6484  #endif  #endif
# Line 6301  void   gc_free_heap(void) Line 6580  void   gc_free_heap(void)
6580    unboxed_region.end_addr = page_address(0);    unboxed_region.end_addr = page_address(0);
6581    
6582    last_free_page = 0;    last_free_page = 0;
   SetSymbolValue(ALLOCATION_POINTER, (lispobj) heap_base);  
6583    
6584      set_alloc_pointer((lispobj) heap_base);
6585    
6586    SetSymbolValue(CURRENT_REGION_FREE_POINTER, (lispobj) boxed_region.free_pointer);    SetSymbolValue(CURRENT_REGION_FREE_POINTER, (lispobj) boxed_region.free_pointer);
6587    SetSymbolValue(CURRENT_REGION_END_ADDR, (lispobj) boxed_region.end_addr);    SetSymbolValue(CURRENT_REGION_END_ADDR, (lispobj) boxed_region.end_addr);
6588    
# Line 6395  void   gencgc_pickup_dynamic(void) Line 6675  void   gencgc_pickup_dynamic(void)
6675  {  {
6676    int page = 0;    int page = 0;
6677    int addr = DYNAMIC_0_SPACE_START;    int addr = DYNAMIC_0_SPACE_START;
6678    int alloc_ptr = SymbolValue(ALLOCATION_POINTER);    int alloc_ptr = get_alloc_pointer();
6679    
6680    /* Initialise the first region. */    /* Initialise the first region. */
6681    do {    do {
# Line 6443  void do_pending_interrupt(void); Line 6723  void do_pending_interrupt(void);
6723    
6724  int alloc_entered = 0;  int alloc_entered = 0;
6725    
6726  char *alloc(int nbytes)  #ifndef i386
6727    extern int need_to_pop_stack;
6728    #endif
6729    
6730    char *
6731    alloc(int nbytes)
6732  {  {
6733    /* Check for alignment allocation problems. */    /* Check for alignment allocation problems. */
6734    gc_assert(((unsigned) SymbolValue(CURRENT_REGION_FREE_POINTER) & 0x7) == 0    gc_assert(((unsigned) SymbolValue(CURRENT_REGION_FREE_POINTER) & 0x7) == 0
# Line 6451  char *alloc(int nbytes) Line 6736  char *alloc(int nbytes)
6736    
6737    bytes_allocated_sum += nbytes;    bytes_allocated_sum += nbytes;
6738    
6739    if (SymbolValue(PSEUDO_ATOMIC_ATOMIC)) {    if (get_pseudo_atomic_atomic()) {
6740      /* Already within a pseudo atomic. */      /* Already within a pseudo atomic. */
6741      void *new_free_pointer;      void *new_free_pointer;
6742    
# Line 6475  char *alloc(int nbytes) Line 6760  char *alloc(int nbytes)
6760        auto_gc_trigger *= 2;        auto_gc_trigger *= 2;
6761        alloc_entered--;        alloc_entered--;
6762        /* Exit the pseudo atomic */        /* Exit the pseudo atomic */
6763        SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0));        clr_pseudo_atomic_atomic();
6764        if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED) != 0)        if (get_pseudo_atomic_interrupted() != 0)
6765          /* Handle any interrupts that occurred during gc_alloc */          /* Handle any interrupts that occurred during gc_alloc */
6766          do_pending_interrupt();          do_pending_interrupt();
6767        funcall0(SymbolFunction(MAYBE_GC));        funcall0(SymbolFunction(MAYBE_GC));
6768    #ifndef i386
6769          need_to_pop_stack = 0;
6770          fprintf(stderr, "ALLOC called MAYBE-GC! bytes_allocated, gc_trigger = %d %d\n",
6771                  bytes_allocated, auto_gc_trigger);
6772    #endif
6773        /* Re-enter the pseudo atomic. */        /* Re-enter the pseudo atomic. */
6774        SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0));        clr_pseudo_atomic_interrupted();
6775        SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1));        set_pseudo_atomic_atomic();
6776        goto retry1;        goto retry1;
6777      }      }
6778      /* Call gc_alloc */      /* Call gc_alloc */
# Line 6498  char *alloc(int nbytes) Line 6788  char *alloc(int nbytes)
6788      void *result;      void *result;
6789      void *new_free_pointer;      void *new_free_pointer;
6790    
6791  #if 0  #if 0 && defined(GC_DEBUG)
6792      /*      /*
6793       * Check that the interrupts are masked, else there could be       * Check that the interrupts are masked, else there could be
6794       * trouble if the allocation is interrupted.       * trouble if the allocation is interrupted.
# Line 6512  char *alloc(int nbytes) Line 6802  char *alloc(int nbytes)
6802    retry2:    retry2:
6803      /* At least wrap this allocation in a pseudo atomic to prevent      /* At least wrap this allocation in a pseudo atomic to prevent
6804         gc_alloc from being re-entered. */         gc_alloc from being re-entered. */
6805      SetSymbolValue(PSEUDO_ATOMIC_INTERRUPTED, make_fixnum(0));      clr_pseudo_atomic_interrupted();
6806      SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(1));      set_pseudo_atomic_atomic();
6807    
6808      if (alloc_entered++)      if (alloc_entered++)
6809        fprintf(stderr,"* Alloc re-entered\n");        fprintf(stderr,"* Alloc re-entered\n");
# Line 6527  char *alloc(int nbytes) Line 6817  char *alloc(int nbytes)
6817        SetSymbolValue(CURRENT_REGION_FREE_POINTER, (lispobj) new_free_pointer);        SetSymbolValue(CURRENT_REGION_FREE_POINTER, (lispobj) new_free_pointer);
6818    
6819        alloc_entered--;        alloc_entered--;
6820        SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0));        clr_pseudo_atomic_atomic();
6821        if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED)) {        if (get_pseudo_atomic_interrupted()) {
6822          /* Handle any interrupts that occurred during gc_alloc */          /* Handle any interrupts that occurred during gc_alloc */
6823          do_pending_interrupt();          do_pending_interrupt();
6824          goto retry2;          goto retry2;
# Line 6541  char *alloc(int nbytes) Line 6831  char *alloc(int nbytes)
6831        auto_gc_trigger *= 2;        auto_gc_trigger *= 2;
6832        alloc_entered--;        alloc_entered--;
6833        /* Exit the pseudo atomic */        /* Exit the pseudo atomic */
6834        SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0));        clr_pseudo_atomic_atomic();
6835        if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED) != 0)        if (get_pseudo_atomic_interrupted() != 0)
6836          /* Handle any interrupts that occurred during gc_alloc */          /* Handle any interrupts that occurred during gc_alloc */
6837          do_pending_interrupt();          do_pending_interrupt();
6838        funcall0(SymbolFunction(MAYBE_GC));        funcall0(SymbolFunction(MAYBE_GC));
# Line 6556  char *alloc(int nbytes) Line 6846  char *alloc(int nbytes)
6846      SetSymbolValue(CURRENT_REGION_END_ADDR, (lispobj) boxed_region.end_addr);      SetSymbolValue(CURRENT_REGION_END_ADDR, (lispobj) boxed_region.end_addr);
6847    
6848      alloc_entered--;      alloc_entered--;
6849      SetSymbolValue(PSEUDO_ATOMIC_ATOMIC, make_fixnum(0));      clr_pseudo_atomic_atomic();
6850      if (SymbolValue(PSEUDO_ATOMIC_INTERRUPTED) != 0) {      if (get_pseudo_atomic_interrupted() != 0) {
6851        /* Handle any interrupts that occurred during gc_alloc */        /* Handle any interrupts that occurred during gc_alloc */
6852        do_pending_interrupt();        do_pending_interrupt();
6853        goto retry2;        goto retry2;

Legend:
Removed from v.1.32  
changed lines
  Added in v.1.32.4.1

  ViewVC Help
Powered by ViewVC 1.1.5