/[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.27.2.1 by pmai, Fri Oct 4 23:14:04 2002 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>
17  #include <signal.h>  #include <signal.h>
18    #include <string.h>
19  #include "lisp.h"  #include "lisp.h"
20  #include "arch.h"  #include "arch.h"
21  #include "internals.h"  #include "internals.h"
# Line 24  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__)
39    
40  #if 0  #if (defined(i386) || defined(__x86_64))
41  #define gc_assert(ex) do { \  
42          if (!(ex)) gc_abort(); \  #define set_alloc_pointer(value) \
43  } while (0)    SetSymbolValue (ALLOCATION_POINTER, (value))
44    #define get_alloc_pointer() \
45      SymbolValue (ALLOCATION_POINTER)
46    #define get_binding_stack_pointer() \
47      SymbolValue (BINDING_STACK_POINTER)
48    #define get_pseudo_atomic_atomic() \
49      SymbolValue (PSEUDO_ATOMIC_ATOMIC)
50    #define set_pseudo_atomic_atomic() \
51      SetSymbolValue (PSEUDO_ATOMIC_ATOMIC, make_fixnum (1))
52    #define clr_pseudo_atomic_atomic() \
53      SetSymbolValue (PSEUDO_ATOMIC_ATOMIC, make_fixnum (0))
54    #define get_pseudo_atomic_interrupted() \
55      SymbolValue (PSEUDO_ATOMIC_INTERRUPTED)
56    #define clr_pseudo_atomic_interrupted() \
57      SetSymbolValue (PSEUDO_ATOMIC_INTERRUPTED, make_fixnum (0))
58    
59    #define set_current_region_free(value) \
60      SetSymbolValue(CURRENT_REGION_FREE_POINTER, (value))
61    #define set_current_region_end(value) \
62      SetSymbolValue(CURRENT_REGION_END_ADDR, (value))
63    #define get_current_region_free() \
64      SymbolValue(CURRENT_REGION_FREE_POINTER)
65    
66    #define set_current_region_end(value) \
67      SetSymbolValue(CURRENT_REGION_END_ADDR, (value))
68    
69    #elif defined(sparc)
70    
71    /*
72     * current_dynamic_space_free_pointer contains the pseudo-atomic
73     * stuff, so we need to preserve those bits when we give it a value.
74     * This value better not have any bits set there either!
75     */
76    
77    /*
78     * On sparc, we don't need to set the alloc_pointer in the code here
79     * because the alloc pointer (current_dynamic_space_free_pointer) is
80     * the same as *current-region-free-pointer* and is stored in
81     * alloc-tn.
82     */
83    #define set_alloc_pointer(value)
84    #define get_alloc_pointer() \
85      ((unsigned long) current_dynamic_space_free_pointer & ~lowtag_Mask)
86    #define get_binding_stack_pointer() \
87      (current_binding_stack_pointer)
88    #define get_pseudo_atomic_atomic() \
89      ((unsigned long)current_dynamic_space_free_pointer & pseudo_atomic_Value)
90    #define set_pseudo_atomic_atomic() \
91      (current_dynamic_space_free_pointer \
92       = (lispobj*) ((unsigned long)current_dynamic_space_free_pointer | pseudo_atomic_Value))
93    #define clr_pseudo_atomic_atomic() \
94      (current_dynamic_space_free_pointer \
95       = (lispobj*) ((unsigned long) current_dynamic_space_free_pointer & ~pseudo_atomic_Value))
96    #define get_pseudo_atomic_interrupted() \
97      ((unsigned long) current_dynamic_space_free_pointer & pseudo_atomic_InterruptedValue)
98    #define clr_pseudo_atomic_interrupted() \
99      (current_dynamic_space_free_pointer \
100       = (lispobj*) ((unsigned long) current_dynamic_space_free_pointer & ~pseudo_atomic_InterruptedValue))
101    
102    #define set_current_region_free(value) \
103      current_dynamic_space_free_pointer = (lispobj*)((value) | ((long)current_dynamic_space_free_pointer & lowtag_Mask))
104    
105    #define get_current_region_free() \
106      ((long)current_dynamic_space_free_pointer & (~(lowtag_Mask)))
107    
108    #define set_current_region_end(value) \
109      SetSymbolValue(CURRENT_REGION_END_ADDR, (value))
110    
111    #elif defined(DARWIN) && defined(__ppc__)
112    #ifndef pseudo_atomic_InterruptedValue
113    #define pseudo_atomic_InterruptedValue 1
114    #endif
115    #ifndef pseudo_atomic_Value
116    #define pseudo_atomic_Value 4
117    #endif
118    
119    #define set_alloc_pointer(value)
120    #define get_alloc_pointer() \
121      ((unsigned long) current_dynamic_space_free_pointer & ~lowtag_Mask)
122    #define get_binding_stack_pointer() \
123      (current_binding_stack_pointer)
124    #define get_pseudo_atomic_atomic() \
125      ((unsigned long)current_dynamic_space_free_pointer & pseudo_atomic_Value)
126    #define set_pseudo_atomic_atomic() \
127      (current_dynamic_space_free_pointer \
128       = (lispobj*) ((unsigned long)current_dynamic_space_free_pointer | pseudo_atomic_Value))
129    #define clr_pseudo_atomic_atomic() \
130      (current_dynamic_space_free_pointer \
131       = (lispobj*) ((unsigned long) current_dynamic_space_free_pointer & ~pseudo_atomic_Value))
132    #define get_pseudo_atomic_interrupted() \
133      ((unsigned long) current_dynamic_space_free_pointer & pseudo_atomic_InterruptedValue)
134    #define clr_pseudo_atomic_interrupted() \
135      (current_dynamic_space_free_pointer \
136       = (lispobj*) ((unsigned long) current_dynamic_space_free_pointer & ~pseudo_atomic_InterruptedValue))
137    
138    #define set_current_region_free(value) \
139      current_dynamic_space_free_pointer = (lispobj*)((value) | ((long)current_dynamic_space_free_pointer & lowtag_Mask))
140    
141    #define get_current_region_free() \
142      ((long)current_dynamic_space_free_pointer & (~(lowtag_Mask)))
143    
144    #define set_current_region_end(value) \
145      SetSymbolValue(CURRENT_REGION_END_ADDR, (value))
146    
147  #else  #else
148  #define gc_assert(ex)  #error gencgc is not supported on this platform
149    #endif
150    
151    /* Define for activating assertions.  */
152    
153    #if defined(x86) && defined(SOLARIS)
154    #define GC_ASSERTIONS 1
155    #endif
156    
157    /* Check for references to stack-allocated objects.  */
158    
159    #ifdef GC_ASSERTIONS
160    
161    static void *invalid_stack_start, *invalid_stack_end;
162    
163    static inline void
164    check_escaped_stack_object(lispobj * where, lispobj obj)
165    {
166    #if !defined(DARWIN) && !defined(__ppc__)
167        void *p;
168    
169        if (Pointerp(obj)
170            && (p = (void *) PTR(obj),
171                (p >= (void *) CONTROL_STACK_START
172                 && p < (void *) CONTROL_STACK_END))) {
173            char *space;
174    
175            if (where >= (lispobj *) DYNAMIC_0_SPACE_START
176                && where < (lispobj *) (DYNAMIC_0_SPACE_START + DYNAMIC_SPACE_SIZE))
177                space = "dynamic space";
178            else if (where >= (lispobj *) STATIC_SPACE_START
179                     && where <
180                     (lispobj *) (STATIC_SPACE_START + STATIC_SPACE_SIZE)) space =
181                    "static space";
182            else if (where >= (lispobj *) READ_ONLY_SPACE_START
183                     && where <
184                     (lispobj *) (READ_ONLY_SPACE_START +
185                                  READ_ONLY_SPACE_SIZE)) space = "read-only space";
186            else
187                space = NULL;
188    
189            /* GC itself uses some stack, so we can't tell exactly where the
190               invalid stack area starts.  Usually, it should be an error if a
191               reference to a stack-allocated object is found, although it
192               is valid to store a reference to a stack-allocated object
193               temporarily in another reachable object, as long as the
194               reference goes away at the end of a dynamic extent.  */
195    
196            if (p >= invalid_stack_start && p < invalid_stack_end)
197                lose("Escaped stack-allocated object 0x%08lx at %p in %s\n",
198                     (unsigned long) obj, where, space);
199    #ifndef i386
200            else if ((where >= (lispobj *) CONTROL_STACK_START
201                      && where < (lispobj *) (CONTROL_STACK_END))
202                     || (space == NULL)) {
203                /* Do nothing if it the reference is from the control stack,
204                   because that will happen, and that's ok.  Or if it's from
205                   an unknown space (typically from scavenging an interrupt
206                   context. */
207            }
208    #endif
209    
210            else
211                fprintf(stderr,
212                        "Reference to stack-allocated object 0x%08lx at %p in %s\n",
213                        (unsigned long) obj, where,
214                        space ? space : "Unknown space");
215        }
216  #endif  #endif
217    }
218    
219    #endif /* GC_ASSERTIONS */
220    
221    
222    #ifdef GC_ASSERTIONS
223    #define gc_assert(ex)           \
224      do {                          \
225        if (!(ex)) gc_abort ();     \
226      } while (0)
227    #else
228    #define gc_assert(ex)  (void) 0
229    #endif
230    
231    
232  /*  /*
233   * The number of generations, an extra is added to this for use as a temp.   * The number of generations, an extra is added to this for use as a temp.
234   */   */
# Line 48  Line 241 
241   * and only a few rare messages are printed at level 1.   * and only a few rare messages are printed at level 1.
242   */   */
243  unsigned gencgc_verbose = 0;  unsigned gencgc_verbose = 0;
244    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   */   */
256  #ifdef __NetBSD__  boolean enable_page_protection = TRUE;
 /* NetBSD on x86 has no way to retrieve the faulting address in the  
  * SIGSEGV handler, so for the moment we can't use page protection. */  
 boolean  enable_page_protection = FALSE;  
 #else  
 boolean  enable_page_protection = TRUE;  
 #endif  
257    
258  /*  /*
259   * Hunt for pointers to old-space, when GCing generations >= verify_gen.   * Hunt for pointers to old-space, when GCing generations >= verify_gen.
# Line 68  boolean  enable_page_protection = TRUE; Line 262  boolean  enable_page_protection = TRUE;
262  int verify_gens = NUM_GENERATIONS;  int verify_gens = NUM_GENERATIONS;
263    
264  /*  /*
265   * Enable a pre-scan verify of generation 0 before it's GCed.   * Enable a pre-scan verify of generation 0 before it's GCed.  (This
266     * makes GC very, very slow, so don't enable this unless you really
267     * need it!)
268   */   */
269  boolean pre_verify_gen_0 = FALSE;  boolean pre_verify_gen_0 = FALSE;
270    
271  /*  /*
272   * Enable checking for bad pointers after gc_free_heap called from purify.   * Enable checking for bad pointers after gc_free_heap called from purify.
273   */   */
274    #if 0 && defined(DARWIN)
275    boolean verify_after_free_heap = TRUE;
276    #else
277  boolean verify_after_free_heap = FALSE;  boolean verify_after_free_heap = FALSE;
278    #endif
279    
280  /*  /*
281   * 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
# Line 85  boolean verify_dynamic_code_check = FALS Line 285  boolean verify_dynamic_code_check = FALS
285    
286  /*  /*
287   * Enable the checking of code objects for fixup errors after they are   * Enable the checking of code objects for fixup errors after they are
288   * transported.   * transported.  (Only used for x86.)
289   */   */
290  boolean check_code_fixups = FALSE;  boolean check_code_fixups = FALSE;
291    
# Line 103  boolean gencgc_unmap_zero = TRUE; Line 303  boolean gencgc_unmap_zero = TRUE;
303  /*  /*
304   * Enable checking that newly allocated regions are zero filled.   * Enable checking that newly allocated regions are zero filled.
305   */   */
306    #if 0 && defined(DARWIN)
307    boolean gencgc_zero_check = TRUE;
308    boolean gencgc_enable_verify_zero_fill = TRUE;
309    #else
310  boolean gencgc_zero_check = FALSE;  boolean gencgc_zero_check = FALSE;
   
311  boolean gencgc_enable_verify_zero_fill = FALSE;  boolean gencgc_enable_verify_zero_fill = FALSE;
312    #endif
313    
314  /*  /*
315   * Enable checking that free pages are zero filled during gc_free_heap   * Enable checking that free pages are zero filled during gc_free_heap
316   * called after purify.   * called after purify.
317   */   */
318    #if 0 && defined(DARWIN)
319    boolean gencgc_zero_check_during_free_heap = TRUE;
320    #else
321  boolean gencgc_zero_check_during_free_heap = FALSE;  boolean gencgc_zero_check_during_free_heap = FALSE;
322    #endif
323    
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 124  unsigned large_object_size = 4 * PAGE_SI Line 332  unsigned large_object_size = 4 * PAGE_SI
332   * interrupt safety during object initialisation.   * interrupt safety during object initialisation.
333   */   */
334  boolean enable_pointer_filter = TRUE;  boolean enable_pointer_filter = TRUE;
   
335    
336    
337  /*  /*
338   * The total bytes allocated. Seen by (dynamic-usage)   * The total bytes allocated. Seen by (dynamic-usage)
339   */   */
340  unsigned long bytes_allocated = 0;  unsigned long bytes_allocated = 0;
341    
342  /*  /*
343     * The total amount of bytes ever allocated.  Not decreased by GC.
344     */
345    
346    volatile unsigned long long bytes_allocated_sum = 0;
347    
348    /*
349   * GC trigger; a value of 0xffffffff represents disabled.   * GC trigger; a value of 0xffffffff represents disabled.
350   */   */
351  unsigned long auto_gc_trigger = 0xffffffff;  unsigned long auto_gc_trigger = 0xffffffff;
352    
353  /*  /*
354     * Number of pages to reserve for heap overflow.  We want some space
355     * available on the heap when we are close to a heap overflow, so we
356     * can handle the overflow.  But how much do we really need?  I (rtoy)
357     * think 256 pages is probably a decent amount.  (That's 1 MB for x86,
358     * 2 MB for sparc, which has 8K pages.)
359     */
360    
361    unsigned long reserved_heap_pages = 256;
362    
363    /*
364   * The src. and dest. generations. Set before a GC starts scavenging.   * The src. and dest. generations. Set before a GC starts scavenging.
365   */   */
366  static int from_space;  static int from_space;
367  static int new_space;  static int new_space;
   
