/[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.37 by toy, Mon Sep 15 16:41:12 2003 UTC revision 1.38 by gerd, Tue Sep 16 11:13:46 2003 UTC
# Line 78  Line 78 
78  #error gencgc is not supported on this platform  #error gencgc is not supported on this platform
79  #endif  #endif
80    
81    /* Define for activating assertions.  */
82    
83    #ifdef sparc
84    #define GC_ASSERTIONS 1
85    #endif
86    
87    /* Check for references to stack-allocated objects.  */
88    
89    #ifdef GC_ASSERTIONS
90    
91    static void *invalid_stack_start, *invalid_stack_end;
92    
93    static inline void
94    check_escaped_stack_object (lispobj *where, lispobj obj)
95    {
96      void *p;
97      if (Pointerp (obj)
98          && (p = (void *) PTR (obj),
99              (p >= (void *) CONTROL_STACK_START
100               && p < (void *) CONTROL_STACK_END)))
101        {
102          char *space;
103    
104          if (where >= (lispobj *) DYNAMIC_0_SPACE_START
105              && where < (lispobj *) (DYNAMIC_0_SPACE_START + DYNAMIC_SPACE_SIZE))
106            space = "dynamic space";
107          else if (where >= (lispobj *) STATIC_SPACE_START
108                   && where < (lispobj *) (STATIC_SPACE_START + STATIC_SPACE_SIZE))
109            space = "static space";
110          else
111            space = "read-only space";
112    
113          /* GC itself uses some stack, so we can't tell exactly where the
114             invalid stack area starts.  Usually, it should be an error if a
115             reference to a stack-allocated object is found, although it
116             is valid to store a reference to a stack-allocated object
117             temporarily in another reachable object, as long as the
118             reference goes away at the end of a dynamic extent.  */
119    
120          if (p >= invalid_stack_start && p < invalid_stack_end)
121            lose ("Escaped stack-allocated object 0x%08lx at %p in %s\n",
122                  (unsigned long) obj, where, space);
123          else
124            fprintf (stderr,
125                     "Reference to stack-allocated object 0x%08lx at %p in %s\n",
126                     (unsigned long) obj, where, space);
127        }
128    }
129    
130    #endif /* GC_ASSERTIONS */
131    
132    
133  /*  /*
134   * Leave the gc_asserts enabled on sparc for a while yet until this   * Leave the gc_asserts enabled on sparc for a while yet until this
135   * stabilizes.   * stabilizes.
136   */   */
137  #if defined(sparc)  #ifdef GC_ASSERTIONS
138  #define gc_assert(ex) do { \  #define gc_assert(ex)           \
139          if (!(ex)) gc_abort(); \    do {                          \
140  } while (0)      if (!(ex)) gc_abort ();     \
141      } while (0)
142  #else  #else
143  #define gc_assert(ex)  (void) 0  #define gc_assert(ex)  (void) 0
144  #endif  #endif
# Line 1953  static lispobj copy_large_unboxed_object Line 2006  static lispobj copy_large_unboxed_object
2006    
2007  #define DIRECT_SCAV 0  #define DIRECT_SCAV 0
2008    
2009  static void scavenge(lispobj *start, long nwords)  static void
2010    scavenge (lispobj *start, long nwords)
2011  {  {
2012    while (nwords > 0) {    while (nwords > 0)
2013      lispobj object;      {
2014      int words_scavenged;        lispobj object;
2015          int words_scavenged;
     object = *start;  
2016    
2017      gc_assert(object != 0x01); /* Not a forwarding pointer. */        object = *start;
2018          /* Not a forwarding pointer. */
2019          gc_assert (object != 0x01);
2020    
2021  #if DIRECT_SCAV  #if DIRECT_SCAV
2022      words_scavenged = (scavtab[TypeOf(object)])(start, object);        words_scavenged = scavtab[TypeOf (object)] (start, object);
2023  #else  #else  /* not DIRECT_SCAV */
2024      if (Pointerp(object))        if (Pointerp (object))
2025        /* It be a pointer. */          {
2026        if (from_space_p(object)) {  #ifdef GC_ASSERTIONS
2027          /*            check_escaped_stack_object (start, object);
2028           * It currently points to old space.  Check for a forwarding  #endif
2029           * pointer.  
2030           */            if (from_space_p (object))
2031          lispobj *ptr = (lispobj *) PTR(object);              {
2032          lispobj first_word = *ptr;                lispobj *ptr = (lispobj *) PTR (object);
2033                  lispobj first_word = *ptr;
2034    
2035          if(first_word == 0x01) {                if (first_word == 0x01)
2036            /* Yep, there be a forwarding pointer. */                  {
2037            *start = ptr[1];                    *start = ptr[1];
2038            words_scavenged = 1;                    words_scavenged = 1;
2039                    }
2040                  else
2041                    words_scavenged = scavtab[TypeOf (object)] (start, object);
2042                }
2043              else
2044                words_scavenged = 1;
2045          }          }
2046          else        else if ((object & 3) == 0)
           /* Scavenge that pointer. */  
           words_scavenged = (scavtab[TypeOf(object)])(start, object);  
       }  
       else  
         /* It points somewhere other than oldspace.  Leave it alone. */  
         words_scavenged = 1;  
     else  
       if ((object & 3) == 0)  
         /* It's a fixnum.  Real easy. */  
2047          words_scavenged = 1;          words_scavenged = 1;
2048        else        else
2049          /* It's some random header object. */          words_scavenged = scavtab[TypeOf (object)] (start, object);
2050          words_scavenged = (scavtab[TypeOf(object)])(start, object);  #endif /* not DIRECT_SCAV */
 #endif  
2051    
2052      start += words_scavenged;        start += words_scavenged;
2053      nwords -= words_scavenged;        nwords -= words_scavenged;
2054    }      }
2055    gc_assert(nwords == 0);  
2056      gc_assert (nwords == 0);
2057  }  }
2058    
2059    
# Line 2690  static int size_code_header(lispobj *whe Line 2743  static int size_code_header(lispobj *whe
2743          return nwords;          return nwords;
2744  }  }
2745    
2746    #ifndef i386
2747    
2748  static int scav_return_pc_header(lispobj *where, lispobj object)  static int scav_return_pc_header(lispobj *where, lispobj object)
2749  {  {
# Line 2701  static int scav_return_pc_header(lispobj Line 2755  static int scav_return_pc_header(lispobj
2755      return 0;      return 0;
2756  }  }
2757    
2758    #endif /* not i386 */
2759    
2760  static lispobj trans_return_pc_header(lispobj object)  static lispobj trans_return_pc_header(lispobj object)
2761  {  {
2762    struct function *return_pc;    struct function *return_pc;
# Line 2723  static lispobj trans_return_pc_header(li Line 2779  static lispobj trans_return_pc_header(li
2779   * the function object.   * the function object.
2780   */   */
2781  #ifdef i386  #ifdef i386
2782    
2783  static int scav_closure_header(lispobj *where, lispobj object)  static int scav_closure_header(lispobj *where, lispobj object)
2784  {  {
2785    struct closure *closure;    struct closure *closure;
# Line 2738  static int scav_closure_header(lispobj * Line 2795  static int scav_closure_header(lispobj *
2795    
2796    return 2;    return 2;
2797  }  }
2798  #endif  
2799    #endif /* i386 */
2800    
2801    #ifndef i386
2802    
2803  static int scav_function_header(lispobj *where, lispobj object)  static int scav_function_header(lispobj *where, lispobj object)
2804  {  {
# Line 2750  static int scav_function_header(lispobj Line 2810  static int scav_function_header(lispobj
2810      return 0;      return 0;
2811  }  }
2812    
2813    #endif /* not i386 */
2814    
2815  static lispobj trans_function_header(lispobj object)  static lispobj trans_function_header(lispobj object)
2816  {  {
2817    struct function *fheader;    struct function *fheader;
# Line 6099  static void write_protect_generation_pag Line 6161  static void write_protect_generation_pag
6161   * Garbage collect a generation. If raise is 0 the remains of the   * Garbage collect a generation. If raise is 0 the remains of the
6162   * generation are not raised to the next generation.   * generation are not raised to the next generation.
6163   */   */
6164  static void     garbage_collect_generation(int generation, int raise)  static void
6165    garbage_collect_generation (int generation, int raise)
6166  {  {
6167    unsigned long i;    unsigned long i;
6168    unsigned long read_only_space_size, static_space_size;    unsigned long read_only_space_size, static_space_size;
6169    
6170    #ifdef GC_ASSERTIONS
6171    #ifdef i386
6172      invalid_stack_start = (void *) CONTROL_STACK_START;
6173      invalid_stack_end = (void *) &raise;
6174    #else /* not i386 */
6175      invalid_stack_start = (void *) &raise;
6176      invalid_stack_end = (void *) CONTROL_STACK_END;
6177    #endif /* not i386 */
6178    #endif /* GC_ASSERTIONS */
6179    
6180    gc_assert(generation <= NUM_GENERATIONS - 1);    gc_assert(generation <= NUM_GENERATIONS - 1);
6181    
6182    /* The oldest generation can't be raised. */    /* The oldest generation can't be raised. */
# Line 6228  static void    garbage_collect_generation(i Line 6301  static void    garbage_collect_generation(i
6301  #endif  #endif
6302    
6303  #ifdef PRINTNOISE  #ifdef PRINTNOISE
6304      printf("Scavenging the binding stack (%d bytes) ...\n",    printf("Scavenging the binding stack (%d bytes) ...\n",
6305             ((lispobj *) get_binding_stack_pointer() - binding_stack) * sizeof(lispobj));           ((lispobj *) get_binding_stack_pointer() - binding_stack) * sizeof(lispobj));
6306  #endif  #endif
6307    /* Scavenge the binding stack. */    /* Scavenge the binding stack. */
6308    scavenge(binding_stack,    scavenge(binding_stack,
6309             (lispobj *) get_binding_stack_pointer() - binding_stack);             (lispobj *) get_binding_stack_pointer() - binding_stack);
6310    
6311  #ifdef PRINTNOISE  #ifdef PRINTNOISE
6312      printf("Done scavenging the binding stack.\n");    printf("Done scavenging the binding stack.\n");
6313  #endif  #endif
6314    /*    /*
6315     * Scavenge the scavenge_hooks in case this refers to a hook added     * Scavenge the scavenge_hooks in case this refers to a hook added
# Line 6246  static void    garbage_collect_generation(i Line 6319  static void    garbage_collect_generation(i
6319     */     */
6320    
6321  #ifdef PRINTNOISE  #ifdef PRINTNOISE
6322      printf("Scavenging the scavenger hooks ...\n");    printf("Scavenging the scavenger hooks ...\n");
6323  #endif  #endif
6324    scavenge((lispobj *) &scavenger_hooks, 1);    scavenge((lispobj *) &scavenger_hooks, 1);
6325  #ifdef PRINTNOISE  #ifdef PRINTNOISE
6326      printf("Done scavenging the scavenger hooks.\n");    printf("Done scavenging the scavenger hooks.\n");
6327  #endif  #endif
6328    
6329    if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) {    if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) {

Legend:
Removed from v.1.37  
changed lines
  Added in v.1.38

  ViewVC Help
Powered by ViewVC 1.1.5