368    
369    
370  /*  /*
371   * GC structures and variables.   * GC structures and variables.
372   */   */
# Line 155  unsigned dynamic_space_pages; Line 379  unsigned dynamic_space_pages;
379    
380  /*  /*
381   * An array of page structures is statically allocated.   * An array of page structures is statically allocated.
382   * This helps quickly map between an address its page structure.   * This helps quickly map between an address and its page structure.
383   */   */
384  struct page *page_table;  struct page *page_table;
385    
386  /*  /*
387   * Heap base, needed for mapping addresses to page structures.   * Heap base, needed for mapping addresses to page structures.
388   */   */
389  static void *heap_base = NULL;  static char *heap_base = NULL;
390    
391  /*  /*
392   * Calculate the start address for the given page number.   * Calculate the start address for the given page number.
393   */   */
394  inline void *page_address(int page_num)  static char *
395    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 find_page_index(void *addr)  int
405    find_page_index(void *addr)
406  {  {
407    int index = 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    }      }
414    
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.
453   */   */
454  struct generation {  struct generation {
455    
456    /* The first page that gc_alloc checks on its next call. */      /* The first page that gc_alloc checks on its next call. */
457    int  alloc_start_page;      int alloc_start_page;
458    
459    /* The first page that gc_alloc_unboxed checks on its next call. */      /* The first page that gc_alloc_unboxed checks on its next call. */
460    int  alloc_unboxed_start_page;      int alloc_unboxed_start_page;
461    
462    /*      /*
463     * The first page that gc_alloc_large (boxed) considers on its next call.       * The first page that gc_alloc_large (boxed) considers on its next call.
464     * Although it always allocates after the boxed_region.       * Although it always allocates after the boxed_region.
465     */       */
466    int  alloc_large_start_page;      int alloc_large_start_page;
467    
468    /*      /*
469     * The first page that gc_alloc_large (unboxed) considers on its next call.       * The first page that gc_alloc_large (unboxed) considers on its next call.
470     * Although it always allocates after the current_unboxed_region.       * Although it always allocates after the current_unboxed_region.
471     */       */
472    int  alloc_large_unboxed_start_page;      int alloc_large_unboxed_start_page;
473    
474    /* The bytes allocate to this generation. */      /* The bytes allocate to this generation. */
475    int  bytes_allocated;      int bytes_allocated;
476    
477    /* The number of bytes at which to trigger a GC */      /* The number of bytes at which to trigger a GC */
478    int  gc_trigger;      int gc_trigger;
479    
480    /* To calculate a new level for gc_trigger */      /* To calculate a new level for gc_trigger */
481    int  bytes_consed_between_gc;      int bytes_consed_between_gc;
482    
483    /* The number of GCs since the last raise. */      /* The number of GCs since the last raise. */
484    int  num_gc;      int num_gc;
485    
486    /*      /*
487     * The average age at after which a GC will raise objects to the       * The average age at after which a GC will raise objects to the
488     * next generation.       * next generation.
489     */       */
490    int  trigger_age;      int trigger_age;
491    
492    /*      /*
493     * The cumulative sum of the bytes allocated to this generation. It       * The cumulative sum of the bytes allocated to this generation. It
494     * is cleared after a GC on this generations, and update before new       * is cleared after a GC on this generation, and update before new
495     * objects are added from a GC of a younger generation. Dividing by       * objects are added from a GC of a younger generation. Dividing by
496     * the bytes_allocated will give the average age of the memory in       * the bytes_allocated will give the average age of the memory in
497     * this generation since its last GC.       * this generation since its last GC.
498     */       */
499    int  cum_sum_bytes_allocated;      int cum_sum_bytes_allocated;
500    
501    /*      /*
502     * A minimum average memory age before a GC will occur helps prevent       * A minimum average memory age before a GC will occur helps prevent
503     * a GC when a large number of new live objects have been added, in       * a GC when a large number of new live objects have been added, in
504     * which case a GC could be a waste of time.       * which case a GC could be a waste of time.
505     */       */
506    double  min_av_mem_age;      double min_av_mem_age;
507  };  };
508    
509  /*  /*
# Line 260  static struct generation generations[NUM Line 518  static struct generation generations[NUM
518  */  */
519    
520  struct generation_stats {  struct generation_stats {
521    int  bytes_allocated;      int bytes_allocated;
522    int  gc_trigger;      int gc_trigger;
523    int  bytes_consed_between_gc;      int bytes_consed_between_gc;
524    int  num_gc;      int num_gc;
525    int  trigger_age;      int trigger_age;
526    int  cum_sum_bytes_allocated;      int cum_sum_bytes_allocated;
527    double  min_av_mem_age;      double min_av_mem_age;
528  };  };
529    
530    
531  /*  /*
532   * The oldest generation that will currently be GCed by default.   * The oldest generation that will currently be GCed by default.
# Line 284  struct generation_stats { Line 542  struct generation_stats {
542   * into an older generation so an unnecessary GC of this long-lived   * into an older generation so an unnecessary GC of this long-lived
543   * data can be avoided.   * data can be avoided.
544   */   */
545  unsigned int  gencgc_oldest_gen_to_gc = NUM_GENERATIONS - 1;  unsigned int gencgc_oldest_gen_to_gc = NUM_GENERATIONS - 1;
546    
547    
548  /*  /*
# Line 292  unsigned int  gencgc_oldest_gen_to_gc = Line 550  unsigned int  gencgc_oldest_gen_to_gc =
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.
565   */   */
# Line 304  static int  last_free_page; Line 567  static int  last_free_page;
567  /*  /*
568   * Count the number of write protected pages within the given generation.   * Count the number of write protected pages within the given generation.
569   */   */
570  static int count_write_protect_generation_pages(int generation)  static int
571    count_write_protect_generation_pages(int generation)
572  {  {
573    int i;      int i;
574    int cnt = 0;      int cnt = 0;
575    int mmask, mflags;      int mmask, mflags;
576    
577    mmask = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK      mmask = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK
578      | PAGE_GENERATION_MASK;          | PAGE_GENERATION_MASK;
579    mflags = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK | generation;      mflags = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK | generation;
580    
581    for (i = 0; i < last_free_page; i++)      for (i = 0; i < last_free_page; i++)
582      if (PAGE_FLAGS(i, mmask) == mflags)          if (PAGE_FLAGS(i, mmask) == mflags)
583        cnt++;              cnt++;
584    return cnt;      return cnt;
585  }  }
586    
587  /*  /*
588   * Count the number of pages within the given generation.   * Count the number of pages within the given generation.
589   */   */
590  static int count_generation_pages(int generation)  static int
591    count_generation_pages(int generation)
592  {  {
593    int i;      int i;
594    int cnt = 0;      int cnt = 0;
595    int mmask, mflags;      int mmask, mflags;
596    
597    mmask = PAGE_ALLOCATED_MASK | PAGE_GENERATION_MASK;      mmask = PAGE_ALLOCATED_MASK | PAGE_GENERATION_MASK;
598    mflags = PAGE_ALLOCATED_MASK | generation;      mflags = PAGE_ALLOCATED_MASK | generation;
599    
600    for (i = 0; i < last_free_page; i++)      for (i = 0; i < last_free_page; i++)
601      if (PAGE_FLAGS(i, mmask) == mflags)          if (PAGE_FLAGS(i, mmask) == mflags)
602        cnt++;              cnt++;
603    return cnt;      return cnt;
604  }  }
605    
606  /*  /*
607   * Count the number of dont_move pages.   * Count the number of dont_move pages.
608   */   */
609  static int count_dont_move_pages(void)  static int
610    count_dont_move_pages(void)
611  {  {
612    int i;      int i;
613    int cnt = 0;      int cnt = 0;
614    int mmask;      int mmask;
615    
616    mmask = PAGE_ALLOCATED_MASK | PAGE_DONT_MOVE_MASK;      mmask = PAGE_ALLOCATED_MASK | PAGE_DONT_MOVE_MASK;
617    
618    for (i = 0; i < last_free_page; i++)      for (i = 0; i < last_free_page; i++)
619      if (PAGE_FLAGS(i, mmask) == mmask)          if (PAGE_FLAGS(i, mmask) == mmask)
620        cnt++;              cnt++;
621    return cnt;      return cnt;
622  }  }
623    
624  /*  /*
625   * Work through the pages and add up the number of bytes used for the   * Work through the pages and add up the number of bytes used for the
626   * given generation.   * given generation.
627   */   */
628  static int generation_bytes_allocated (int generation)  #ifdef GC_ASSERTIONS
629    static int
630    generation_bytes_allocated(int generation)
631  {  {
632    int i;      int i;
633    int bytes_allocated = 0;      int bytes_allocated = 0;
634    int mmask, mflags;      int mmask, mflags;
635    
636    mmask = PAGE_ALLOCATED_MASK | PAGE_GENERATION_MASK;      mmask = PAGE_ALLOCATED_MASK | PAGE_GENERATION_MASK;
637    mflags = PAGE_ALLOCATED_MASK | generation;      mflags = PAGE_ALLOCATED_MASK | generation;
638    
639    for (i = 0; i < last_free_page; i++) {      for (i = 0; i < last_free_page; i++) {
640      if (PAGE_FLAGS(i, mmask) == mflags)          if (PAGE_FLAGS(i, mmask) == mflags)
641        bytes_allocated += page_table[i].bytes_used;              bytes_allocated += page_table[i].bytes_used;
642    }      }
643    return bytes_allocated;      return bytes_allocated;
644  }  }
645    #endif
646    
647  /*  /*
648   * Return the average age of the memory in a generation.   * Return the average age of the memory in a generation.
649   */   */
650  static double gen_av_mem_age(int gen)  static double
651    gen_av_mem_age(int gen)
652  {  {
653    if (generations[gen].bytes_allocated == 0)      if (generations[gen].bytes_allocated == 0)
654      return 0.0;          return 0.0;
655    
656    return (double) generations[gen].cum_sum_bytes_allocated /      return (double) generations[gen].cum_sum_bytes_allocated /
657                  (double) generations[gen].bytes_allocated;          (double) generations[gen].bytes_allocated;
658  }  }
659    
660  /*  /*
661   * The verbose argument controls how much to print out:   * The verbose argument controls how much to print out:
662   * 0 for normal level of detail; 1 for debugging.   * 0 for normal level of detail; 1 for debugging.
663   */   */
664  static void print_generation_stats(int  verbose)  void
665    print_generation_stats(int verbose)
666  {  {
667    int i, gens;      int i, gens;
   int fpu_state[27];  
668    
669    /*  #if defined(i386) || defined(__x86_64)
670     * This code uses the FP instructions which may be setup for Lisp so  #define FPU_STATE_SIZE 27
671     * they need to the saved and reset for C.      /*
672     */       * Need 512 byte area, aligned on a 16-byte boundary.  So allocate
673    fpu_save(fpu_state);       * 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];
678        int sse_state[SSE_STATE_SIZE];
679    
680        extern void sse_save(void *);
681        extern void sse_restore(void *);
682    #elif defined(sparc)
683        /*
684         * 32 (single-precision) FP registers, and the FP state register.
685         * But Sparc V9 has 32 double-precision registers (equivalent to 64
686         * single-precision, but can't be accessed), so we leave enough room
687         * for that.
688         */
689    #define FPU_STATE_SIZE (((32 + 32 + 1) + 1)/2)
690        long long fpu_state[FPU_STATE_SIZE];
691    #elif defined(DARWIN) && defined(__ppc__)
692    #define FPU_STATE_SIZE 32
693        long long fpu_state[FPU_STATE_SIZE];
694    #endif
695    
696    /* Number of generations to print out. */      /*
697    if (verbose)       * This code uses the FP instructions which may be setup for Lisp so
698      gens = NUM_GENERATIONS + 1;       * they need to the saved and reset for C.
699    else       */
     gens = NUM_GENERATIONS;  
700    
701    /* Print the heap stats */      fpu_save(fpu_state);
702    fprintf(stderr, "   Generation Boxed Unboxed LB   LUB    Alloc  Waste   Trig    WP  GCs Mem-age\n");  #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. */
709        if (verbose)
710            gens = NUM_GENERATIONS + 1;
711        else
712            gens = NUM_GENERATIONS;
713    
714    for (i = 0; i < gens; i++) {      /* Print the heap stats */
715      int j;      fprintf(stderr, "          Page count (%d KB)\n", GC_PAGE_SIZE / 1024);
716      int boxed_cnt = 0;      fprintf(stderr,
717      int unboxed_cnt = 0;              "   Gen  Boxed Unboxed  LB   LUB    Alloc    Waste    Trigger   WP  GCs Mem-age\n");
718      int large_boxed_cnt = 0;  
719      int large_unboxed_cnt = 0;      for (i = 0; i < gens; i++) {
720            int j;
721      for (j = 0; j < last_free_page; j++) {          int boxed_cnt = 0;
722        int flags = page_table[j].flags;          int unboxed_cnt = 0;
723        if ((flags & PAGE_GENERATION_MASK) == i) {          int large_boxed_cnt = 0;
724          if (flags & PAGE_ALLOCATED_MASK) {          int large_unboxed_cnt = 0;
725            /*  
726             * Count the number of boxed and unboxed pages within the          for (j = 0; j < last_free_page; j++) {
727             * given generation.              int flags = page_table[j].flags;
728             */  
729            if (flags & PAGE_UNBOXED_MASK)              if ((flags & PAGE_GENERATION_MASK) == i) {
730              if (flags & PAGE_LARGE_OBJECT_MASK)                  if (flags & PAGE_ALLOCATED_MASK) {
731                large_unboxed_cnt++;                      /*
732              else                       * Count the number of boxed and unboxed pages within the
733                unboxed_cnt++;                       * given generation.
734            else                       */
735              if (flags & PAGE_LARGE_OBJECT_MASK)                      if (flags & PAGE_UNBOXED_MASK)
736                large_boxed_cnt++;                          if (flags & PAGE_LARGE_OBJECT_MASK)
737              else                              large_unboxed_cnt++;
738                boxed_cnt++;                          else
739                                unboxed_cnt++;
740                        else if (flags & PAGE_LARGE_OBJECT_MASK)
741                            large_boxed_cnt++;
742                        else
743                            boxed_cnt++;
744                    }
745                }
746          }          }
       }  
     }  
747    
748      gc_assert(generations[i].bytes_allocated == generation_bytes_allocated(i));          gc_assert(generations[i].bytes_allocated ==
749      fprintf(stderr, "   %8d: %5d %5d %5d %5d %8d %5d %8d %4d %3d %7.4f\n",                    generation_bytes_allocated(i));
750              i, boxed_cnt, unboxed_cnt, large_boxed_cnt, large_unboxed_cnt,          fprintf(stderr, " %5d: %5d %5d %5d %5d %10d %6d %10d %4d %3d %7.4f\n",
751              generations[i].bytes_allocated,                  i, boxed_cnt, unboxed_cnt, large_boxed_cnt, large_unboxed_cnt,
752              PAGE_SIZE * count_generation_pages(i) -                  generations[i].bytes_allocated,
753              generations[i].bytes_allocated,                  GC_PAGE_SIZE * count_generation_pages(i) -
754              generations[i].gc_trigger,                  generations[i].bytes_allocated, generations[i].gc_trigger,
755              count_write_protect_generation_pages(i),                  count_write_protect_generation_pages(i), generations[i].num_gc,
756              generations[i].num_gc,                  gen_av_mem_age(i));
757              gen_av_mem_age(i));      }
758    }      fprintf(stderr, "   Total bytes alloc=%ld\n", bytes_allocated);
759    fprintf(stderr, "   Total bytes alloc=%d\n", bytes_allocated);  
760        fpu_restore(fpu_state);
761    fpu_restore(fpu_state);  #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
769     array.     array.
770  */  */
771  void get_generation_stats(int gen, struct generation_stats *stats)  void
772    get_generation_stats(int gen, struct generation_stats *stats)
773  {  {
774    if (gen <= NUM_GENERATIONS) {      if (gen <= NUM_GENERATIONS) {
775      stats->bytes_allocated = generations[gen].bytes_allocated;          stats->bytes_allocated = generations[gen].bytes_allocated;
776      stats->gc_trigger = generations[gen].gc_trigger;          stats->gc_trigger = generations[gen].gc_trigger;
777      stats->bytes_consed_between_gc = generations[gen].bytes_consed_between_gc;          stats->bytes_consed_between_gc =
778      stats->num_gc = generations[gen].num_gc;              generations[gen].bytes_consed_between_gc;
779      stats->trigger_age = generations[gen].trigger_age;          stats->num_gc = generations[gen].num_gc;
780      stats->cum_sum_bytes_allocated = generations[gen].cum_sum_bytes_allocated;          stats->trigger_age = generations[gen].trigger_age;
781      stats->min_av_mem_age = generations[gen].min_av_mem_age;          stats->cum_sum_bytes_allocated =
782    }              generations[gen].cum_sum_bytes_allocated;
783            stats->min_av_mem_age = generations[gen].min_av_mem_age;
784        }
785  }  }
786    
787  void set_gc_trigger(int gen, int trigger)  void
788    set_gc_trigger(int gen, int trigger)
789  {  {
790    if (gen <= NUM_GENERATIONS) {      if (gen <= NUM_GENERATIONS) {
791      generations[gen].gc_trigger = trigger;          generations[gen].gc_trigger = trigger;
792    }      }
793  }  }
794    
795  void set_trigger_age(int gen, int trigger_age)  void
796    set_trigger_age(int gen, int trigger_age)
797  {  {
798    if (gen <= NUM_GENERATIONS) {      if (gen <= NUM_GENERATIONS) {
799      generations[gen].trigger_age = trigger_age;          generations[gen].trigger_age = trigger_age;
800    }      }
801  }  }
802    
803  void set_min_mem_age(int gen, double min_mem_age)  void
804    set_min_mem_age(int gen, double min_mem_age)
805  {  {
806    if (gen <= NUM_GENERATIONS) {      if (gen <= NUM_GENERATIONS) {
807      generations[gen].min_av_mem_age = min_mem_age;          generations[gen].min_av_mem_age = min_mem_age;
808    }      }
809  }  }
810    
811  /*  /*
# Line 546  void set_min_mem_age(int gen, double min Line 861  void set_min_mem_age(int gen, double min
861   * Only using two regions at present, both are for the current   * Only using two regions at present, both are for the current
862   * newspace generation.   * newspace generation.
863   */   */
864  struct alloc_region  boxed_region;  struct alloc_region boxed_region;
865  struct alloc_region  unboxed_region;  struct alloc_region unboxed_region;
866    
867  #if 0  #if 0
868  /*  /*
# Line 558  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);
879    extern void do_dynamic_space_overflow_error(void);
880    
881    /* Handle heap overflow here, maybe. */
882    static void
883    handle_heap_overflow(const char *msg, int size)
884    {
885        unsigned long heap_size_mb;
886    
887        if (msg) {
888            fprintf(stderr, msg, size);
889        }
890    #ifndef SPARSE_BLOCK_SIZE
891    #define SPARSE_BLOCK_SIZE (0)
892    #endif
893    
894        /* Figure out how many MB of heap we have */
895        heap_size_mb = (dynamic_space_size + SPARSE_BLOCK_SIZE) >> 20;
896    
897        fprintf(stderr, " CMUCL has run out of dynamic heap space (%lu MB).\n",
898                heap_size_mb);
899        /* Try to handle heap overflow somewhat gracefully if we can. */
900    #if defined(trap_DynamicSpaceOverflow) || defined(FEATURE_HEAP_OVERFLOW_CHECK)
901        if (reserved_heap_pages == 0) {
902            fprintf(stderr, "\n Returning to top-level.\n");
903            do_dynamic_space_overflow_error();
904        } else {
905            fprintf(stderr,
906                    "  You can control heap size with the -dynamic-space-size commandline option.\n");
907            do_dynamic_space_overflow_warning();
908        }
909    #else
910        print_generation_stats(1);
911    
912        exit(1);
913    #endif
914    }
915    
916  /*  /*
917   * Find a new region with room for at least the given number of bytes.   * Find a new region with room for at least the given number of bytes.
# Line 584  static int  gc_alloc_generation; Line 937  static int  gc_alloc_generation;
937   * allocation call using the same pages, all the pages in the region   * allocation call using the same pages, all the pages in the region
938   * are allocated, although they will initially be empty.   * are allocated, although they will initially be empty.
939   */   */
940  static void gc_alloc_new_region(int nbytes, int unboxed,  static void
941                                  struct alloc_region *alloc_region)  gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region)
942  {  {
943    int first_page;      int first_page;
944    int last_page;      int last_page;
945    int region_size;      int region_size;
946    int restart_page;      int restart_page;
947    int bytes_found;      int bytes_found;
948    int num_pages;      int num_pages;
949    int i;      int i;
950    int mmask, mflags;      int mmask, mflags;
   
 #if 0  
   fprintf(stderr, "alloc_new_region for %d bytes from gen %d\n",  
           nbytes, gc_alloc_generation);  
 #endif  
   
   /* Check that the region is in a reset state. */  
   gc_assert(alloc_region->first_page == 0  
             && alloc_region->last_page == -1  
             && alloc_region->free_pointer == alloc_region->end_addr);  
   
   if (unboxed)  
     restart_page = generations[gc_alloc_generation].alloc_unboxed_start_page;  
   else  
     restart_page = generations[gc_alloc_generation].alloc_start_page;  
   
   /*  
    * Search for a contiguous free region of at least nbytes with the  
    * given properties: boxed/unboxed, generation. First setting up the  
    * mask and matching flags.  
    */  
   
   mmask = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK  
     | PAGE_LARGE_OBJECT_MASK | PAGE_DONT_MOVE_MASK  
     | PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK;  
   mflags = PAGE_ALLOCATED_MASK | (unboxed << PAGE_UNBOXED_SHIFT)  
     | gc_alloc_generation;  
   
   do {  
     first_page = restart_page;  
   
     /*  
      * First search for a page with at least 32 bytes free, that is  
      * not write protected, or marked dont_move.  
      */  
   
     while (first_page < dynamic_space_pages) {  
       int flags = page_table[first_page].flags;  
       if (!(flags & PAGE_ALLOCATED_MASK)  
           || ((flags & mmask) == mflags &&  
               page_table[first_page].bytes_used < PAGE_SIZE - 32))  
         break;  
       first_page++;  
     }  
   
     /* Check for a failure */  
     if (first_page >= dynamic_space_pages) {  
       fprintf(stderr, "*A2 gc_alloc_new_region failed, nbytes=%d.\n", nbytes);  
       print_generation_stats(1);  
       exit(1);  
     }  
951    
952      gc_assert(!PAGE_WRITE_PROTECTED(first_page));      /* Shut up some compiler warnings */
953        last_page = bytes_found = 0;
954    
955  #if 0  #if 0
956      fprintf(stderr, "  first_page=%d bytes_used=%d\n",      fprintf(stderr, "alloc_new_region for %d bytes from gen %d\n",
957              first_page, page_table[first_page].bytes_used);              nbytes, gc_alloc_generation);
958  #endif  #endif
959    
960        /* Check that the region is in a reset state. */
961        gc_assert(alloc_region->first_page == 0
962                  && alloc_region->last_page == -1
963                  && alloc_region->free_pointer == alloc_region->end_addr);
964    
965        if (unboxed)
966            restart_page =
967                generations[gc_alloc_generation].alloc_unboxed_start_page;
968        else
969            restart_page = generations[gc_alloc_generation].alloc_start_page;
970    
971      /*      /*
972       * Now search forward to calculate the available region size.  It       * Search for a contiguous free region of at least nbytes with the
973       * tries to keeps going until nbytes are found and the number of       * given properties: boxed/unboxed, generation. First setting up the
974       * pages is greater than some level. This helps keep down the       * mask and matching flags.
      * number of pages in a region.  
975       */       */
     last_page = first_page;  
     bytes_found = PAGE_SIZE - page_table[first_page].bytes_used;  
     num_pages = 1;  
     while ((bytes_found < nbytes || num_pages < 2)  
            && last_page < dynamic_space_pages - 1  
            && !PAGE_ALLOCATED(last_page + 1)) {  
       last_page++;  
       num_pages++;  
       bytes_found += PAGE_SIZE;  
       gc_assert(!PAGE_WRITE_PROTECTED(last_page));  
     }  
976    
977      region_size = (PAGE_SIZE - page_table[first_page].bytes_used)      mmask = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK
978        + PAGE_SIZE * (last_page - first_page);          | PAGE_LARGE_OBJECT_MASK | PAGE_DONT_MOVE_MASK
979            | PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK;
980        mflags = PAGE_ALLOCATED_MASK | (unboxed << PAGE_UNBOXED_SHIFT)
981            | gc_alloc_generation;
982    
983        do {
984            first_page = restart_page;
985    
986            /*
987             * First search for a page with at least 32 bytes free, that is
988             * not write protected, or marked dont_move.
989             */
990    
991            while (first_page < dynamic_space_pages) {
992                int flags = page_table[first_page].flags;
993    
994      gc_assert(bytes_found == region_size);              if (!(flags & PAGE_ALLOCATED_MASK)
995                    || ((flags & mmask) == mflags &&
996                        page_table[first_page].bytes_used < GC_PAGE_SIZE - 32))
997                    break;
998                first_page++;
999            }
1000    
1001            /* Check for a failure */
1002            if (first_page >= dynamic_space_pages - reserved_heap_pages) {
1003  #if 0  #if 0
1004      fprintf(stderr, "  last_page=%d bytes_found=%d num_pages=%d\n",              handle_heap_overflow("*A2 gc_alloc_new_region failed, nbytes=%d.\n",
1005              last_page, bytes_found, num_pages);                                   nbytes);
1006    #else
1007                break;
1008  #endif  #endif
1009            }
1010    
1011      restart_page = last_page + 1;          gc_assert(!PAGE_WRITE_PROTECTED(first_page));
   }  
   while (restart_page < dynamic_space_pages && bytes_found < nbytes);  
1012    
1013    /* Check for a failure */  #if 0
1014    if (restart_page >= dynamic_space_pages && bytes_found < nbytes) {          fprintf(stderr, "  first_page=%d bytes_used=%d\n",
1015      fprintf(stderr, "*A1 gc_alloc_new_region failed, nbytes=%d.\n", nbytes);                  first_page, page_table[first_page].bytes_used);
1016      print_generation_stats(1);  #endif
1017      exit(1);  
1018    }          /*
1019             * Now search forward to calculate the available region size.  It
1020             * tries to keeps going until nbytes are found and the number of
1021             * pages is greater than some level. This helps keep down the
1022             * number of pages in a region.
1023             */
1024            last_page = first_page;
1025            bytes_found = GC_PAGE_SIZE - page_table[first_page].bytes_used;
1026            num_pages = 1;
1027            while ((bytes_found < nbytes || num_pages < 2)
1028                   && last_page < dynamic_space_pages - 1
1029                   && !PAGE_ALLOCATED(last_page + 1)) {
1030                last_page++;
1031                num_pages++;
1032                bytes_found += GC_PAGE_SIZE;
1033                gc_assert(!PAGE_WRITE_PROTECTED(last_page));
1034            }
1035    
1036            region_size = (GC_PAGE_SIZE - page_table[first_page].bytes_used)
1037                + GC_PAGE_SIZE * (last_page - first_page);
1038    
1039            gc_assert(bytes_found == region_size);
1040    
1041  #if 0  #if 0
1042    fprintf(stderr, "gc_alloc_new_region gen %d: %d bytes: from pages %d to %d: addr=%x\n",          fprintf(stderr, "  last_page=%d bytes_found=%d num_pages=%d\n",
1043            gc_alloc_generation, bytes_found, first_page, last_page,                  last_page, bytes_found, num_pages);
1044            page_address(first_page));  #endif
 #endif  
   
   /* Setup the alloc_region. */  
   alloc_region->first_page = first_page;  
   alloc_region->last_page = last_page;  
   alloc_region->start_addr = page_table[first_page].bytes_used  
     + page_address(first_page);  
   alloc_region->free_pointer = alloc_region->start_addr;  
   alloc_region->end_addr = alloc_region->start_addr + bytes_found;  
   
   if (gencgc_zero_check) {  
     int *p;  
     for(p = (int *)alloc_region->start_addr;  
         p < (int *)alloc_region->end_addr; p++)  
       if (*p != 0)  
         fprintf(stderr, "** new region not zero @ %x\n",p);  
   }  
   
   /* Setup the pages. */  
   
   /* The first page may have already been in use. */  
   if (page_table[first_page].bytes_used == 0) {  
     PAGE_FLAGS_UPDATE(first_page, mmask, mflags);  
     page_table[first_page].first_object_offset = 0;  
   }  
   
   gc_assert(PAGE_ALLOCATED(first_page));  
   gc_assert(PAGE_UNBOXED_VAL(first_page) == unboxed);  
   gc_assert(PAGE_GENERATION(first_page) == gc_alloc_generation);  
   gc_assert(!PAGE_LARGE_OBJECT(first_page));  
   
   for (i = first_page + 1; i <= last_page; i++) {  
     PAGE_FLAGS_UPDATE(i, PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK  
                       | PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK,  
                       PAGE_ALLOCATED_MASK | (unboxed << PAGE_UNBOXED_SHIFT)  
                       | gc_alloc_generation);  
     /*  
      * This may not be necessary for unboxed regions (think it was  
      * broken before!)  
      */  
     page_table[i].first_object_offset =  
       alloc_region->start_addr - page_address(i);  
   }  
1045    
1046    /* Bump up the last_free_page */          restart_page = last_page + 1;
1047    if (last_page + 1 > last_free_page) {      }
1048      last_free_page = last_page + 1;      while (restart_page < dynamic_space_pages && bytes_found < nbytes);
1049      SetSymbolValue(ALLOCATION_POINTER,  
1050                     (lispobj) ((char *) heap_base +      if (first_page >= dynamic_space_pages - reserved_heap_pages) {
1051                                PAGE_SIZE * last_free_page));          handle_heap_overflow("*A2 gc_alloc_new_region failed, nbytes=%d.\n",
1052    }                               nbytes);
1053        }
1054    
1055        /* Check for a failure */
1056        if (restart_page >= (dynamic_space_pages - reserved_heap_pages)
1057            && bytes_found < nbytes) {
1058            handle_heap_overflow("*A1 gc_alloc_new_region failed, nbytes=%d.\n",
1059                                 nbytes);
1060        }
1061    #if 0
1062        fprintf(stderr,
1063                "gc_alloc_new_region gen %d: %d bytes: from pages %d to %d: addr=%x\n",
1064                gc_alloc_generation, bytes_found, first_page, last_page,
1065                page_address(first_page));
1066    #endif
1067    
1068        /* Setup the alloc_region. */
1069        alloc_region->first_page = first_page;
1070        alloc_region->last_page = last_page;
1071        alloc_region->start_addr = page_table[first_page].bytes_used
1072            + page_address(first_page);
1073        alloc_region->free_pointer = alloc_region->start_addr;
1074        alloc_region->end_addr = alloc_region->start_addr + bytes_found;
1075    
1076        if (gencgc_zero_check) {
1077            int *p;
1078    
1079            for (p = (int *) alloc_region->start_addr;
1080                 p < (int *) alloc_region->end_addr; p++)
1081                if (*p != 0)
1082                    fprintf(stderr, "** new region not zero @ %lx\n",
1083                            (unsigned long) p);
1084        }
1085    
1086        /* Setup the pages. */
1087    
1088        /* The first page may have already been in use. */
1089        if (page_table[first_page].bytes_used == 0) {
1090            PAGE_FLAGS_UPDATE(first_page, mmask, mflags);
1091            page_table[first_page].first_object_offset = 0;
1092        }
1093    
1094        gc_assert(PAGE_ALLOCATED(first_page));
1095        gc_assert(PAGE_UNBOXED_VAL(first_page) == unboxed);
1096        gc_assert(PAGE_GENERATION(first_page) == gc_alloc_generation);
1097        gc_assert(!PAGE_LARGE_OBJECT(first_page));
1098    
1099        for (i = first_page + 1; i <= last_page; i++) {
1100            PAGE_FLAGS_UPDATE(i, PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK
1101                              | PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK,
1102                              PAGE_ALLOCATED_MASK | (unboxed << PAGE_UNBOXED_SHIFT)
1103                              | gc_alloc_generation);
1104            /*
1105             * This may not be necessary for unboxed regions (think it was
1106             * broken before!)
1107             */
1108            page_table[i].first_object_offset =
1109                alloc_region->start_addr - page_address(i);
1110        }
1111    
1112        /* Bump up the last_free_page */
1113        if (last_page + 1 > last_free_page) {
1114            last_free_page = last_page + 1;
1115            set_alloc_pointer((lispobj) ((char *) heap_base +
1116                                         GC_PAGE_SIZE * last_free_page));
1117    
1118        }
1119  }  }
1120    
1121    
# Line 756  static void gc_alloc_new_region(int nbyt Line 1124  static void gc_alloc_new_region(int nbyt
1124   * If the record_new_objects flag is 2 then all new regions created   * If the record_new_objects flag is 2 then all new regions created
1125   * are recorded.   * are recorded.
1126   *   *
1127   * If it's 1 then then it is only recorded if the first page of the   * If it's 1 then it is only recorded if the first page of the
1128   * current region is <= new_areas_ignore_page. This helps avoid   * current region is <= new_areas_ignore_page. This helps avoid
1129   * unnecessary recording when doing full scavenge pass.   * unnecessary recording when doing full scavenge pass.
1130   *   *
# Line 774  static void gc_alloc_new_region(int nbyt Line 1142  static void gc_alloc_new_region(int nbyt
1142  static int record_new_objects = 0;  static int record_new_objects = 0;
1143  static int new_areas_ignore_page;  static int new_areas_ignore_page;
1144  struct new_area {  struct new_area {
1145    int  page;      int page;
1146    int  offset;      int offset;
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. */
1154  static void add_new_area(int first_page, int offset, int size)  static void
1155    add_new_area(int first_page, int offset, int size)
1156  {  {
1157    unsigned new_area_start,c;      unsigned new_area_start, c;
1158    int i;      int i;
1159    
1160    /* Ignore if full */      /* Ignore if full */
1161    if (new_areas_index >= NUM_NEW_AREAS)      if (new_areas_index >= NUM_NEW_AREAS)
1162      return;          return;
1163    
1164    switch (record_new_objects) {      switch (record_new_objects) {
1165    case 0:        case 0:
1166      return;            return;
1167    case 1:        case 1:
1168      if (first_page > new_areas_ignore_page)            if (first_page > new_areas_ignore_page)
1169        return;                return;
1170      break;            break;
1171    case 2:        case 2:
1172      break;            break;
1173    default:        default:
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
1181         * found this will save adding a new area.
1182         */
1183        for (i = new_areas_index - 1, c = 0; i >= 0 && c < 8; i--, c++) {
1184            unsigned area_end = GC_PAGE_SIZE * (*new_areas)[i].page
1185                + (*new_areas)[i].offset + (*new_areas)[i].size;
1186    
   /*  
    * Search backwards for a prior area that this follows from.  If  
    * found this will save adding a new area.  
    */  
   for (i = new_areas_index - 1, c = 0; i >= 0 && c < 8; i--, c++) {  
     unsigned area_end = PAGE_SIZE * (*new_areas)[i].page  
       + (*new_areas)[i].offset + (*new_areas)[i].size;  
1187  #if 0  #if 0
1188      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);
1189  #endif  #endif
1190      if (new_area_start == area_end) {          if (new_area_start == area_end) {
1191  #if 0  #if 0
1192        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",
1193                i, (*new_areas)[i].page, (*new_areas)[i].offset ,                      i, (*new_areas)[i].page, (*new_areas)[i].offset,
1194                (*new_areas)[i].size, first_page, offset, size);                      (*new_areas)[i].size, first_page, offset, size);
1195  #endif  #endif
1196        (*new_areas)[i].size += size;              (*new_areas)[i].size += size;
1197        return;              return;
1198            }
1199      }      }
   }  
1200  #if 0  #if 0
1201    fprintf(stderr, "*S1 %d %d %d\n",i,c,new_area_start);      fprintf(stderr, "*S1 %d %d %d\n", i, c, new_area_start);
1202  #endif  #endif
1203    
1204    (*new_areas)[new_areas_index].page = first_page;      (*new_areas)[new_areas_index].page = first_page;
1205    (*new_areas)[new_areas_index].offset = offset;      (*new_areas)[new_areas_index].offset = offset;
1206    (*new_areas)[new_areas_index].size = size;      (*new_areas)[new_areas_index].size = size;
1207  #if 0  #if 0
1208    fprintf(stderr, "  new_area %d page %d offset %d size %d\n",      fprintf(stderr, "  new_area %d page %d offset %d size %d\n",
1209            new_areas_index, first_page, offset, size);              new_areas_index, first_page, offset, size);
1210  #endif  #endif
1211    new_areas_index++;      new_areas_index++;
1212    
1213    /* Note the max new_areas used. */      /* Note the max new_areas used. */
1214    if (new_areas_index > max_new_areas)      if (new_areas_index > max_new_areas)
1215      max_new_areas = new_areas_index;          max_new_areas = new_areas_index;
1216  }  }
1217    
1218    
# Line 855  static void add_new_area(int first_page, Line 1225  static void add_new_area(int first_page,
1225   * it is safe to try and re-update the page table of this reset   * it is safe to try and re-update the page table of this reset
1226   * alloc_region.   * alloc_region.
1227   */   */
1228  void gc_alloc_update_page_tables(int unboxed,  void
1229                                   struct alloc_region *alloc_region)  gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region)
1230  {  {
1231    int more;      int more;
1232    int first_page;      int first_page;
1233    int next_page;      int next_page;
1234    int bytes_used;      int bytes_used;
1235    int orig_first_page_bytes_used;      int orig_first_page_bytes_used;
1236    int region_size;      int region_size;
1237    int byte_cnt;      int byte_cnt;
1238    
1239  #if 0  #if 0
1240    fprintf(stderr, "gc_alloc_update_page_tables to gen %d: ",      fprintf(stderr, "gc_alloc_update_page_tables to gen %d: ",
1241            gc_alloc_generation);              gc_alloc_generation);
1242  #endif  #endif
1243    
1244    first_page = alloc_region->first_page;      first_page = alloc_region->first_page;
1245    
1246    /* Catch an unused alloc_region. */      /* Catch an unused alloc_region. */
1247    if (first_page == 0 && alloc_region->last_page == -1)      if (first_page == 0 && alloc_region->last_page == -1)
1248      return;          return;
1249    
1250    next_page = first_page + 1;      next_page = first_page + 1;
1251    
1252    /* Skip if no bytes were allocated */      /* Skip if no bytes were allocated */
1253    if (alloc_region->free_pointer != alloc_region->start_addr) {      if (alloc_region->free_pointer != alloc_region->start_addr) {
1254      orig_first_page_bytes_used = page_table[first_page].bytes_used;          orig_first_page_bytes_used = page_table[first_page].bytes_used;
1255    
1256      gc_assert(alloc_region->start_addr == page_address(first_page) +          gc_assert(alloc_region->start_addr == page_address(first_page) +
1257                page_table[first_page].bytes_used);                    page_table[first_page].bytes_used);
1258    
1259      /* All the pages used need to be updated */          /* All the pages used need to be updated */
1260    
1261      /* Update the first page. */          /* Update the first page. */
1262    
1263  #if 0  #if 0
1264      fprintf(stderr, "0");          fprintf(stderr, "0");
1265  #endif  #endif
1266    
1267      /* If the page was free then setup the gen, and first_object_offset. */          /* If the page was free then setup the gen, and first_object_offset. */
1268      if (page_table[first_page].bytes_used == 0)          if (page_table[first_page].bytes_used == 0)
1269        gc_assert(page_table[first_page].first_object_offset == 0);              gc_assert(page_table[first_page].first_object_offset == 0);
1270    
1271      gc_assert(PAGE_ALLOCATED(first_page));          gc_assert(PAGE_ALLOCATED(first_page));
1272      gc_assert(PAGE_UNBOXED_VAL(first_page) == unboxed);          gc_assert(PAGE_UNBOXED_VAL(first_page) == unboxed);
1273      gc_assert(PAGE_GENERATION(first_page) == gc_alloc_generation);          gc_assert(PAGE_GENERATION(first_page) == gc_alloc_generation);
1274      gc_assert(!PAGE_LARGE_OBJECT(first_page));          gc_assert(!PAGE_LARGE_OBJECT(first_page));
1275    
1276      byte_cnt = 0;          byte_cnt = 0;
1277    
1278      /*          /*
1279       * Calc. the number of bytes used in this page. This is not always           * Calc. the number of bytes used in this page. This is not always
1280       * the number of new bytes, unless it was free.           * the number of new bytes, unless it was free.
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;
1289      byte_cnt += bytes_used;          byte_cnt += bytes_used;
1290    
1291      /*          /*
1292       * All the rest of the pages should be free. Need to set their           * All the rest of the pages should be free. Need to set their
1293       * first_object_offset pointer to the start of the region, and set           * first_object_offset pointer to the start of the region, and set
1294       * the bytes_used.           * the bytes_used.
1295       */           */
1296      while (more) {          while (more) {
1297  #if 0  #if 0
1298        fprintf(stderr, "+")              fprintf(stderr, "+");
1299  #endif  #endif
1300        gc_assert(PAGE_ALLOCATED(next_page));              gc_assert(PAGE_ALLOCATED(next_page));
1301        gc_assert(PAGE_UNBOXED_VAL(next_page) == unboxed);              gc_assert(PAGE_UNBOXED_VAL(next_page) == unboxed);
1302        gc_assert(page_table[next_page].bytes_used == 0);              gc_assert(page_table[next_page].bytes_used == 0);
1303        gc_assert(PAGE_GENERATION(next_page) == gc_alloc_generation);              gc_assert(PAGE_GENERATION(next_page) == gc_alloc_generation);
1304        gc_assert(!PAGE_LARGE_OBJECT(next_page));              gc_assert(!PAGE_LARGE_OBJECT(next_page));
1305    
1306        gc_assert(page_table[next_page].first_object_offset ==              gc_assert(page_table[next_page].first_object_offset ==
1307                  alloc_region->start_addr - page_address(next_page));                        alloc_region->start_addr - page_address(next_page));
1308    
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;
1317        byte_cnt += bytes_used;              byte_cnt += bytes_used;
1318    
1319        next_page++;              next_page++;
1320      }          }
1321    
1322      region_size = alloc_region->free_pointer - alloc_region->start_addr;          region_size = alloc_region->free_pointer - alloc_region->start_addr;
1323      bytes_allocated += region_size;          bytes_allocated += region_size;
1324      generations[gc_alloc_generation].bytes_allocated += region_size;          generations[gc_alloc_generation].bytes_allocated += region_size;
1325    
1326      gc_assert(byte_cnt - orig_first_page_bytes_used == region_size);          gc_assert(byte_cnt - orig_first_page_bytes_used == region_size);
1327    
1328      /*          /*
1329       * Set the generations alloc restart page to the last page of           * Set the generations alloc restart page to the last page of
1330       * the region.           * the region.
1331       */           */
1332      if (unboxed)          if (unboxed)
1333        generations[gc_alloc_generation].alloc_unboxed_start_page = next_page-1;              generations[gc_alloc_generation].alloc_unboxed_start_page =
1334      else                  next_page - 1;
1335        generations[gc_alloc_generation].alloc_start_page = next_page - 1;          else
1336                generations[gc_alloc_generation].alloc_start_page = next_page - 1;
1337    
1338      /* Add the region to the new_areas if requested. */          /* Add the region to the new_areas if requested. */
1339      if (!unboxed)          if (!unboxed)
1340        add_new_area(first_page, orig_first_page_bytes_used, region_size);              add_new_area(first_page, orig_first_page_bytes_used, region_size);
1341    
1342  #if 0  #if 0
1343      fprintf(stderr, "  gc_alloc_update_page_tables update %d bytes to gen %d\n",          fprintf(stderr,
1344              region_size, gc_alloc_generation);                  "  gc_alloc_update_page_tables update %d bytes to gen %d\n",
1345                    region_size, gc_alloc_generation);
1346  #endif  #endif
1347    }      } else
1348    else          /*
1349      /*           * No bytes allocated. Unallocate the first_page if there are 0 bytes_used.
1350       * No bytes allocated. Unallocate the first_page if there are 0 bytes_used.           */
      */  
1351      if (page_table[first_page].bytes_used == 0)      if (page_table[first_page].bytes_used == 0)
1352        page_table[first_page].flags &= ~PAGE_ALLOCATED_MASK;          page_table[first_page].flags &= ~PAGE_ALLOCATED_MASK;
1353    
1354    /* Unallocate any unused pages. */      /* Unallocate any unused pages. */
1355    while (next_page <= alloc_region->last_page) {      while (next_page <= alloc_region->last_page) {
1356      gc_assert(page_table[next_page].bytes_used == 0);          gc_assert(page_table[next_page].bytes_used == 0);
1357      page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK;          page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK;
1358      next_page++;          next_page++;
1359    }      }
1360    
1361    /* Reset the alloc_region. */      /* Reset the alloc_region. */
1362    alloc_region->first_page = 0;      alloc_region->first_page = 0;
1363    alloc_region->last_page = -1;      alloc_region->last_page = -1;
1364    alloc_region->start_addr = page_address(0);      alloc_region->start_addr = page_address(0);
1365    alloc_region->free_pointer = page_address(0);      alloc_region->free_pointer = page_address(0);
1366    alloc_region->end_addr = page_address(0);      alloc_region->end_addr = page_address(0);
1367    
1368  #if 0  #if 0
1369    fprintf(stderr, "\n");      fprintf(stderr, "\n");
1370  #endif  #endif
1371  }  }
1372    
# Line 1006  static inline void *gc_quick_alloc(int n Line 1377  static inline void *gc_quick_alloc(int n
1377  /*  /*
1378   * Allocate a possibly large object.   * Allocate a possibly large object.
1379   */   */
1380  static void *gc_alloc_large(int  nbytes, int unboxed,  static void *
1381                              struct alloc_region *alloc_region)  gc_alloc_large(int nbytes, int unboxed, struct alloc_region *alloc_region)
1382  {  {
1383    int first_page;      int first_page;
1384    int last_page;      int last_page;
1385    int region_size;      int region_size;
1386    int restart_page;      int restart_page;
1387    int bytes_found;      int bytes_found;
1388    int num_pages;      int num_pages;
1389    int orig_first_page_bytes_used;      int orig_first_page_bytes_used;
1390    int byte_cnt;      int byte_cnt;
1391    int more;      int more;
1392    int bytes_used;      int bytes_used;
1393    int next_page;      int next_page;
1394    int large = (nbytes >= large_object_size);      int large = (nbytes >= large_object_size);
1395    int mmask, mflags;      int mmask, mflags;
1396    
1397    
1398        /* Shut up some compiler warnings */
1399        last_page = bytes_found = 0;
1400    
1401  #if 0  #if 0
1402    if (nbytes > 200000)      if (nbytes > 200000)
1403      fprintf(stderr, "*** alloc_large %d\n", nbytes);          fprintf(stderr, "*** alloc_large %d\n", nbytes);
1404  #endif  #endif
1405    
1406  #if 0  #if 0
1407    fprintf(stderr, "gc_alloc_large for %d bytes from gen %d\n",      fprintf(stderr, "gc_alloc_large for %d bytes from gen %d\n",
1408            nbytes, gc_alloc_generation);              nbytes, gc_alloc_generation);
1409  #endif  #endif
1410    
1411    /*      /*
1412     * If the object is small, and there is room in the current region       * If the object is small, and there is room in the current region
1413     * then allocation it in the current region.       * then allocation it in the current region.
1414     */       */
1415    if (!large && alloc_region->end_addr - alloc_region->free_pointer >= nbytes)      if (!large && alloc_region->end_addr - alloc_region->free_pointer >= nbytes)
1416      return gc_quick_alloc(nbytes);          return gc_quick_alloc(nbytes);
1417    
1418    /*      /*
1419     * Search for a contiguous free region of at least nbytes. If it's a       * Search for a contiguous free region of at least nbytes. If it's a
1420     * large object then align it on a page boundary by searching for a       * large object then align it on a page boundary by searching for a
1421     * free page.       * free page.
1422     */       */
1423    
1424    /*      /*
1425     * To allow the allocation of small objects without the danger of       * To allow the allocation of small objects without the danger of
1426     * using a page in the current boxed region, the search starts after       * using a page in the current boxed region, the search starts after
1427     * the current boxed free region. XX could probably keep a page       * the current boxed free region. XX could probably keep a page
1428     * index ahead of the current region and bumped up here to save a       * index ahead of the current region and bumped up here to save a
1429     * lot of re-scanning.       * lot of re-scanning.
1430     */       */
1431    if (unboxed)      if (unboxed)
1432      restart_page = generations[gc_alloc_generation].alloc_large_unboxed_start_page;          restart_page =
1433    else              generations[gc_alloc_generation].alloc_large_unboxed_start_page;
1434      restart_page = generations[gc_alloc_generation].alloc_large_start_page;      else
1435    if (restart_page <= alloc_region->last_page)          restart_page = generations[gc_alloc_generation].alloc_large_start_page;
1436      restart_page = alloc_region->last_page + 1;      if (restart_page <= alloc_region->last_page)
1437            restart_page = alloc_region->last_page + 1;
1438    /* Setup the mask and matching flags. */  
1439        /* Setup the mask and matching flags. */
1440    mmask = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK  
1441      | PAGE_LARGE_OBJECT_MASK | PAGE_DONT_MOVE_MASK      mmask = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK
1442      | PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK;          | PAGE_LARGE_OBJECT_MASK | PAGE_DONT_MOVE_MASK
1443    mflags = PAGE_ALLOCATED_MASK | (unboxed << PAGE_UNBOXED_SHIFT)          | PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK;
1444      | gc_alloc_generation;      mflags = PAGE_ALLOCATED_MASK | (unboxed << PAGE_UNBOXED_SHIFT)
1445            | gc_alloc_generation;
1446    
1447    do {      do {
1448      first_page = restart_page;          first_page = restart_page;
1449    
1450      if (large)          if (large)
1451        while (first_page < dynamic_space_pages && PAGE_ALLOCATED(first_page))              while (first_page < dynamic_space_pages
1452          first_page++;                     && PAGE_ALLOCATED(first_page)) first_page++;
1453      else          else
1454        while (first_page < dynamic_space_pages) {              while (first_page < dynamic_space_pages) {
1455          int flags = page_table[first_page].flags;                  int flags = page_table[first_page].flags;
         if (!(flags & PAGE_ALLOCATED_MASK)  
             || ((flags & mmask) == mflags &&  
                 page_table[first_page].bytes_used < PAGE_SIZE - 32))  
           break;  
         first_page++;  
       }  
1456    
1457      /* Check for a failure */                  if (!(flags & PAGE_ALLOCATED_MASK)
1458      if (first_page >= dynamic_space_pages) {                      || ((flags & mmask) == mflags &&
1459        fprintf(stderr, "*A2 gc_alloc_large failed, nbytes=%d.\n", nbytes);                          page_table[first_page].bytes_used < GC_PAGE_SIZE - 32))
1460        print_generation_stats(1);                      break;
1461        exit(1);                  first_page++;
1462      }              }
1463    
1464      gc_assert(!PAGE_WRITE_PROTECTED(first_page));          /* Check for a failure */
1465            if (first_page >= dynamic_space_pages - reserved_heap_pages) {
1466    #if 0
1467                handle_heap_overflow("*A2 gc_alloc_large failed, nbytes=%d.\n",
1468                                     nbytes);
1469    #else
1470                break;
1471    #endif
1472            }
1473            gc_assert(!PAGE_WRITE_PROTECTED(first_page));
1474    
1475  #if 0  #if 0
1476      fprintf(stderr, "  first_page=%d bytes_used=%d\n",          fprintf(stderr, "  first_page=%d bytes_used=%d\n",
1477              first_page, page_table[first_page].bytes_used);                  first_page, page_table[first_page].bytes_used);
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    
1497  #if 0  #if 0
1498      fprintf(stderr, "  last_page=%d bytes_found=%d num_pages=%d\n",          fprintf(stderr, "  last_page=%d bytes_found=%d num_pages=%d\n",
1499              last_page, bytes_found, num_pages);                  last_page, bytes_found, num_pages);
1500  #endif  #endif
1501    
1502      restart_page = last_page + 1;          restart_page = last_page + 1;
1503    }      }
1504    while ((restart_page < dynamic_space_pages) && (bytes_found < nbytes));      while ((restart_page < dynamic_space_pages) && (bytes_found < nbytes));
1505    
1506    /* Check for a failure */      if (first_page >= dynamic_space_pages - reserved_heap_pages) {
1507    if (restart_page >= dynamic_space_pages && bytes_found < nbytes) {          handle_heap_overflow("*A2 gc_alloc_large failed, nbytes=%d.\n", nbytes);
1508      fprintf(stderr, "*A1 gc_alloc_large failed, nbytes=%d.\n", nbytes);      }
1509      print_generation_stats(1);  
1510      exit(1);      /* Check for a failure */
1511    }      if (restart_page >= (dynamic_space_pages - reserved_heap_pages)
1512            && bytes_found < nbytes) {
1513            handle_heap_overflow("*A1 gc_alloc_large failed, nbytes=%d.\n", nbytes);
1514        }
1515    #if 0
1516        if (large)
1517            fprintf(stderr,
1518                    "gc_alloc_large gen %d: %d of %d bytes: from pages %d to %d: addr=%x\n",
1519                    gc_alloc_generation, nbytes, bytes_found, first_page, last_page,
1520                    page_address(first_page));
1521    #endif
1522    
1523  #if 0      gc_assert(first_page > alloc_region->last_page);
1524    if (large)      if (unboxed)
1525      fprintf(stderr, "gc_alloc_large gen %d: %d of %d bytes: from pages %d to %d: addr=%x\n",          generations[gc_alloc_generation].alloc_large_unboxed_start_page =
1526              gc_alloc_generation, nbytes, bytes_found,              last_page;
1527              first_page, last_page, page_address(first_page));      else
1528  #endif          generations[gc_alloc_generation].alloc_large_start_page = last_page;
   
   gc_assert(first_page > alloc_region->last_page);  
   if (unboxed)  
     generations[gc_alloc_generation].alloc_large_unboxed_start_page =  
       last_page;  
   else  
     generations[gc_alloc_generation].alloc_large_start_page = last_page;  
1529    
1530    /* Setup the pages. */      /* Setup the pages. */
1531    orig_first_page_bytes_used = page_table[first_page].bytes_used;      orig_first_page_bytes_used = page_table[first_page].bytes_used;
1532    
1533    /*      /*
1534     * If the first page was free then setup the gen, and       * If the first page was free then setup the gen, and
1535     * first_object_offset.       * first_object_offset.
1536     */       */
1537    
1538        if (large)
1539            mflags |= PAGE_LARGE_OBJECT_MASK;
1540        if (page_table[first_page].bytes_used == 0) {
1541            PAGE_FLAGS_UPDATE(first_page, mmask, mflags);
1542            page_table[first_page].first_object_offset = 0;
1543        }
1544    
1545    if (large)      gc_assert(PAGE_ALLOCATED(first_page));
1546      mflags |= PAGE_LARGE_OBJECT_MASK;      gc_assert(PAGE_UNBOXED_VAL(first_page) == unboxed);
1547    if (page_table[first_page].bytes_used == 0) {      gc_assert(PAGE_GENERATION(first_page) == gc_alloc_generation);
1548      PAGE_FLAGS_UPDATE(first_page, mmask, mflags);      gc_assert(PAGE_LARGE_OBJECT_VAL(first_page) == large);
     page_table[first_page].first_object_offset = 0;  
   }  
   
   gc_assert(PAGE_ALLOCATED(first_page));  
   gc_assert(PAGE_UNBOXED_VAL(first_page) == unboxed);  
   gc_assert(PAGE_GENERATION(first_page) == gc_alloc_generation);  
   gc_assert(PAGE_LARGE_OBJECT_VAL(first_page) == large);  
1549    
1550    byte_cnt = 0;      byte_cnt = 0;
1551    
1552    /*      /*
1553     * Calc. the number of bytes used in this page. This is not       * Calc. the number of bytes used in this page. This is not
1554     * always the number of new bytes, unless it was free.       * always the number of new bytes, unless it was free.
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;
1563    byte_cnt += bytes_used;      byte_cnt += bytes_used;
1564    
1565    next_page = first_page + 1;      next_page = first_page + 1;
1566    
1567    /*      /*
1568     * All the rest of the pages should be free. Need to set their       * All the rest of the pages should be free. Need to set their
1569     * first_object_offset pointer to the start of the region, and set       * first_object_offset pointer to the start of the region, and set
1570     * the bytes_used.       * the bytes_used.
1571     */       */
1572    while (more) {      while (more) {
1573  #if 0  #if 0
1574      fprintf(stderr, "+");          fprintf(stderr, "+");
1575  #endif  #endif
1576    
1577      gc_assert(!PAGE_ALLOCATED(next_page));          gc_assert(!PAGE_ALLOCATED(next_page));
1578      gc_assert(page_table[next_page].bytes_used == 0);          gc_assert(page_table[next_page].bytes_used == 0);
1579      PAGE_FLAGS_UPDATE(next_page, mmask, mflags);          PAGE_FLAGS_UPDATE(next_page, mmask, mflags);
1580    
1581            page_table[next_page].first_object_offset =
1582                orig_first_page_bytes_used - GC_PAGE_SIZE * (next_page - first_page);
1583    
1584            /* Calc. the number of bytes used in this page. */
1585            more = 0;
1586            bytes_used = nbytes + orig_first_page_bytes_used - byte_cnt;
1587            if (bytes_used > GC_PAGE_SIZE) {
1588                bytes_used = GC_PAGE_SIZE;
1589                more = 1;
1590            }
1591            page_table[next_page].bytes_used = bytes_used;
1592            byte_cnt += bytes_used;
1593    
1594            next_page++;
1595        }
1596    
1597        gc_assert(byte_cnt - orig_first_page_bytes_used == nbytes);
1598    
1599      page_table[next_page].first_object_offset =      bytes_allocated += nbytes;
1600        orig_first_page_bytes_used - PAGE_SIZE * (next_page - first_page);      generations[gc_alloc_generation].bytes_allocated += nbytes;
1601    
1602      /* Calc. the number of bytes used in this page. */      /* Add the region to the new_areas if requested. */
1603      more = 0;      if (!unboxed)
1604      bytes_used = nbytes + orig_first_page_bytes_used - byte_cnt;          add_new_area(first_page, orig_first_page_bytes_used, nbytes);
1605      if (bytes_used > PAGE_SIZE) {  
1606        bytes_used = PAGE_SIZE;      /* Bump up the last_free_page */
1607        more = 1;      if (last_page + 1 > last_free_page) {
1608            last_free_page = last_page + 1;
1609            set_alloc_pointer((lispobj) ((char *) heap_base +
1610                                         GC_PAGE_SIZE * last_free_page));
1611      }      }
     page_table[next_page].bytes_used = bytes_used;  
     byte_cnt += bytes_used;  
1612    
1613      next_page++;      return (void *) (page_address(first_page) + orig_first_page_bytes_used);
1614    }  }
1615    
1616    gc_assert(byte_cnt - orig_first_page_bytes_used == nbytes);  /*
1617     * If the current region has more than this much space left, we don't
1618     * want to abandon the region (wasting space), but do a "large" alloc
1619     * to a new region.
1620     */
1621    
1622    bytes_allocated += nbytes;  int region_empty_threshold = 32;
   generations[gc_alloc_generation].bytes_allocated += nbytes;  
1623    
   /* Add the region to the new_areas if requested. */  
   if (!unboxed)  
     add_new_area(first_page, orig_first_page_bytes_used, nbytes);  
1624    
1625    /* Bump up the last_free_page */  /*
1626    if (last_page + 1 > last_free_page) {   * How many consecutive large alloc we can do before we abandon the
1627      last_free_page = last_page + 1;   * current region.
1628      SetSymbolValue(ALLOCATION_POINTER,   */
1629                     (lispobj) ((char *) heap_base +  int consecutive_large_alloc_limit = 10;
                               PAGE_SIZE * last_free_page));  
   }  
1630    
   return (void *) (page_address(first_page) + orig_first_page_bytes_used);  
 }  
1631    
1632  /*  /*
1633   * Allocate bytes from the boxed_region. It first checks if there is   * Statistics for the current region
  * room, if not then it calls gc_alloc_new_region to find a new region  
  * with enough space. A pointer to the start of the region is returned.  
1634   */   */
1635  static void *gc_alloc(int nbytes)  struct alloc_stats
1636  {  {
1637    void *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        /*
1650         * A copy of the current allocation region which we use to compare
1651         * 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. */
1677        new_free_pointer = region->free_pointer + nbytes;
1678    
1679        if (new_free_pointer <= region->end_addr) {
1680            /* If so then allocate from the current alloc region. */
1681            char *new_obj = region->free_pointer;
1682    
1683            region->free_pointer = new_free_pointer;
1684    
1685            /* Check if the alloc region is almost empty. */
1686            if (region->end_addr - region->free_pointer <= region_empty_threshold) {
1687                /* If so finished with the current region. */
1688                gc_alloc_update_page_tables(unboxed, region);
1689                /* Setup a new region. */
1690                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;
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  #if 0
1716    fprintf(stderr, "gc_alloc %d\n",nbytes);      fprintf(stderr, "gc_alloc %d\n", nbytes);
1717  #endif  #endif
1718    
1719    /* Check if there is room in the current alloc region. */      /* Check if there is room in the current alloc region. */
   new_free_pointer = boxed_region.free_pointer + nbytes;  
1720    
1721    if (new_free_pointer <= boxed_region.end_addr) {      new_obj = gc_alloc_try_current_region(nbytes, region, unboxed, stats);
1722      /* If so then allocate from the current alloc region. */      if (new_obj != (void *) -1) {
1723      void *new_obj = boxed_region.free_pointer;          return new_obj;
     boxed_region.free_pointer = new_free_pointer;  
   
     /* Check if the alloc region is almost empty. */  
     if (boxed_region.end_addr - boxed_region.free_pointer <= 32) {  
       /* If so 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);  
1724      }      }
     return (void *) new_obj;  
   }  
   
   /* Else not enough free space in the current region. */  
1725    
1726    /*      /* Else not enough free space in the current region. */
    * If there is a bit of room left in the current region then  
    * allocate a large object.  
    */  
   if (boxed_region.end_addr - boxed_region.free_pointer > 32)  
     return gc_alloc_large(nbytes, 0, &boxed_region);  
1727    
1728    /* Else find a new region. */      /*
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
1739         * allocate a large object.
1740         */
1741    
1742    /* Finished with the current region. */      /*
1743    gc_alloc_update_page_tables(0, &boxed_region);       * 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    /* Setup a new region. */      if ((region->end_addr - region->free_pointer > region_empty_threshold)
1765    gc_alloc_new_region(nbytes, 0, &boxed_region);          && (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    /* Should now be enough room. */      /*
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    /* Check if there is room in the current region. */      /* Finished with the current region. */
1791    new_free_pointer = boxed_region.free_pointer + nbytes;      gc_alloc_update_page_tables(unboxed, region);
1792    
1793    if (new_free_pointer <= boxed_region.end_addr) {      /* Setup a new region. */
1794      /* If so then allocate from the current region. */      gc_alloc_new_region(nbytes, unboxed, region);
     void *new_obj = boxed_region.free_pointer;  
     boxed_region.free_pointer = new_free_pointer;  
1795    
1796      /* Check if the current region is almost empty. */      /* Should now be enough room. */
     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);  
1797    
1798        /* Setup a new region. */      new_obj = gc_alloc_try_current_region(nbytes, region, unboxed, stats);
1799        gc_alloc_new_region(32, 0, &boxed_region);      if (new_obj != (void *) -1) {
1800            return new_obj;
1801      }      }
1802    
1803      return (void *) new_obj;      /* Shouldn't happen? */
1804    }      gc_assert(0);
1805        return 0;
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    /* Shouldn't happen? */      obj = gc_alloc_region(nbytes, &boxed_region, 0, &boxed_stats);
1819    gc_assert(0);  
1820        return obj;
1821  }  }
1822    
1823  /*  /*
# Line 1311  static void *gc_alloc(int nbytes) Line 1825  static void *gc_alloc(int nbytes)
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.
1827   */   */
1828  static inline void *gc_quick_alloc(int nbytes)  static inline void *
1829    gc_quick_alloc(int nbytes)
1830  {  {
1831    void *new_free_pointer;      char *new_free_pointer;
1832    
1833        /* Check if there is room in the current region. */
1834        new_free_pointer = boxed_region.free_pointer + nbytes;
1835    
1836    /* Check if there is room in the current region. */      if (new_free_pointer <= boxed_region.end_addr) {
1837    new_free_pointer = boxed_region.free_pointer + nbytes;          /* If so then allocate from the current region. */
1838            void *new_obj = boxed_region.free_pointer;
1839    
1840    if (new_free_pointer <= boxed_region.end_addr) {          boxed_region.free_pointer = new_free_pointer;
1841      /* If so then allocate from the current region. */          return (void *) new_obj;
1842      void  *new_obj = boxed_region.free_pointer;      }
     boxed_region.free_pointer = new_free_pointer;  
     return (void *) new_obj;  
   }  
1843    
1844    /* Else call gc_alloc */      /* Else call gc_alloc */
1845    return gc_alloc(nbytes);      return gc_alloc(nbytes);
1846  }  }
1847    
1848  /*  /*
# Line 1335  static inline void *gc_quick_alloc(int n Line 1851  static inline void *gc_quick_alloc(int n
1851   * not enough free space then call gc_alloc to do the job. A pointer   * not enough free space then call gc_alloc to do the job. A pointer
1852   * to the start of the region is returned.   * to the start of the region is returned.
1853   */   */
1854  static inline void *gc_quick_alloc_large(int nbytes)  static inline void *
1855  {  gc_quick_alloc_large(int nbytes)
   void *new_free_pointer;  
   
   if (nbytes >= large_object_size)  
     return gc_alloc_large(nbytes,0,&boxed_region);  
   
   /* Check if there is room in the current region. */  
   new_free_pointer = boxed_region.free_pointer + nbytes;  
   
   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;  
     return (void *) new_obj;  
   }  
   
   /* Else call gc_alloc */  
   return gc_alloc(nbytes);  
 }  
   
   
   
   
 static void *gc_alloc_unboxed(int nbytes)  
1856  {  {
1857    void *new_free_pointer;      char *new_free_pointer;
   
 #if 0  
   fprintf(stderr, "gc_alloc_unboxed %d\n",nbytes);  
 #endif  
1858    
1859    /* Check if there is room in the current region. */      if (nbytes >= large_object_size)
1860    new_free_pointer = unboxed_region.free_pointer + nbytes;          return gc_alloc_large(nbytes, 0, &boxed_region);
1861    
1862    if (new_free_pointer <= unboxed_region.end_addr) {      /* Check if there is room in the current region. */
1863      /* If so then allocate from the current region. */      new_free_pointer = boxed_region.free_pointer + nbytes;
     void *new_obj = unboxed_region.free_pointer;  
     unboxed_region.free_pointer = new_free_pointer;  
1864    
1865      /* Check if the current region is almost empty. */      if (new_free_pointer <= boxed_region.end_addr) {
1866      if ((unboxed_region.end_addr - unboxed_region.free_pointer) <= 32) {          /* If so then allocate from the current region. */
1867        /* If so finished with the current region. */          void *new_obj = boxed_region.free_pointer;
       gc_alloc_update_page_tables(1, &unboxed_region);  
1868    
1869        /* Setup a new region. */          boxed_region.free_pointer = new_free_pointer;
1870        gc_alloc_new_region(32, 1, &unboxed_region);          return (void *) new_obj;
1871      }      }
1872    
1873      return (void *) new_obj;      /* Else call gc_alloc */
1874    }      return gc_alloc(nbytes);
1875    }
   /* Else not enough free space in the current region. */  
   
   /*  
    * 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. */  
   
   /* 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 find, finished with the current region. */  
       gc_alloc_update_page_tables(1, &unboxed_region);  
1876    
1877        /* Setup a new region. */  static inline void *
1878        gc_alloc_new_region(32, 1, &unboxed_region);  gc_alloc_unboxed(int nbytes)
1879      }  {
1880        void *obj;
1881    
1882      return (void *) new_obj;      obj = gc_alloc_region(nbytes, &unboxed_region, 1, &unboxed_stats);
   }  
1883    
1884    /* Shouldn't happen? */      return obj;
   gc_assert(0);  
1885  }  }
1886    
1887  static inline void *gc_quick_alloc_unboxed(int nbytes)  static inline void *
1888    gc_quick_alloc_unboxed(int nbytes)
1889  {  {
1890    void *new_free_pointer;      char *new_free_pointer;
1891    
1892        /* Check if there is room in the current region. */
1893        new_free_pointer = unboxed_region.free_pointer + nbytes;
1894    
1895    /* Check if there is room in the current region. */      if (new_free_pointer <= unboxed_region.end_addr) {
1896    new_free_pointer = unboxed_region.free_pointer + nbytes;          /* If so then allocate from the current region. */
1897            void *new_obj = unboxed_region.free_pointer;
1898    
1899    if (new_free_pointer <= unboxed_region.end_addr) {          unboxed_region.free_pointer = new_free_pointer;
     /* If so then allocate from the current region. */  
     void *new_obj = unboxed_region.free_pointer;  
     unboxed_region.free_pointer = new_free_pointer;  
1900    
1901      return (void *) new_obj;          return (void *) new_obj;
1902      }      }
1903    
1904    /* Else call gc_alloc */      /* Else call gc_alloc */
1905    return gc_alloc_unboxed(nbytes);      return gc_alloc_unboxed(nbytes);
1906  }  }
1907    
1908  /*  /*
# Line 1456  static inline void *gc_quick_alloc_unbox Line 1912  static inline void *gc_quick_alloc_unbox
1912   *   *
1913   * A pointer to the start of the region is returned.   * A pointer to the start of the region is returned.
1914   */   */
1915  static inline void *gc_quick_alloc_large_unboxed(int nbytes)  static inline void *
1916    gc_quick_alloc_large_unboxed(int nbytes)
1917  {  {
1918    void *new_free_pointer;      char *new_free_pointer;
1919    
1920        if (nbytes >= large_object_size)
1921            return gc_alloc_large(nbytes, 1, &unboxed_region);
1922    
1923    if (nbytes >= large_object_size)      /* Check if there is room in the current region. */
1924      return gc_alloc_large(nbytes,1,&unboxed_region);      new_free_pointer = unboxed_region.free_pointer + nbytes;
1925    
1926    /* Check if there is room in the current region. */      if (new_free_pointer <= unboxed_region.end_addr) {
1927    new_free_pointer = unboxed_region.free_pointer + nbytes;          /* If so then allocate from the current region. */
1928            void *new_obj = unboxed_region.free_pointer;
1929    
1930    if (new_free_pointer <= unboxed_region.end_addr) {          unboxed_region.free_pointer = new_free_pointer;
     /* If so then allocate from the current region. */  
     void *new_obj = unboxed_region.free_pointer;  
     unboxed_region.free_pointer = new_free_pointer;  
1931    
1932      return (void *) new_obj;          return (void *) new_obj;
1933    }      }
1934    
1935    /* Else call gc_alloc */      /* Else call gc_alloc */
1936    return gc_alloc_unboxed(nbytes);      return gc_alloc_unboxed(nbytes);
1937  }  }
1938    
1939  /***************************************************************************/  /***************************************************************************/
   
1940    
1941    
1942  /* Scavenging/transporting routines derived from gc.c */  /* Scavenging/transporting routines derived from gc.c */
1943    
1944  static int (*scavtab[256])(lispobj *where, lispobj object);  static int (*scavtab[256]) (lispobj * where, lispobj object);
1945  static lispobj (*transother[256])(lispobj object);  static lispobj(*transother[256]) (lispobj object);
1946  static int (*sizetab[256])(lispobj *where);  static int (*sizetab[256]) (lispobj * where);
1947    
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    
1955  /* Predicates */  /* Predicates */
1956    
1957  static inline boolean from_space_p(lispobj obj)  static inline boolean
1958    from_space_p(lispobj obj)
1959  {  {
1960    int page_index = (void*) obj - heap_base;      int page_index = (char *) obj - heap_base;
   return page_index >= 0  
     && (page_index = (unsigned int) page_index / PAGE_SIZE) < dynamic_space_pages  
     && PAGE_GENERATION(page_index) == from_space;  
 }  
1961    
1962  static inline boolean new_space_p(lispobj obj)      return page_index >= 0
1963  {          && (page_index =
1964    int page_index = (void*) obj - heap_base;              (unsigned int) page_index / GC_PAGE_SIZE) < dynamic_space_pages
1965    return page_index >= 0          && PAGE_GENERATION(page_index) == from_space;
     && (page_index = (unsigned int) page_index / PAGE_SIZE) < dynamic_space_pages  
     && PAGE_GENERATION(page_index) == new_space;  
1966  }  }
1967    
1968    static inline boolean
1969  /* Copying Objects */  new_space_p(lispobj obj)
1970    {
1971        int page_index = (char *) obj - heap_base;
1972    
1973        return page_index >= 0
1974            && (page_index =
1975                (unsigned int) page_index / GC_PAGE_SIZE) < dynamic_space_pages
1976            && PAGE_GENERATION(page_index) == new_space;
1977    }
1978    
1979  /* Copying Boxed Objects */  static inline boolean
1980  static inline lispobj copy_object(lispobj object, int nwords)  dynamic_space_p(lispobj obj)
1981  {  {
1982    int tag;      lispobj end = DYNAMIC_0_SPACE_START + DYNAMIC_SPACE_SIZE;
   lispobj *new;  
   lispobj *source, *dest;  
   
   gc_assert(Pointerp(object));  
   gc_assert(from_space_p(object));  
   gc_assert((nwords & 0x01) == 0);  
   
   /* get tag of object */  
   tag = LowtagOf(object);  
   
   /* allocate space */  
   new = gc_quick_alloc(nwords*4);  
   
   dest = new;  
   source = (lispobj *) PTR(object);  
   
   /* copy the object */  
   while (nwords > 0) {  
     dest[0] = source[0];  
     dest[1] = source[1];  
     dest += 2;  
     source += 2;  
     nwords -= 2;  
   }  
1983    
1984    /* return lisp pointer of new object */      return (obj >= DYNAMIC_0_SPACE_START) && (obj < end);
   return (lispobj) new | tag;  
1985  }  }
1986    
1987  /*  static inline boolean
1988   * Copying Large Boxed Objects. If the object is in a large object  static_space_p(lispobj obj)
  * region then it is simply promoted, else it is copied. If it's large  
  * enough then it's copied to a large object region.  
  *  
  * Vectors may have shrunk. If the object is not copied the space  
  * needs to be reclaimed, and the page_tables corrected.  
  */  
 static lispobj copy_large_object(lispobj object, int nwords)  
1989  {  {
1990    int tag;      lispobj end = SymbolValue(STATIC_SPACE_FREE_POINTER);
   lispobj *new;  
   lispobj *source, *dest;  
   int first_page;  
   
   gc_assert(Pointerp(object));  
   gc_assert(from_space_p(object));  
   gc_assert((nwords & 0x01) == 0);  
   
   if (gencgc_verbose && nwords > 1024 * 1024)  
     fprintf(stderr, "** copy_large_object: %d\n", nwords * 4);  
   
   /* Check if it's a large object. */  
   first_page = find_page_index((void *) object);  
   gc_assert(first_page >= 0);  
1991    
1992    if (PAGE_LARGE_OBJECT(first_page)) {      return (obj >= STATIC_SPACE_START) && (obj < end);
1993      /* Promote the object. */  }
     int remaining_bytes;  
     int next_page;  
     int bytes_freed;  
     int old_bytes_used;  
     int mmask, mflags;  
1994    
1995      /*  static inline boolean
1996       * Note: Any page write protection must be removed, else a later  read_only_space_p(lispobj obj)
1997       * scavenge_newspace may incorrectly not scavenge these pages.  {
1998       * This would not be necessary if they are added to the new areas,      lispobj end = SymbolValue(READ_ONLY_SPACE_FREE_POINTER);
      * but lets do it for them all (they'll probably be written  
      * anyway?).  
      */  
1999    
2000      gc_assert(page_table[first_page].first_object_offset == 0);      return (obj >= READ_ONLY_SPACE_START) && (obj < end);
2001    }
2002    
2003      next_page = first_page;  static inline boolean
2004      remaining_bytes = nwords * 4;  control_stack_space_p(lispobj obj)
2005      while (remaining_bytes > PAGE_SIZE) {  {
2006        gc_assert(PAGE_GENERATION(next_page) == from_space);      lispobj end = CONTROL_STACK_START + CONTROL_STACK_SIZE;
       gc_assert(PAGE_ALLOCATED(next_page));  
       gc_assert(!PAGE_UNBOXED(next_page));  
       gc_assert(PAGE_LARGE_OBJECT(next_page));  
       gc_assert(page_table[next_page].first_object_offset ==  
                 PAGE_SIZE * (first_page - next_page));  
       gc_assert(page_table[next_page].bytes_used == PAGE_SIZE);  
   
       PAGE_FLAGS_UPDATE(next_page, PAGE_GENERATION_MASK, new_space);  
   
       /*  
        * Remove any write protection.  Should be able to religh on the  
        * WP flag to avoid redundant calls.  
        */  
       if (PAGE_WRITE_PROTECTED(next_page)) {  
         os_protect(page_address(next_page), PAGE_SIZE, OS_VM_PROT_ALL);  
         page_table[next_page].flags &= ~PAGE_WRITE_PROTECTED_MASK;  
       }  
       remaining_bytes -= PAGE_SIZE;  
       next_page++;  
     }  
2007    
2008      /*      return (obj >= CONTROL_STACK_START) && (obj < end);
2009       * Now only one page remains, but the object may have shrunk so  }
      * there may be more unused pages which will be freed.  
      */  
2010    
2011      /* Object may have shrunk but shouldn't have grown - check. */  static inline boolean
2012      gc_assert(page_table[next_page].bytes_used >= remaining_bytes);  binding_stack_space_p(lispobj obj)
2013    {
2014        lispobj end = BINDING_STACK_START + BINDING_STACK_SIZE;
2015    
2016      PAGE_FLAGS_UPDATE(next_page, PAGE_GENERATION_MASK, new_space);      return (obj >= BINDING_STACK_START) && (obj < end);
2017      gc_assert(PAGE_ALLOCATED(next_page));  }
2018      gc_assert(!PAGE_UNBOXED(next_page));  
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      /* Adjust the bytes_used. */      return (obj >= SIGNAL_STACK_START) && (obj < end);
2026      old_bytes_used = page_table[next_page].bytes_used;  #else
2027      page_table[next_page].bytes_used = remaining_bytes;      return FALSE;
2028    #endif
2029    }
2030    
2031      bytes_freed = old_bytes_used - remaining_bytes;  #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      mmask = PAGE_ALLOCATED_MASK | PAGE_UNBOXED_MASK | PAGE_LARGE_OBJECT_MASK  /*
2047        | PAGE_GENERATION_MASK;   * Other random places that can't be in malloc space.  Return TRUE if
2048      mflags = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK | from_space;   * obj is in some other known space
2049     */
2050      /* Free any remaining pages; needs care. */  static inline boolean
2051      next_page++;  other_space_p(lispobj obj)
2052      while (old_bytes_used == PAGE_SIZE &&  {
2053             PAGE_FLAGS(next_page, mmask) == mflags &&      boolean in_space = FALSE;
2054             page_table[next_page].first_object_offset == PAGE_SIZE * (first_page  
2055                                                                       - next_page)) {  #if defined(sparc)
2056        /*      extern char _end;
2057         * Checks out OK, free the page. Don't need to both zeroing  
2058         * pages as this should have been done before shrinking the      /*
2059         * object. These pages shouldn't be write protected as they       * Skip over any objects in the C runtime which includes the
2060         * should be zero filled.       * 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        gc_assert(!PAGE_WRITE_PROTECTED(next_page));       * don't know what that is.  I think that's probably all for
2063         * sparc.
2064        old_bytes_used = page_table[next_page].bytes_used;       */
2065        page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK;      if ((char*) obj <= &_end) {
2066        page_table[next_page].bytes_used = 0;          in_space = TRUE;
       bytes_freed += old_bytes_used;  
       next_page++;  
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      if (gencgc_verbose && bytes_freed > 0)      return in_space;
2084        fprintf(stderr, "* copy_large_boxed bytes_freed %d\n", bytes_freed);  }
2085    
2086      generations[from_space].bytes_allocated -= 4 * nwords + bytes_freed;  
     generations[new_space].bytes_allocated += 4 * nwords;  
     bytes_allocated -= bytes_freed;  
2087    
2088      /* Add the region to the new_areas if requested. */  /* Copying Objects */
2089      add_new_area(first_page, 0, nwords * 4);  
2090    
2091    /* Copying Boxed Objects */
2092    static inline lispobj
2093    copy_object(lispobj object, int nwords)
2094    {
2095        int tag;
2096        lispobj *new;
2097        lispobj *source, *dest;
2098    
2099        gc_assert(Pointerp(object));
2100        gc_assert(from_space_p(object));
2101        gc_assert((nwords & 0x01) == 0);
2102    
     return object;  
   }  
   else {  
2103      /* get tag of object */      /* get tag of object */
2104      tag = LowtagOf(object);      tag = LowtagOf(object);
2105    
2106      /* allocate space */      /* allocate space */
2107      new = gc_quick_alloc_large(nwords * 4);      new = gc_quick_alloc(nwords * sizeof(lispobj));
2108    
2109      dest = new;      dest = new;
2110      source = (lispobj *) PTR(object);      source = (lispobj *) PTR(object);
2111    
2112      /* copy the object */      /* copy the object */
2113      while (nwords > 0) {      while (nwords > 0) {
2114        dest[0] = source[0];          dest[0] = source[0];
2115        dest[1] = source[1];          dest[1] = source[1];
2116        dest += 2;          dest += 2;
2117        source += 2;          source += 2;
2118        nwords -= 2;          nwords -= 2;
2119      }      }
2120    
2121      /* return lisp pointer of new object */      /* return lisp pointer of new object */
2122      return (lispobj) new | tag;      return (lispobj) new | tag;
   }  
2123  }  }
2124    
 /* Copying UnBoxed Objects. */  
 static inline lispobj copy_unboxed_object(lispobj object, int nwords)  
 {  
   int tag;  
   lispobj *new;  
   lispobj *source, *dest;  
   
   gc_assert(Pointerp(object));  
   gc_assert(from_space_p(object));  
   gc_assert((nwords & 0x01) == 0);  
   
   /* get tag of object */  
   tag = LowtagOf(object);  
   
   /* allocate space */  
   new = gc_quick_alloc_unboxed(nwords*4);  
   
   dest = new;  
   source = (lispobj *) PTR(object);  
   
   /* Copy the object */  
   while (nwords > 0) {  
     dest[0] = source[0];  
     dest[1] = source[1];  
     dest += 2;  
     source += 2;  
     nwords -= 2;  
   }  
   
   /* Return lisp pointer of new object. */  
   return (lispobj) new | tag;  
 }  
   
   
2125  /*  /*
2126   * Copying Large Unboxed Objects. If the object is in a large object   * Copying Large Boxed Objects. If the object is in a large object
2127   * region then it is simply promoted, else it is copied. If it's large   * region then it is simply promoted, else it is copied. If it's large
2128   * enough then it's copied to a large object region.   * enough then it's copied to a large object region.
2129   *   *
2130   * Bignums and vectors may have shrunk. If the object is not copied   * Vectors may have shrunk. If the object is not copied the space
2131   * the space needs to be reclaimed, and the page_tables corrected.   * needs to be reclaimed, and the page_tables corrected.
2132   */   */
2133  static lispobj copy_large_unboxed_object(lispobj object, int nwords)  static lispobj
2134    copy_large_object(lispobj object, int nwords)
2135  {  {
2136    int tag;      int tag;
2137    lispobj *new;      lispobj *new;
2138    lispobj *source, *dest;      lispobj *source, *dest;
2139    int first_page;      int first_page;
2140    
2141        gc_assert(Pointerp(object));
2142        gc_assert(from_space_p(object));
2143        gc_assert((nwords & 0x01) == 0);
2144    
2145        if (gencgc_verbose && nwords > 1024 * 1024)
2146            fprintf(stderr, "** copy_large_object: %lu\n",
2147                    (unsigned long) (nwords * sizeof(lispobj)));
2148    
2149        /* Check if it's a large object. */
2150        first_page = find_page_index((void *) object);
2151        gc_assert(first_page >= 0);
2152    
2153        if (PAGE_LARGE_OBJECT(first_page)) {
2154            /* Promote the object. */
2155            int remaining_bytes;
2156            int next_page;
2157            int bytes_freed;
2158            int old_bytes_used;
2159            int mmask, mflags;
2160    
2161    gc_assert(Pointerp(object));          /*
2162    gc_assert(from_space_p(object));           * Note: Any page write protection must be removed, else a later
2163    gc_assert((nwords & 0x01) == 0);           * scavenge_newspace may incorrectly not scavenge these pages.
2164             * This would not be necessary if they are added to the new areas,
2165             * but lets do it for them all (they'll probably be written
2166             * anyway?).
2167             */
2168    
2169    if (gencgc_verbose && nwords > 1024 * 1024)          gc_assert(page_table[first_page].first_object_offset == 0);
     fprintf(stderr, "** copy_large_unboxed_object: %d\n", nwords * 4);  
2170    
2171    /* Check if it's a large object. */          next_page = first_page;
2172    first_page = find_page_index((void *) object);          remaining_bytes = nwords * sizeof(lispobj);
2173    gc_assert(first_page >= 0);          while (remaining_bytes > GC_PAGE_SIZE) {
2174                gc_assert(PAGE_GENERATION(next_page) == from_space);
2175                gc_assert(PAGE_ALLOCATED(next_page));
2176                gc_assert(!PAGE_UNBOXED(next_page));
2177                gc_assert(PAGE_LARGE_OBJECT(next_page));
2178                gc_assert(page_table[next_page].first_object_offset ==
2179                          GC_PAGE_SIZE * (first_page - next_page));
2180                gc_assert(page_table[next_page].bytes_used == GC_PAGE_SIZE);
2181    
2182    if (PAGE_LARGE_OBJECT(first_page)) {              PAGE_FLAGS_UPDATE(next_page, PAGE_GENERATION_MASK, new_space);
     /*  
      * Promote the object. Note: Unboxed objects may have been  
      * allocated to a BOXED region so it may be necessary to change  
      * the region to UNBOXED.  
      */  
     int remaining_bytes;  
     int next_page;  
     int bytes_freed;  
     int old_bytes_used;  
     int mmask, mflags;  
2183    
2184      gc_assert(page_table[first_page].first_object_offset == 0);              /*
2185                 * Remove any write protection.  Should be able to religh on the
2186                 * WP flag to avoid redundant calls.
2187                 */
2188                if (PAGE_WRITE_PROTECTED(next_page)) {
2189                    os_protect((os_vm_address_t) page_address(next_page), GC_PAGE_SIZE,
2190                               OS_VM_PROT_ALL);
2191                    page_table[next_page].flags &= ~PAGE_WRITE_PROTECTED_MASK;
2192                }
2193                remaining_bytes -= GC_PAGE_SIZE;
2194                next_page++;
2195            }
2196    
2197      next_page = first_page;          /*
2198      remaining_bytes = nwords * 4;           * Now only one page remains, but the object may have shrunk so
2199      while (remaining_bytes > PAGE_SIZE) {           * there may be more unused pages which will be freed.
2200        gc_assert(PAGE_GENERATION(next_page) == from_space);           */
       gc_assert(PAGE_ALLOCATED(next_page));  
       gc_assert(PAGE_LARGE_OBJECT(next_page));  
       gc_assert(page_table[next_page].first_object_offset ==  
                 PAGE_SIZE * (first_page - next_page));  
       gc_assert(page_table[next_page].bytes_used == PAGE_SIZE);  
   
       PAGE_FLAGS_UPDATE(next_page, PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK,  
                         PAGE_UNBOXED_MASK | new_space);  
       remaining_bytes -= PAGE_SIZE;  
       next_page++;  
     }  
2201    
2202      /*          /* Object may have shrunk but shouldn't have grown - check. */
2203       * Now only one page remains, but the object may have shrunk so          gc_assert(page_table[next_page].bytes_used >= remaining_bytes);
      * there may be more unused pages which will be freed.  
      */  
2204    
2205      /* Object may have shrunk but shouldn't have grown - check. */          PAGE_FLAGS_UPDATE(next_page, PAGE_GENERATION_MASK, new_space);
2206      gc_assert(page_table[next_page].bytes_used >= remaining_bytes);          gc_assert(PAGE_ALLOCATED(next_page));
2207            gc_assert(!PAGE_UNBOXED(next_page));
2208    
2209            /* Adjust the bytes_used. */
2210            old_bytes_used = page_table[next_page].bytes_used;
2211            page_table[next_page].bytes_used = remaining_bytes;
2212    
2213            bytes_freed = old_bytes_used - remaining_bytes;
2214    
2215            mmask = PAGE_ALLOCATED_MASK | PAGE_UNBOXED_MASK | PAGE_LARGE_OBJECT_MASK
2216                | PAGE_GENERATION_MASK;
2217            mflags = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK | from_space;
2218    
2219            /* Free any remaining pages; needs care. */
2220            next_page++;
2221            while (old_bytes_used == GC_PAGE_SIZE &&
2222                   PAGE_FLAGS(next_page, mmask) == mflags &&
2223                   page_table[next_page].first_object_offset ==
2224                   GC_PAGE_SIZE * (first_page - next_page)) {
2225                /*
2226                 * Checks out OK, free the page. Don't need to both zeroing
2227                 * pages as this should have been done before shrinking the
2228                 * object. These pages shouldn't be write protected as they
2229                 * should be zero filled.
2230                 */
2231                gc_assert(!PAGE_WRITE_PROTECTED(next_page));
2232    
2233      PAGE_FLAGS_UPDATE(next_page, PAGE_ALLOCATED_MASK | PAGE_UNBOXED_MASK              old_bytes_used = page_table[next_page].bytes_used;
2234                        | PAGE_GENERATION_MASK,              page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK;
2235                        PAGE_ALLOCATED_MASK | PAGE_UNBOXED_MASK | new_space);              page_table[next_page].bytes_used = 0;
2236                bytes_freed += old_bytes_used;
2237                next_page++;
2238            }
2239    
2240      /* Adjust the bytes_used. */          if (gencgc_verbose && bytes_freed > 0)
2241      old_bytes_used = page_table[next_page].bytes_used;              fprintf(stderr, "* copy_large_boxed bytes_freed %d\n", bytes_freed);
     page_table[next_page].bytes_used = remaining_bytes;  
2242    
2243      bytes_freed = old_bytes_used - remaining_bytes;          generations[from_space].bytes_allocated -=
2244                sizeof(lispobj) * nwords + bytes_freed;
2245            generations[new_space].bytes_allocated += sizeof(lispobj) * nwords;
2246            bytes_allocated -= bytes_freed;
2247    
2248      mmask = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK          /* Add the region to the new_areas if requested. */
2249        | PAGE_GENERATION_MASK;          add_new_area(first_page, 0, nwords * sizeof(lispobj));
     mflags = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK | from_space;  
2250    
2251      /* Free any remaining pages; needs care. */          return object;
2252      next_page++;      } else {
2253      while (old_bytes_used == PAGE_SIZE &&          /* get tag of object */
2254             PAGE_FLAGS(next_page, mmask) == mflags &&          tag = LowtagOf(object);
            page_table[next_page].first_object_offset == PAGE_SIZE * (first_page  
                                                                      - next_page)) {  
       /*  
        * Checks out OK, free the page. Don't need to both zeroing  
        * pages as this should have been done before shrinking the  
        * object. These pages shouldn't be write protected, even if  
        * boxed they should be zero filled.  
        */  
       gc_assert(!PAGE_WRITE_PROTECTED(next_page));  
   
       old_bytes_used = page_table[next_page].bytes_used;  
       page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK;  
       page_table[next_page].bytes_used = 0;  
       bytes_freed += old_bytes_used;  
       next_page++;  
     }  
2255    
2256      if (gencgc_verbose && bytes_freed > 0)          /* allocate space */
2257        fprintf(stderr, "* copy_large_unboxed bytes_freed %d\n", bytes_freed);          new = gc_quick_alloc_large(nwords * sizeof(lispobj));
2258    
2259      generations[from_space].bytes_allocated -= 4 * nwords + bytes_freed;          dest = new;
2260      generations[new_space].bytes_allocated += 4 * nwords;          source = (lispobj *) PTR(object);
2261      bytes_allocated -= bytes_freed;  
2262            /* copy the object */
2263            while (nwords > 0) {
2264                dest[0] = source[0];
2265                dest[1] = source[1];
2266                dest += 2;
2267                source += 2;
2268                nwords -= 2;
2269            }
2270    
2271            /* return lisp pointer of new object */
2272            return (lispobj) new | tag;
2273        }
2274    }
2275    
2276    /* Copying UnBoxed Objects. */
2277    static inline lispobj
2278    copy_unboxed_object(lispobj object, int nwords)
2279    {
2280        int tag;
2281        lispobj *new;
2282        lispobj *source, *dest;
2283    
2284        gc_assert(Pointerp(object));
2285        gc_assert(from_space_p(object));
2286        gc_assert((nwords & 0x01) == 0);
2287    
     return object;  
   }  
   else {  
2288      /* get tag of object */      /* get tag of object */
2289      tag = LowtagOf(object);      tag = LowtagOf(object);
2290    
2291      /* allocate space */      /* allocate space */
2292      new = gc_quick_alloc_large_unboxed(nwords * 4);      new = gc_quick_alloc_unboxed(nwords * sizeof(lispobj));
2293    
2294      dest = new;      dest = new;
2295      source = (lispobj *) PTR(object);      source = (lispobj *) PTR(object);
2296    
2297      /* copy the object */      /* Copy the object */
2298      while (nwords > 0) {      while (nwords > 0) {
2299        dest[0] = source[0];          dest[0] = source[0];
2300        dest[1] = source[1];          dest[1] = source[1];
2301        dest += 2;          dest += 2;
2302        source += 2;          source += 2;
2303        nwords -= 2;          nwords -= 2;
2304      }      }
2305    
2306      /* return lisp pointer of new object */      /* Return lisp pointer of new object. */
2307      return (lispobj) new | tag;      return (lispobj) new | tag;
2308    }  }
2309    
2310    
2311    /*
2312     * Copying Large Unboxed Objects. If the object is in a large object
2313     * region then it is simply promoted, else it is copied. If it's large
2314     * enough then it's copied to a large object region.
2315     *
2316     * Bignums and vectors may have shrunk. If the object is not copied
2317     * the space needs to be reclaimed, and the page_tables corrected.
2318     */
2319    static lispobj
2320    copy_large_unboxed_object(lispobj object, int nwords)
2321    {
2322        int tag;
2323        lispobj *new;
2324        lispobj *source, *dest;
2325        int first_page;
2326    
2327        gc_assert(Pointerp(object));
2328        gc_assert(from_space_p(object));
2329        gc_assert((nwords & 0x01) == 0);
2330    
2331        if (gencgc_verbose && nwords > 1024 * 1024)
2332            fprintf(stderr, "** copy_large_unboxed_object: %lu\n",
2333                    (unsigned long) (nwords * sizeof(lispobj)));
2334    
2335        /* Check if it's a large object. */
2336        first_page = find_page_index((void *) object);
2337        gc_assert(first_page >= 0);
2338    
2339        if (PAGE_LARGE_OBJECT(first_page)) {
2340            /*
2341             * Promote the object. Note: Unboxed objects may have been
2342             * allocated to a BOXED region so it may be necessary to change
2343             * the region to UNBOXED.
2344             */
2345            int remaining_bytes;
2346            int next_page;
2347            int bytes_freed;
2348            int old_bytes_used;
2349            int mmask, mflags;
2350    
2351            gc_assert(page_table[first_page].first_object_offset == 0);
2352    
2353            next_page = first_page;
2354            remaining_bytes = nwords * sizeof(lispobj);
2355            while (remaining_bytes > GC_PAGE_SIZE) {
2356                gc_assert(PAGE_GENERATION(next_page) == from_space);
2357                gc_assert(PAGE_ALLOCATED(next_page));
2358                gc_assert(PAGE_LARGE_OBJECT(next_page));
2359                gc_assert(page_table[next_page].first_object_offset ==
2360                          GC_PAGE_SIZE * (first_page - next_page));
2361                gc_assert(page_table[next_page].bytes_used == GC_PAGE_SIZE);
2362    
2363                PAGE_FLAGS_UPDATE(next_page,
2364                                  PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK,
2365                                  PAGE_UNBOXED_MASK | new_space);
2366                remaining_bytes -= GC_PAGE_SIZE;
2367                next_page++;
2368            }
2369    
2370            /*
2371             * Now only one page remains, but the object may have shrunk so
2372             * there may be more unused pages which will be freed.
2373             */
2374    
2375            /* Object may have shrunk but shouldn't have grown - check. */
2376            gc_assert(page_table[next_page].bytes_used >= remaining_bytes);
2377    
2378            PAGE_FLAGS_UPDATE(next_page, PAGE_ALLOCATED_MASK | PAGE_UNBOXED_MASK
2379                              | PAGE_GENERATION_MASK,
2380                              PAGE_ALLOCATED_MASK | PAGE_UNBOXED_MASK | new_space);
2381    
2382            /* Adjust the bytes_used. */
2383            old_bytes_used = page_table[next_page].bytes_used;
2384            page_table[next_page].bytes_used = remaining_bytes;
2385    
2386            bytes_freed = old_bytes_used - remaining_bytes;
2387    
2388            mmask = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK
2389                | PAGE_GENERATION_MASK;
2390            mflags = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK | from_space;
2391    
2392            /* Free any remaining pages; needs care. */
2393            next_page++;
2394            while (old_bytes_used == GC_PAGE_SIZE &&
2395                   PAGE_FLAGS(next_page, mmask) == mflags &&
2396                   page_table[next_page].first_object_offset ==
2397                   GC_PAGE_SIZE * (first_page - next_page)) {
2398                /*
2399                 * Checks out OK, free the page. Don't need to both zeroing
2400                 * pages as this should have been done before shrinking the
2401                 * object. These pages shouldn't be write protected, even if
2402                 * boxed they should be zero filled.
2403                 */
2404                gc_assert(!PAGE_WRITE_PROTECTED(next_page));
2405    
2406                old_bytes_used = page_table[next_page].bytes_used;
2407                page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK;
2408                page_table[next_page].bytes_used = 0;
2409                bytes_freed += old_bytes_used;
2410                next_page++;
2411            }
2412    
2413            if (gencgc_verbose && bytes_freed > 0)
2414                fprintf(stderr, "* copy_large_unboxed bytes_freed %d\n",
2415                        bytes_freed);
2416    
2417            generations[from_space].bytes_allocated -=
2418                sizeof(lispobj) * nwords + bytes_freed;
2419            generations[new_space].bytes_allocated += sizeof(lispobj) * nwords;
2420            bytes_allocated -= bytes_freed;
2421    
2422            return object;
2423        } else {
2424            /* get tag of object */
2425            tag = LowtagOf(object);
2426    
2427            /* allocate space */
2428            new = gc_quick_alloc_large_unboxed(nwords * sizeof(lispobj));
2429    
2430            dest = new;
2431            source = (lispobj *) PTR(object);
2432    
2433            /* copy the object */
2434            while (nwords > 0) {
2435                dest[0] = source[0];
2436                dest[1] = source[1];
2437                dest += 2;
2438                source += 2;
2439                nwords -= 2;
2440            }
2441    
2442            /* return lisp pointer of new object */
2443            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 */
2495    
2496    /*
2497     * Douglas Crosher says:
2498     *
2499     * There were two different ways in which the scavenger dispatched,
2500     * and DIRECT_SCAV was one option.  This code did work at one stage
2501     * but testing showed it to be slower.  When DIRECT_SCAV is enabled
2502     * the scavenger dispatches via the scavtab for all objects, and when
2503     * disabled the scavenger firstly detects and handles some common
2504     * cases itself before dispatching.
2505     */
2506    
2507  #define DIRECT_SCAV 0  #define DIRECT_SCAV 0
2508    
2509  static void scavenge(lispobj *start, long nwords)  static void
2510    scavenge(void *start_obj, long nwords)
2511  {  {
2512    while (nwords > 0) {      lispobj *start;
     lispobj object;  
     int words_scavenged;  
2513    
2514      object = *start;      start = (lispobj *) start_obj;
2515    
2516      gc_assert(object != 0x01); /* Not a forwarding pointer. */      while (nwords > 0) {
2517            lispobj object;
2518            int words_scavenged;
2519    
2520  #if DIRECT_SCAV          object = *start;
2521      words_scavenged = (scavtab[TypeOf(object)])(start, object);          /* Not a forwarding pointer. */
2522  #else          gc_assert(object != 0x01);
     if (Pointerp(object))  
       /* It be a pointer. */  
       if (from_space_p(object)) {  
         /*  
          * It currently points to old space.  Check for a forwarding  
          * pointer.  
          */  
         lispobj *ptr = (lispobj *) PTR(object);  
         lispobj first_word = *ptr;  
2523    
2524          if(first_word == 0x01) {  #if DIRECT_SCAV
2525            /* Yep, there be a forwarding pointer. */          words_scavenged = scavtab[TypeOf(object)] (start, object);
2526            *start = ptr[1];  #else /* not DIRECT_SCAV */
2527            words_scavenged = 1;          if (Pointerp(object)) {
2528          }  #ifdef GC_ASSERTIONS
2529                check_escaped_stack_object(start, object);
2530    #endif
2531    
2532                if (from_space_p(object)) {
2533                    lispobj *ptr = (lispobj *) PTR(object);
2534                    lispobj first_word = *ptr;
2535    
2536                    if (first_word == 0x01) {
2537                        *start = ptr[1];
2538                        words_scavenged = 1;
2539                    } else {
2540                        words_scavenged = scavtab[TypeOf(object)] (start, object);
2541                    }
2542                } 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)
2585                words_scavenged = 1;
2586          else          else
2587            /* Scavenge that pointer. */              words_scavenged = scavtab[TypeOf(object)] (start, object);
2588            words_scavenged = (scavtab[TypeOf(object)])(start, object);  #endif /* not DIRECT_SCAV */
2589        }  
2590        else          start += words_scavenged;
2591          /* It points somewhere other than oldspace.  Leave it alone. */          nwords -= words_scavenged;
2592          words_scavenged = 1;      }
2593      else  
2594        if ((object & 3) == 0)      gc_assert(nwords == 0);
2595          /* It's a fixnum.  Real easy. */  }
2596          words_scavenged = 1;  
2597        else  
2598          /* It's some random header object. */  #if !(defined(i386) || defined(__x86_64))
2599          words_scavenged = (scavtab[TypeOf(object)])(start, object);  /* Scavenging Interrupt Contexts */
2600    
2601    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
2684    scavenge_interrupt_context(os_context_t * context)
2685    {
2686        int i;
2687    
2688        INTERIOR_POINTER_VARS(pc);
2689    #ifdef reg_LIP
2690        INTERIOR_POINTER_VARS(lip);
2691    #endif
2692    #ifdef reg_LR
2693        INTERIOR_POINTER_VARS(lr);
2694  #endif  #endif
2695    #ifdef reg_CTR
2696        INTERIOR_POINTER_VARS(ctr);
2697    #endif
2698    #ifdef SC_NPC
2699        INTERIOR_POINTER_VARS(npc);
2700    #endif
2701    
2702    #ifdef reg_LIP
2703        PAIR_INTERIOR_POINTER(lip, SC_REG(context, reg_LIP));
2704    #endif /* reg_LIP */
2705    
2706        PAIR_INTERIOR_POINTER(pc, SC_PC(context));
2707    
2708    #ifdef SC_NPC
2709        PAIR_INTERIOR_POINTER(npc, SC_NPC(context));
2710    #endif
2711    
2712      start += words_scavenged;  #ifdef reg_LR
2713      nwords -= words_scavenged;      PAIR_INTERIOR_POINTER(pc, SC_REG(context, reg_LR));
2714    }  #endif
2715    gc_assert(nwords == 0);  
2716    #ifdef reg_CTR
2717        PAIR_INTERIOR_POINTER(pc, SC_REG(context, reg_CTR));
2718    #endif
2719    
2720        /* Scanvenge all boxed registers in the context. */
2721        for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
2722            int index;
2723            lispobj foo;
2724    
2725            index = boxed_registers[i];
2726            foo = SC_REG(context, index);
2727            scavenge(&foo, 1);
2728            SC_REG(context, index) = foo;
2729    
2730            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
2738        FIXUP_INTERIOR_POINTER(lip, SC_REG(context, reg_LIP));
2739    #endif
2740    
2741        FIXUP_INTERIOR_POINTER(pc, SC_PC(context));
2742    
2743    #ifdef SC_NPC
2744        FIXUP_INTERIOR_POINTER(npc, SC_NPC(context));
2745    #endif
2746    
2747    #ifdef reg_LR
2748        FIXUP_INTERIOR_POINTER(lr, SC_REG(context, reg_LR));
2749    #endif
2750    
2751    #ifdef reg_CTR
2752        FIXUP_INTERIOR_POINTER(ctr, SC_REG(context, reg_CTR));
2753    #endif
2754  }  }
2755    
2756    void
2757    scavenge_interrupt_contexts(void)
2758    {
2759        int i, index;
2760        os_context_t *context;
2761    
2762    #ifdef PRINTNOISE
2763        printf("Scavenging interrupt contexts ...\n");
2764    #endif
2765    
2766        index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX));
2767    
2768    #if defined(DEBUG_PRINT_CONTEXT_INDEX)
2769        printf("Number of active contexts: %d\n", index);
2770    #endif
2771    
2772        for (i = 0; i < index; i++) {
2773            context = lisp_interrupt_contexts[i];
2774            scavenge_interrupt_context(context);
2775        }
2776    }
2777    #endif
2778    
2779  /* Code and Code-Related Objects */  /* Code and Code-Related Objects */
2780    
2781    /*
2782     * Aargh!  Why is SPARC so different here?  What is the advantage of
2783     * making it different from all the other ports?
2784     */
2785    #if defined(sparc) || (defined(DARWIN) && defined(__ppc__))
2786    #define RAW_ADDR_OFFSET 0
2787    #else
2788  #define RAW_ADDR_OFFSET (6 * sizeof(lispobj) - type_FunctionPointer)  #define RAW_ADDR_OFFSET (6 * sizeof(lispobj) - type_FunctionPointer)
2789    #endif
2790    
2791  static lispobj trans_function_header(lispobj object);  static lispobj trans_function_header(lispobj object);
2792  static lispobj trans_boxed(lispobj object);  static lispobj trans_boxed(lispobj object);
2793    
2794  #if DIRECT_SCAV  #if DIRECT_SCAV
2795  static int scav_function_pointer(lispobj *where, lispobj object)  static int
2796    scav_function_pointer(lispobj * where, lispobj object)
2797  {  {
2798    gc_assert(Pointerp(object));      gc_assert(Pointerp(object));
2799    
2800    if (from_space_p(object)) {      if (from_space_p(object)) {
2801      lispobj first, *first_pointer;          lispobj first, *first_pointer;
2802    
2803      /*          /*
2804       * Object is a pointer into from space - check to see if it has           * Object is a pointer into from space - check to see if it has
2805       * been forwarded.           * been forwarded.
2806       */           */
2807      first_pointer = (lispobj *) PTR(object);          first_pointer = (lispobj *) PTR(object);
2808      first = *first_pointer;          first = *first_pointer;
2809    
2810      if (first == 0x01) {          if (first == 0x01) {
2811        /* Forwarded */              /* Forwarded */
2812        *where = first_pointer[1];              *where = first_pointer[1];
2813        return 1;              return 1;
2814      }          } else {
2815      else {              int type;
2816        int type;              lispobj copy;
       lispobj copy;  
2817    
2818        /*              /*
2819         * Must transport object -- object may point to either a               * Must transport object -- object may point to either a
2820         * function header, a closure function header, or to a closure               * function header, a closure function header, or to a closure
2821         * header.               * header.
2822         */               */
2823    
2824        type = TypeOf(first);              type = TypeOf(first);
2825        switch (type) {              switch (type) {
2826        case type_FunctionHeader:                case type_FunctionHeader:
2827        case type_ClosureFunctionHeader:                case type_ClosureFunctionHeader:
2828          copy = trans_function_header(object);                    copy = trans_function_header(object);
2829          break;                    break;
2830        default:                default:
2831          copy = trans_boxed(object);                    copy = trans_boxed(object);
2832          break;                    break;
2833        }              }
2834    
2835        if (copy != object) {              if (copy != object) {
2836          /* Set forwarding pointer. */                  /* Set forwarding pointer. */
2837          first_pointer[0] = 0x01;                  first_pointer[0] = 0x01;
2838          first_pointer[1] = copy;                  first_pointer[1] = copy;
2839        }              }
2840    
2841        first = copy;              first = copy;
2842      }          }
2843    
2844      gc_assert(Pointerp(first));          gc_assert(Pointerp(first));
2845      gc_assert(!from_space_p(first));          gc_assert(!from_space_p(first));
2846    
2847      *where = first;          *where = first;
2848    }      }
2849    return 1;      return 1;
2850  }  }
2851  #else  #else
2852  static int scav_function_pointer(lispobj *where, lispobj object)  static int
2853    scav_function_pointer(lispobj * where, lispobj object)
2854  {  {
2855    lispobj *first_pointer;      lispobj *first_pointer;
2856    lispobj copy;      lispobj copy;
2857    
2858    gc_assert(Pointerp(object));      gc_assert(Pointerp(object));
2859    
2860    /* Object is a pointer into from space - no a FP. */      /* Object is a pointer into from space - no a FP. */
2861    first_pointer = (lispobj *) PTR(object);      first_pointer = (lispobj *) PTR(object);
2862    
2863    /*      /*
2864     * Must transport object -- object may point to either a function       * Must transport object -- object may point to either a function
2865     * header, a closure function header, or to a closure header.       * header, a closure function header, or to a closure header.
2866     */       */
2867    
2868    switch (TypeOf(*first_pointer)) {      switch (TypeOf(*first_pointer)) {
2869    case type_FunctionHeader:        case type_FunctionHeader:
2870    case type_ClosureFunctionHeader:        case type_ClosureFunctionHeader:
2871      copy = trans_function_header(object);            copy = trans_function_header(object);
2872      break;            break;
2873    default:        default:
2874      copy = trans_boxed(object);            copy = trans_boxed(object);
2875      break;            break;
2876    }      }
2877    
2878    if (copy != object) {      if (copy != object) {
2879      /* Set forwarding pointer */          /* Set forwarding pointer */
2880      first_pointer[0] = 0x01;          first_pointer[0] = 0x01;
2881      first_pointer[1] = copy;          first_pointer[1] = copy;
2882    }      }
2883    
2884    gc_assert(Pointerp(copy));      gc_assert(Pointerp(copy));
2885    gc_assert(!from_space_p(copy));      gc_assert(!from_space_p(copy));
2886    
2887    *where = copy;      *where = copy;
2888    
2889    return 1;      return 1;
2890  }  }
2891  #endif  #endif
2892    
2893    #if defined(i386) || defined(__x86_64)
2894  /*  /*
2895   * Scan a x86 compiled code objected, looking for possible fixups that   * Scan an x86 compiled code object, looking for possible fixups that
2896   * have been missed after a move.   * have been missed after a move.
2897   *   *
2898   * Two types of fixups are needed:   * Two types of fixups are needed:
# Line 2034  static int scav_function_pointer(lispobj Line 2902  static int scav_function_pointer(lispobj
2902   * Currently only absolution fixups to the constant vector, or to the   * Currently only absolution fixups to the constant vector, or to the
2903   * code area are checked.   * code area are checked.
2904   */   */
2905  void sniff_code_object(struct code *code, unsigned displacement)  void
2906    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)
2915      return;          return;
2916    
2917    /*      /*
2918     * It's ok if it's byte compiled code. The trace table offset will       * It's ok if it's byte compiled code. The trace table offset will
2919     * be a fixnum if it's x86 compiled code - check.       * be a fixnum if it's x86 compiled code - check.
2920     */       */
2921    if (code->trace_table_offset & 0x3) {      if (code->trace_table_offset & 0x3) {
2922  #if 0  #if 0
2923      fprintf(stderr, "*** Sniffing byte compiled code object at %x.\n",code);          fprintf(stderr, "*** Sniffing byte compiled code object at %x.\n",
2924                    code);
2925  #endif  #endif
2926      return;          return;
2927    }      }
2928    
2929    /* Else it's x86 machine code. */      /* Else it's x86 machine code. */
2930    
2931        ncode_words = fixnum_value(code->code_size);
2932        nheader_words = HeaderValue(*(lispobj *) code);
2933        nwords = ncode_words + nheader_words;
2934    
2935        constants_start_addr = (char *) code + 5 * sizeof(lispobj);
2936        constants_end_addr = (char *) code + nheader_words * sizeof(lispobj);
2937        code_start_addr = (char *) code + nheader_words * sizeof(lispobj);
2938        code_end_addr = (char *) code + nwords * sizeof(lispobj);
2939    
2940        /* Work through the unboxed code. */
2941        for (p = code_start_addr; p < code_end_addr; p++) {
2942            char *data = *(char **) p;
2943            unsigned d1 = *((unsigned char *) p - 1);
2944            unsigned d2 = *((unsigned char *) p - 2);
2945            unsigned d3 = *((unsigned char *) p - 3);
2946            unsigned d4 = *((unsigned char *) p - 4);
2947            unsigned d5 = *((unsigned char *) p - 5);
2948            unsigned d6 = *((unsigned char *) p - 6);
2949    
2950    ncode_words = fixnum_value(code->code_size);          /*
2951    nheader_words = HeaderValue(*(lispobj *) code);           * Check for code references.
2952    nwords = ncode_words + nheader_words;           *
2953             * Check for a 32 bit word that looks like an absolute reference
2954    constants_start_addr = (void *) code + 5 * 4;           * to within the code adea of the code object.
2955    constants_end_addr = (void *) code + nheader_words * 4;           */
2956    code_start_addr = (void *) code + nheader_words * 4;          if (data >= code_start_addr - displacement
2957    code_end_addr = (void *) code + nwords * 4;              && data < code_end_addr - displacement) {
2958                /* Function header */
2959    /* Work through the unboxed code. */              if (d4 == 0x5e
2960    for (p = code_start_addr; p < code_end_addr; p++) {                  && ((unsigned long) p - 4 -
2961      void *data = *(void **) p;                      4 * HeaderValue(*((unsigned long *) p - 1))) ==
2962      unsigned d1 = *((unsigned char *) p - 1);                  (unsigned long) code) {
2963      unsigned d2 = *((unsigned char *) p - 2);                  /* Skip the function header */
2964      unsigned d3 = *((unsigned char *) p - 3);                  p += 6 * 4 - 4 - 1;
2965      unsigned d4 = *((unsigned char *) p - 4);                  continue;
2966      unsigned d5 = *((unsigned char *) p - 5);              }
2967      unsigned d6 = *((unsigned char *) p - 6);              /* Push imm32 */
2968                if (d1 == 0x68) {
2969                    fixup_found = 1;
2970                    fprintf(stderr,
2971                            "Code ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
2972                            (unsigned long) p, d6, d5, d4, d3, d2, d1,
2973                            (unsigned long) data);
2974                    fprintf(stderr, "***  Push $0x%.8lx\n", (unsigned long) data);
2975                }
2976                /* Mov [reg-8],imm32 */
2977                if (d3 == 0xc7
2978                    && (d2 == 0x40 || d2 == 0x41 || d2 == 0x42 || d2 == 0x43
2979                        || d2 == 0x45 || d2 == 0x46 || d2 == 0x47)
2980                    && d1 == 0xf8) {
2981                    fixup_found = 1;
2982                    fprintf(stderr,
2983                            "Code ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
2984                            (unsigned long) p, d6, d5, d4, d3, d2, d1,
2985                            (unsigned long) data);
2986                    fprintf(stderr, "***  Mov [reg-8],$0x%.8lx\n",
2987                            (unsigned long) data);
2988                }
2989                /* Lea reg, [disp32] */
2990                if (d2 == 0x8d && (d1 & 0xc7) == 5) {
2991                    fixup_found = 1;
2992                    fprintf(stderr,
2993                            "Code ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
2994                            (unsigned long) p, d6, d5, d4, d3, d2, d1,
2995                            (unsigned long) data);
2996                    fprintf(stderr, "***  Lea reg,[$0x%.8lx]\n",
2997                            (unsigned long) data);
2998                }
2999            }
3000    
3001      /*          /*
3002       * Check for code references.           * Check for constant references.
3003       *           *
3004       * Check for a 32 bit word that looks like an absolute reference           * Check for a 32 bit word that looks like an absolution reference
3005       * to within the code adea of the code object.           * to within the constant vector. Constant references will be
3006       */           * aligned.
3007      if (data >= code_start_addr - displacement           */
3008          && data < code_end_addr - displacement) {          if (data >= constants_start_addr - displacement
3009        /* Function header */              && data < constants_end_addr - displacement
3010        if (d4 == 0x5e              && ((unsigned long) data & 0x3) == 0) {
3011            && ((unsigned) p - 4 - 4 * HeaderValue(*((unsigned *) p - 1))) == (unsigned) code) {              /*  Mov eax,m32 */
3012          /* Skip the function header */              if (d1 == 0xa1) {
3013          p += 6 * 4 - 4 - 1;                  fixup_found = 1;
3014          continue;                  fprintf(stderr,
3015        }                          "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3016        /* Push imm32 */                          (unsigned long) p, d6, d5, d4, d3, d2, d1,
3017        if (d1 == 0x68) {                          (unsigned long) data);
3018          fixup_found = 1;                  fprintf(stderr, "***  Mov eax,0x%.8lx\n", (unsigned long) data);
3019          fprintf(stderr, "Code ref. @ %x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",              }
3020                  p, d6,d5,d4,d3,d2,d1, data);  
3021          fprintf(stderr, "***  Push $0x%.8x\n", data);              /*  Mov m32,eax */
3022        }              if (d1 == 0xa3) {
3023        /* Mov [reg-8],imm32 */                  fixup_found = 1;
3024        if (d3 == 0xc7                  fprintf(stderr,
3025            && (d2 == 0x40 || d2 == 0x41 || d2 == 0x42 || d2 == 0x43                          "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3026                || d2 == 0x45 || d2 == 0x46 || d2 == 0x47)                          (unsigned long) p, d6, d5, d4, d3, d2, d1,
3027            && d1 == 0xf8) {                          (unsigned long) data);
3028          fixup_found = 1;                  fprintf(stderr, "***  Mov 0x%.8lx,eax\n", (unsigned long) data);
3029          fprintf(stderr, "Code ref. @ %x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",              }
3030                  p, d6,d5,d4,d3,d2,d1, data);  
3031          fprintf(stderr, "***  Mov [reg-8],$0x%.8x\n", data);              /* Cmp m32,imm32 */
3032        }              if (d1 == 0x3d && d2 == 0x81) {
3033        /* Lea reg, [disp32] */                  fixup_found = 1;
3034        if (d2 == 0x8d && (d1 & 0xc7) == 5) {                  fprintf(stderr,
3035          fixup_found = 1;                          "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3036          fprintf(stderr, "Code ref. @ %x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",                          (unsigned long) p, d6, d5, d4, d3, d2, d1,
3037                  p, d6,d5,d4,d3,d2,d1, data);                          (unsigned long) data);
3038          fprintf(stderr, "***  Lea reg,[$0x%.8x]\n", data);                  /* XX Check this */
3039        }                  fprintf(stderr, "***  Cmp 0x%.8lx,immed32\n",
3040                            (unsigned long) data);
3041                }
3042    
3043                /* Check for a mod=00, r/m=101 byte. */
3044                if ((d1 & 0xc7) == 5) {
3045                    /* Cmp m32,reg */
3046                    if (d2 == 0x39) {
3047                        fixup_found = 1;
3048                        fprintf(stderr,
3049                                "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3050                                (unsigned long) p, d6, d5, d4, d3, d2, d1,
3051                                (unsigned long) data);
3052                        fprintf(stderr, "***  Cmp 0x%.8lx,reg\n",
3053                                (unsigned long) data);
3054                    }
3055                    /* Cmp reg32,m32 */
3056                    if (d2 == 0x3b) {
3057                        fixup_found = 1;
3058                        fprintf(stderr,
3059                                "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3060                                (unsigned long) p, d6, d5, d4, d3, d2, d1,
3061                                (unsigned long) data);
3062                        fprintf(stderr, "***  Cmp reg32,0x%.8lx\n",
3063                                (unsigned long) data);
3064                    }
3065                    /* Mov m32,reg32 */
3066                    if (d2 == 0x89) {
3067                        fixup_found = 1;
3068                        fprintf(stderr,
3069                                "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3070                                (unsigned long) p, d6, d5, d4, d3, d2, d1,
3071                                (unsigned long) data);
3072                        fprintf(stderr, "***  Mov 0x%.8lx,reg32\n",
3073                                (unsigned long) data);
3074                    }
3075                    /* Mov reg32,m32 */
3076                    if (d2 == 0x8b) {
3077                        fixup_found = 1;
3078                        fprintf(stderr,
3079                                "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3080                                (unsigned long) p, d6, d5, d4, d3, d2, d1,
3081                                (unsigned long) data);
3082                        fprintf(stderr, "***  Mov reg32,0x%.8lx\n",
3083                                (unsigned long) data);
3084                    }
3085                    /* Lea reg32,m32 */
3086                    if (d2 == 0x8d) {
3087                        fixup_found = 1;
3088                        fprintf(stderr,
3089                                "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3090                                (unsigned long) p, d6, d5, d4, d3, d2, d1,
3091                                (unsigned long) data);
3092                        fprintf(stderr, "***  Lea reg32,0x%.8lx\n",
3093                                (unsigned long) data);
3094                    }
3095                }
3096            }
3097      }      }
3098    
3099      /*      /* If anything was found print out some info. on the code object. */
3100       * Check for constant references.      if (fixup_found) {
3101       *          fprintf(stderr,
3102       * Check for a 32 bit word that looks like an absolution reference                  "*** Compiled code object at %lx: header_words=%d code_words=%d .\n",
3103       * to within the constant vector. Constant references will be                  (unsigned long) code, nheader_words, ncode_words);
3104       * aligned.          fprintf(stderr,
3105       */                  "*** Const. start = %lx; end= %lx; Code start = %lx; end = %lx\n",
3106      if (data >= constants_start_addr - displacement                  (unsigned long) constants_start_addr,
3107          && data < constants_end_addr - displacement                  (unsigned long) constants_end_addr,
3108          && ((unsigned) data & 0x3) == 0) {                  (unsigned long) code_start_addr, (unsigned long) code_end_addr);
3109        /*  Mov eax,m32 */      }
3110        if (d1 == 0xa1) {  }
         fixup_found = 1;  
         fprintf(stderr, "Abs. const. ref. @ %x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",  
                 p, d6, d5, d4, d3, d2, d1, data);  
         fprintf(stderr, "***  Mov eax,0x%.8x\n", data);  
       }  
   
       /*  Mov m32,eax */  
       if (d1 == 0xa3) {  
         fixup_found = 1;  
         fprintf(stderr, "Abs. const. ref. @ %x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",  
                 p, d6, d5, d4, d3, d2, d1, data);  
         fprintf(stderr, "***  Mov 0x%.8x,eax\n", data);  
       }  
   
       /* Cmp m32,imm32 */  
       if (d1 == 0x3d && d2 == 0x81) {  
         fixup_found = 1;  
         fprintf(stderr, "Abs. const. ref. @ %x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",  
                 p, d6, d5, d4, d3, d2, d1, data);  
         /* XX Check this */  
         fprintf(stderr, "***  Cmp 0x%.8x,immed32\n", data);  
       }  
   
       /* Check for a mod=00, r/m=101 byte. */  
       if ((d1 & 0xc7) == 5) {  
         /* Cmp m32,reg */  
         if (d2 == 0x39) {  
           fixup_found = 1;  
           fprintf(stderr, "Abs. const. ref. @ %x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",  
                   p, d6, d5, d4, d3, d2, d1, data);  
           fprintf(stderr, "***  Cmp 0x%.8x,reg\n", data);  
         }  
         /* Cmp reg32,m32 */  
         if (d2 == 0x3b) {  
           fixup_found = 1;  
           fprintf(stderr, "Abs. const. ref. @ %x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",  
                   p, d6, d5, d4, d3, d2, d1, data);  
           fprintf(stderr, "***  Cmp reg32,0x%.8x\n", data);  
         }  
         /* Mov m32,reg32 */  
         if (d2 == 0x89) {  
           fixup_found = 1;  
           fprintf(stderr, "Abs. const. ref. @ %x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",  
                   p, d6, d5, d4, d3, d2, d1, data);  
           fprintf(stderr, "***  Mov 0x%.8x,reg32\n", data);  
         }  
         /* Mov reg32,m32 */  
         if (d2 == 0x8b) {  
           fixup_found = 1;  
           fprintf(stderr, "Abs. const. ref. @ %x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",  
                   p, d6, d5, d4, d3, d2, d1, data);  
           fprintf(stderr, "***  Mov reg32,0x%.8x\n", data);  
         }  
         /* Lea reg32,m32 */  
         if (d2 == 0x8d) {  
           fixup_found = 1;  
           fprintf(stderr, "Abs. const. ref. @ %x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",  
                   p, d6, d5, d4, d3, d2, d1, data);  
           fprintf(stderr, "***  Lea reg32,0x%.8x\n", data);  
         }  
       }  
     }  
   }  
   
   /* If anything was found print out some info. on the code object. */  
   if (fixup_found) {  
     fprintf(stderr, "*** Compiled code object at %x: header_words=%d code_words=%d .\n",  
             code, nheader_words, ncode_words);  
     fprintf(stderr, "*** Const. start = %x; end= %x; Code start = %x; end = %x\n",  
             constants_start_addr, constants_end_addr,  
             code_start_addr, code_end_addr);  
   }  
 }  
   
 static void apply_code_fixups(struct code *old_code, struct code *new_code)  
 {  
   int nheader_words, ncode_words, nwords;  
   void *constants_start_addr, *constants_end_addr;  
   void *code_start_addr, *code_end_addr;  
   lispobj fixups = NIL;  
   unsigned displacement = (unsigned) new_code - (unsigned) old_code;  
   struct vector *fixups_vector;  
3111    
3112    /*  static void
3113     * It's ok if it's byte compiled code. The trace table offset will  apply_code_fixups(struct code *old_code, struct code *new_code)
3114     * be a fixnum if it's x86 compiled code - check.  {
3115     */      int nheader_words, ncode_words, nwords;
3116    if (new_code->trace_table_offset & 0x3) {      char *constants_start_addr, *constants_end_addr;
3117        char *code_start_addr, *code_end_addr;
3118        lispobj fixups = NIL;
3119        unsigned long displacement =
3120    
3121            (unsigned long) new_code - (unsigned long) old_code;
3122        struct vector *fixups_vector;
3123    
3124        /*
3125         * It's ok if it's byte compiled code. The trace table offset will
3126         * be a fixnum if it's x86 compiled code - check.
3127         */
3128        if (new_code->trace_table_offset & 0x3) {
3129  #if 0  #if 0
3130      fprintf(stderr, "*** Byte compiled code object at %x.\n", new_code);          fprintf(stderr, "*** Byte compiled code object at %x.\n", new_code);
3131  #endif  #endif
3132      return;          return;
3133    }      }
3134    
3135    /* Else it's x86 machine code. */      /* Else it's x86 machine code. */
3136    ncode_words = fixnum_value(new_code->code_size);      ncode_words = fixnum_value(new_code->code_size);
3137    nheader_words = HeaderValue(*(lispobj *) new_code);      nheader_words = HeaderValue(*(lispobj *) new_code);
3138    nwords = ncode_words + nheader_words;      nwords = ncode_words + nheader_words;
3139  #if 0  #if 0
3140    fprintf(stderr, "*** Compiled code object at %x: header_words=%d code_words=%d .\n",      fprintf(stderr,
3141            new_code, nheader_words, ncode_words);              "*** Compiled code object at %x: header_words=%d code_words=%d .\n",
3142  #endif              new_code, nheader_words, ncode_words);
3143    constants_start_addr = (void *) new_code + 5 * 4;  #endif
3144    constants_end_addr = (void *) new_code + nheader_words * 4;      constants_start_addr = (char *) new_code + 5 * sizeof(lispobj);
3145    code_start_addr = (void *) new_code + nheader_words * 4;      constants_end_addr = (char *) new_code + nheader_words * sizeof(lispobj);
3146    code_end_addr = (void *)new_code + nwords*4;      code_start_addr = (char *) new_code + nheader_words * sizeof(lispobj);
3147  #if 0      code_end_addr = (char *) new_code + nwords * sizeof(lispobj);
3148    fprintf(stderr, "*** Const. start = %x; end= %x; Code start = %x; end = %x\n",  #if 0
3149            constants_start_addr, constants_end_addr,      fprintf(stderr,
3150            code_start_addr, code_end_addr);              "*** Const. start = %x; end= %x; Code start = %x; end = %x\n",
3151                constants_start_addr, constants_end_addr, code_start_addr,
3152                code_end_addr);
3153  #endif  #endif
3154    
3155    /*      /*
3156     * The first constant should be a pointer to the fixups for this       * The first constant should be a pointer to the fixups for this
3157     * code objects - Check.       * code objects - Check.
3158     */       */
3159    fixups = new_code->constants[0];      fixups = new_code->constants[0];
3160    
3161    /*      /*
3162     * It will be 0 or the unbound-marker if there are no fixups, and       * It will be 0 or the unbound-marker if there are no fixups, and
3163     * will be an other pointer if it is valid.       * will be an other pointer if it is valid.
3164     */       */
3165    if (fixups == 0 || fixups == type_UnboundMarker || !Pointerp(fixups)) {      if (fixups == 0 || fixups == type_UnboundMarker || !Pointerp(fixups)) {
3166      /* Check for possible errors. */          /* Check for possible errors. */
3167      if (check_code_fixups)          if (check_code_fixups)
3168        sniff_code_object(new_code, displacement);              sniff_code_object(new_code, displacement);
3169    
3170  #if 0  #if 0
3171      fprintf(stderr, "Fixups for code object not found!?\n");          fprintf(stderr, "Fixups for code object not found!?\n");
3172      fprintf(stderr, "*** Compiled code object at %x: header_words=%d code_words=%d .\n",          fprintf(stderr,
3173              new_code, nheader_words, ncode_words);                  "*** Compiled code object at %x: header_words=%d code_words=%d .\n",
3174      fprintf(stderr, "*** Const. start = %x; end= %x; Code start = %x; end = %x\n",                  new_code, nheader_words, ncode_words);
3175              constants_start_addr, constants_end_addr,          fprintf(stderr,
3176              code_start_addr, code_end_addr);                  "*** Const. start = %x; end= %x; Code start = %x; end = %x\n",
3177                    constants_start_addr, constants_end_addr, code_start_addr,
3178                    code_end_addr);
3179  #endif  #endif
3180      return;          return;
3181    }      }
3182    
3183    fixups_vector = (struct vector *) PTR(fixups);      fixups_vector = (struct vector *) PTR(fixups);
3184    
3185    /* Could be pointing to a forwarding pointer. */      /* Could be pointing to a forwarding pointer. */
3186    if (Pointerp(fixups) && find_page_index((void*) fixups_vector) != -1      if (Pointerp(fixups) && find_page_index((void *) fixups_vector) != -1
3187        && fixups_vector->header == 0x01) {          && fixups_vector->header == 0x01) {
3188  #if 0  #if 0
3189      fprintf(stderr, "* FF\n");          fprintf(stderr, "* FF\n");
3190  #endif  #endif
3191      /* If so then follow it. */          /* If so then follow it. */
3192      fixups_vector = (struct vector *) PTR((lispobj) fixups_vector->length);          fixups_vector = (struct vector *) PTR((lispobj) fixups_vector->length);
3193    }      }
   
3194  #if 0  #if 0
3195    fprintf(stderr, "Got the fixups\n");      fprintf(stderr, "Got the fixups\n");
3196  #endif  #endif
3197    
3198    if (TypeOf(fixups_vector->header) == type_SimpleArrayUnsignedByte32) {      if (TypeOf(fixups_vector->header) == type_SimpleArrayUnsignedByte32) {
     /*  
      * Got the fixups for the code block.  Now work through the  
      * vector, and apply a fixup at each address.  
      */  
     int length = fixnum_value(fixups_vector->length);  
     int i;  
     for (i = 0; i < length; i++) {  
       unsigned offset = fixups_vector->data[i];  
       /* Now check the current value of offset. */  
       unsigned old_value = *(unsigned *) ((unsigned) code_start_addr + offset);  
   
       /*  
        * If it's within the old_code object then it must be an  
        * absolute fixup (relative ones are not saved).  
        */  
       if (old_value >= (unsigned) old_code  
           && old_value < (unsigned) old_code + nwords * 4)  
         /* So add the dispacement. */  
         *(unsigned *) ((unsigned) code_start_addr + offset) = old_value  
           + displacement;  
       else  
3199          /*          /*
3200           * It is outside the old code object so it must be a relative           * Got the fixups for the code block.  Now work through the
3201           * fixup (absolute fixups are not saved). So subtract the           * vector, and apply a fixup at each address.
          * displacement.  
3202           */           */
3203          *(unsigned *) ((unsigned) code_start_addr + offset) = old_value          int length = fixnum_value(fixups_vector->length);
3204            - displacement;          int i;
3205    
3206            for (i = 0; i < length; i++) {
3207                unsigned offset = fixups_vector->data[i];
3208    
3209                /* Now check the current value of offset. */
3210                unsigned long old_value =
3211                    *(unsigned long *) ((unsigned long) code_start_addr + offset);
3212    
3213                /*
3214                 * If it's within the old_code object then it must be an
3215                 * absolute fixup (relative ones are not saved).
3216                 */
3217                if (old_value >= (unsigned long) old_code
3218                    && old_value <
3219                    (unsigned long) old_code + nwords * sizeof(lispobj))
3220                    /* So add the dispacement. */
3221                    *(unsigned long *) ((unsigned long) code_start_addr + offset) =
3222                        old_value + displacement;
3223                else
3224                    /*
3225                     * It is outside the old code object so it must be a relative
3226                     * fixup (absolute fixups are not saved). So subtract the
3227                     * displacement.
3228                     */
3229                    *(unsigned long *) ((unsigned long) code_start_addr + offset) =
3230                        old_value - displacement;
3231            }
3232      }      }
   }  
3233    
3234    /* Check for possible errors. */      /* Check for possible errors. */
3235    if (check_code_fixups)      if (check_code_fixups)
3236      sniff_code_object(new_code, displacement);          sniff_code_object(new_code, displacement);
3237  }  }
3238    #endif
3239    
3240  static struct code * trans_code(struct code *code)  static struct code *
3241    trans_code(struct code *code)
3242  {  {
3243    struct code *new_code;      struct code *new_code;
3244    lispobj l_code, l_new_code;      lispobj l_code, l_new_code;
3245    int nheader_words, ncode_words, nwords;      int nheader_words, ncode_words, nwords;
3246    unsigned long displacement;      unsigned long displacement;
3247    lispobj fheaderl, *prev_pointer;      lispobj fheaderl, *prev_pointer;
3248    
3249  #if 0  #if 0
3250    fprintf(stderr, "\nTransporting code object located at 0x%08x.\n",      fprintf(stderr, "\nTransporting code object located at 0x%08x.\n",
3251            (unsigned long) code);              (unsigned long) code);
3252  #endif  #endif
3253    
3254    /* If object has already been transported, just return pointer */      /* If object has already been transported, just return pointer */
3255    if (*(lispobj *) code == 0x01)      if (*(lispobj *) code == 0x01) {
3256      return (struct code*) (((lispobj *) code)[1]);          return (struct code *) (((lispobj *) code)[1]);
3257        }
3258    
   gc_assert(TypeOf(code->header) == type_CodeHeader);  
3259    
3260    /* prepare to transport the code vector */      gc_assert(TypeOf(code->header) == type_CodeHeader);
   l_code = (lispobj) code | type_OtherPointer;  
3261    
3262    ncode_words = fixnum_value(code->code_size);      /* prepare to transport the code vector */
3263    nheader_words = HeaderValue(code->header);      l_code = (lispobj) code | type_OtherPointer;
   nwords = ncode_words + nheader_words;  
   nwords = CEILING(nwords, 2);  
3264    
3265    l_new_code = copy_large_object(l_code, nwords);      ncode_words = fixnum_value(code->code_size);
3266    new_code = (struct code *) PTR(l_new_code);      nheader_words = HeaderValue(code->header);
3267        nwords = ncode_words + nheader_words;
3268        nwords = CEILING(nwords, 2);
3269    
3270    /* May not have been moved. */      l_new_code = copy_large_object(l_code, nwords);
3271    if (new_code == code)      new_code = (struct code *) PTR(l_new_code);
     return new_code;  
3272    
3273    displacement = l_new_code - l_code;      /* May not have been moved. */
3274        if (new_code == code)
3275            return new_code;
3276    
3277        displacement = l_new_code - l_code;
3278    
3279  #if 0  #if 0
3280    fprintf(stderr, "Old code object at 0x%08x, new code object at 0x%08x.\n",      fprintf(stderr, "Old code object at 0x%08x, new code object at 0x%08x.\n",
3281            (unsigned long) code, (unsigned long) new_code);              (unsigned long) code, (unsigned long) new_code);
3282    fprintf(stderr, "Code object is %d words long.\n", nwords);      fprintf(stderr, "Code object is %d words long.\n", nwords);
3283  #endif  #endif
3284    
3285    /* set forwarding pointer */      /* set forwarding pointer */
3286    ((lispobj *) code)[0] = 0x01;      ((lispobj *) code)[0] = 0x01;
3287    ((lispobj *) code)[1] = l_new_code;      ((lispobj *) code)[1] = l_new_code;
3288    
3289    /*      /*
3290     * Set forwarding pointers for all the function headers in the code       * Set forwarding pointers for all the function headers in the code
3291     * object; also fix all self pointers.       * object; also fix all self pointers.
3292     */       */
3293    
3294    fheaderl = code->entry_points;      fheaderl = code->entry_points;
3295    prev_pointer = &new_code->entry_points;      prev_pointer = &new_code->entry_points;
3296    
3297    while (fheaderl != NIL) {      while (fheaderl != NIL) {
3298      struct function *fheaderp, *nfheaderp;          struct function *fheaderp, *nfheaderp;
3299      lispobj nfheaderl;          lispobj nfheaderl;
3300    
3301      fheaderp = (struct function *) PTR(fheaderl);          fheaderp = (struct function *) PTR(fheaderl);
3302      gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);          gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
3303    
3304      /*          /*
3305       * Calcuate the new function pointer and the new function header.           * Calcuate the new function pointer and the new function header.
3306       */           */
3307      nfheaderl = fheaderl + displacement;          nfheaderl = fheaderl + displacement;
3308      nfheaderp = (struct function *) PTR(nfheaderl);          nfheaderp = (struct function *) PTR(nfheaderl);
3309    
3310      /* set forwarding pointer */          /* set forwarding pointer */
3311      ((lispobj *) fheaderp)[0] = 0x01;          ((lispobj *) fheaderp)[0] = 0x01;
3312      ((lispobj *) fheaderp)[1] = nfheaderl;          ((lispobj *) fheaderp)[1] = nfheaderl;
3313    
3314      /* Fix self pointer */          /* Fix self pointer */
3315      nfheaderp->self = nfheaderl + RAW_ADDR_OFFSET;          nfheaderp->self = nfheaderl + RAW_ADDR_OFFSET;
3316    
3317      *prev_pointer = nfheaderl;          *prev_pointer = nfheaderl;
3318    
3319      fheaderl = fheaderp->next;          fheaderl = fheaderp->next;
3320      prev_pointer = &nfheaderp->next;          prev_pointer = &nfheaderp->next;
3321    }      }
3322    
3323  #if 0  #if 0
3324    sniff_code_object(new_code, displacement);      sniff_code_object(new_code, displacement);
3325    #endif
3326    #if defined(i386) || defined(__x86_64)
3327        apply_code_fixups(code, new_code);
3328    #else
3329        /* From gc.c */
3330    #ifndef MACH
3331        os_flush_icache((os_vm_address_t) (((int *) new_code) + nheader_words),
3332                        ncode_words * sizeof(int));
3333    #endif
3334  #endif  #endif
   apply_code_fixups(code, new_code);  
3335    
3336    return new_code;      return new_code;
3337  }  }
3338    
3339  static int scav_code_header(lispobj *where, lispobj object)  static int
3340    scav_code_header(lispobj * where, lispobj object)
3341  {  {
3342    struct code *code;      struct code *code;
3343    int nheader_words, ncode_words, nwords;      int nheader_words, ncode_words, nwords;
3344    lispobj fheaderl;      lispobj fheaderl;
3345    struct function *fheaderp;      struct function *fheaderp;
3346    
3347        code = (struct code *) where;
3348        ncode_words = fixnum_value(code->code_size);
3349        nheader_words = HeaderValue(object);
3350        nwords = ncode_words + nheader_words;
3351        nwords = CEILING(nwords, 2);
3352    
3353    code = (struct code *) where;      /* Scavenge the boxed section of the code data block */
3354    ncode_words = fixnum_value(code->code_size);      scavenge(where + 1, nheader_words - 1);
   nheader_words = HeaderValue(object);  
   nwords = ncode_words + nheader_words;  
   nwords = CEILING(nwords, 2);  
3355    
3356    /* Scavenge the boxed section of the code data block */      /*
3357    scavenge(where + 1, nheader_words - 1);       * Scavenge the boxed section of each function object in the code
3358         * data block
3359    /*       */
3360     * Scavenge the boxed section of each function object in the code      fheaderl = code->entry_points;
3361     * data block      while (fheaderl != NIL) {
3362     */          fheaderp = (struct function *) PTR(fheaderl);
3363    fheaderl = code->entry_points;          gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);
   while (fheaderl != NIL) {  
     fheaderp = (struct function *) PTR(fheaderl);  
     gc_assert(TypeOf(fheaderp->header) == type_FunctionHeader);  
3364    
3365      scavenge(&fheaderp->name, 1);          scavenge(&fheaderp->name, 1);
3366      scavenge(&fheaderp->arglist, 1);          scavenge(&fheaderp->arglist, 1);
3367      scavenge(&fheaderp->type, 1);          scavenge(&fheaderp->type, 1);
3368    
3369      fheaderl = fheaderp->next;          fheaderl = fheaderp->next;
3370    }      }
3371    
3372    return nwords;      return nwords;
3373  }  }
3374    
3375  static lispobj trans_code_header(lispobj object)  static lispobj
3376    trans_code_header(lispobj object)
3377  {  {
3378          struct code *ncode;      struct code *ncode;
3379    
3380          ncode = trans_code((struct code *) PTR(object));      ncode = trans_code((struct code *) PTR(object));
3381          return (lispobj) ncode | type_OtherPointer;      return (lispobj) ncode | type_OtherPointer;
3382  }  }
3383    
3384  static int size_code_header(lispobj *where)  static int
3385    size_code_header(lispobj * where)
3386  {  {
3387          struct code *code;      struct code *code;
3388          int nheader_words, ncode_words, nwords;      int nheader_words, ncode_words, nwords;
3389    
3390          code = (struct code *) where;      code = (struct code *) where;
3391    
3392          ncode_words = fixnum_value(code->code_size);      ncode_words = fixnum_value(code->code_size);
3393          nheader_words = HeaderValue(code->header);      nheader_words = HeaderValue(code->header);
3394          nwords = ncode_words + nheader_words;      nwords = ncode_words + nheader_words;
3395          nwords = CEILING(nwords, 2);      nwords = CEILING(nwords, 2);
3396    
3397          return nwords;      return nwords;
3398  }  }
3399    
3400    #if !(defined(i386) || defined(__x86_64))
3401    
3402  static int scav_return_pc_header(lispobj *where, lispobj object)  static int
3403    scav_return_pc_header(lispobj * where, lispobj object)
3404  {  {
3405      fprintf(stderr, "GC lossage.  Should not be scavenging a ");      fprintf(stderr, "GC lossage.  Should not be scavenging a ");
3406      fprintf(stderr, "Return PC Header.\n");      fprintf(stderr, "Return PC Header.\n");
3407      fprintf(stderr, "where = 0x%08x, object = 0x%08x",      fprintf(stderr, "where = 0x%08lx, object = 0x%08lx",
3408              (unsigned long) where, (unsigned long) object);              (unsigned long) where, (unsigned long) object);
3409      lose(NULL);      lose(NULL);
3410      return 0;      return 0;
3411  }  }
3412    
3413  static lispobj trans_return_pc_header(lispobj object)  #endif /* not i386 */
3414    
3415    static lispobj
3416    trans_return_pc_header(lispobj object)
3417  {  {
3418    struct function *return_pc;      struct function *return_pc;
3419    unsigned long offset;      unsigned long offset;
3420    struct code *code, *ncode;      struct code *code, *ncode;
3421    
3422    fprintf(stderr, "*** trans_return_pc_header: will this work?\n");      return_pc = (struct function *) PTR(object);
3423        offset = HeaderValue(return_pc->header) * sizeof(lispobj);
3424    
3425    return_pc = (struct function *) PTR(object);      /* Transport the whole code object */
3426    offset = HeaderValue(return_pc->header) * 4;      code = (struct code *) ((unsigned long) return_pc - offset);
3427    
3428    /* Transport the whole code object */      ncode = trans_code(code);
   code = (struct code *) ((unsigned long) return_pc - offset);  
   ncode = trans_code(code);  
3429    
3430    return ((lispobj) ncode + offset) | type_OtherPointer;      return ((lispobj) ncode + offset) | type_OtherPointer;
3431  }  }
3432    
3433  /*  /*
3434   * On the 386, closures hold a pointer to the raw address instead of   * On the 386, closures hold a pointer to the raw address instead of
3435   * the function object.   * the function object.
3436   */   */
3437  #ifdef i386  #if defined(i386) || defined(__x86_64)
 static int scav_closure_header(lispobj *where, lispobj object)  
 {  
   struct closure *closure;  
   lispobj fun;  
3438    
3439    closure = (struct closure *)where;  static int
3440    fun = closure->function - RAW_ADDR_OFFSET;  scav_closure_header(lispobj * where, lispobj object)
3441    scavenge(&fun, 1);  {
3442    /* The function may have moved so update the raw address. But don't      struct closure *closure;
3443       write unnecessarily. */      lispobj fun;
   if (closure->function != fun + RAW_ADDR_OFFSET)  
     closure->function = fun + RAW_ADDR_OFFSET;  
3444    
3445    return 2;      closure = (struct closure *) where;
3446  }      fun = closure->function - RAW_ADDR_OFFSET;
3447    #if !(defined(i386) && defined(SOLARIS))
3448        scavenge(&fun, 1);
3449        /* The function may have moved so update the raw address. But don't
3450           write unnecessarily. */
3451        if (closure->function != fun + RAW_ADDR_OFFSET)
3452            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