0.8.5.47:
[sbcl.git] / src / runtime / gencgc.c
1 /*
2  * GENerational Conservative Garbage Collector for SBCL x86
3  */
4
5 /*
6  * This software is part of the SBCL system. See the README file for
7  * more information.
8  *
9  * This software is derived from the CMU CL system, which was
10  * written at Carnegie Mellon University and released into the
11  * public domain. The software is in the public domain and is
12  * provided with absolutely no warranty. See the COPYING and CREDITS
13  * files for more information.
14  */
15
16 /*
17  * For a review of garbage collection techniques (e.g. generational
18  * GC) and terminology (e.g. "scavenging") see Paul R. Wilson,
19  * "Uniprocessor Garbage Collection Techniques". As of 20000618, this
20  * had been accepted for _ACM Computing Surveys_ and was available
21  * as a PostScript preprint through
22  *   <http://www.cs.utexas.edu/users/oops/papers.html>
23  * as
24  *   <ftp://ftp.cs.utexas.edu/pub/garbage/bigsurv.ps>.
25  */
26
27 #include <stdio.h>
28 #include <signal.h>
29 #include <errno.h>
30 #include "runtime.h"
31 #include "sbcl.h"
32 #include "os.h"
33 #include "interr.h"
34 #include "globals.h"
35 #include "interrupt.h"
36 #include "validate.h"
37 #include "lispregs.h"
38 #include "arch.h"
39 #include "gc.h"
40 #include "gc-internal.h"
41 #include "thread.h"
42 #include "genesis/vector.h"
43 #include "genesis/weak-pointer.h"
44 #include "genesis/simple-fun.h"
45
46 #ifdef LISP_FEATURE_SB_THREAD
47 #include <sys/ptrace.h>
48 #include <linux/user.h>         /* threading is presently linux-only */
49 #endif
50
51 /* assembly language stub that executes trap_PendingInterrupt */
52 void do_pending_interrupt(void);
53
54 /* forward declarations */
55 int gc_find_freeish_pages(int *restart_page_ptr, int nbytes, int unboxed, struct alloc_region *alloc_region);
56 void  gc_set_region_empty(struct alloc_region *region);
57 void gc_alloc_update_all_page_tables(void);
58 static void  gencgc_pickup_dynamic(void);
59 boolean interrupt_maybe_gc_int(int, siginfo_t *, void *);
60
61 \f
62 /*
63  * GC parameters
64  */
65
66 /* the number of actual generations. (The number of 'struct
67  * generation' objects is one more than this, because one object
68  * serves as scratch when GC'ing.) */
69 #define NUM_GENERATIONS 6
70
71 /* Should we use page protection to help avoid the scavenging of pages
72  * that don't have pointers to younger generations? */
73 boolean enable_page_protection = 1;
74
75 /* Should we unmap a page and re-mmap it to have it zero filled? */
76 #if defined(__FreeBSD__) || defined(__OpenBSD__)
77 /* comment from cmucl-2.4.8: This can waste a lot of swap on FreeBSD
78  * so don't unmap there.
79  *
80  * The CMU CL comment didn't specify a version, but was probably an
81  * old version of FreeBSD (pre-4.0), so this might no longer be true.
82  * OTOH, if it is true, this behavior might exist on OpenBSD too, so
83  * for now we don't unmap there either. -- WHN 2001-04-07 */
84 boolean gencgc_unmap_zero = 0;
85 #else
86 boolean gencgc_unmap_zero = 1;
87 #endif
88
89 /* the minimum size (in bytes) for a large object*/
90 /* FIXME: Should this really be PAGE_BYTES? */
91 unsigned large_object_size = 4 * PAGE_BYTES;
92
93 \f
94 /*
95  * debugging
96  */
97
98
99
100 /* the verbosity level. All non-error messages are disabled at level 0;
101  * and only a few rare messages are printed at level 1. */
102 unsigned gencgc_verbose = (QSHOW ? 1 : 0);
103
104 /* FIXME: At some point enable the various error-checking things below
105  * and see what they say. */
106
107 /* We hunt for pointers to old-space, when GCing generations >= verify_gen.
108  * Set verify_gens to NUM_GENERATIONS to disable this kind of check. */
109 int verify_gens = NUM_GENERATIONS;
110
111 /* Should we do a pre-scan verify of generation 0 before it's GCed? */
112 boolean pre_verify_gen_0 = 0;
113
114 /* Should we check for bad pointers after gc_free_heap is called
115  * from Lisp PURIFY? */
116 boolean verify_after_free_heap = 0;
117
118 /* Should we print a note when code objects are found in the dynamic space
119  * during a heap verify? */
120 boolean verify_dynamic_code_check = 0;
121
122 /* Should we check code objects for fixup errors after they are transported? */
123 boolean check_code_fixups = 0;
124
125 /* Should we check that newly allocated regions are zero filled? */
126 boolean gencgc_zero_check = 0;
127
128 /* Should we check that the free space is zero filled? */
129 boolean gencgc_enable_verify_zero_fill = 0;
130
131 /* Should we check that free pages are zero filled during gc_free_heap
132  * called after Lisp PURIFY? */
133 boolean gencgc_zero_check_during_free_heap = 0;
134 \f
135 /*
136  * GC structures and variables
137  */
138
139 /* the total bytes allocated. These are seen by Lisp DYNAMIC-USAGE. */
140 unsigned long bytes_allocated = 0;
141 extern unsigned long bytes_consed_between_gcs; /* gc-common.c */
142 unsigned long auto_gc_trigger = 0;
143
144 /* the source and destination generations. These are set before a GC starts
145  * scavenging. */
146 int from_space;
147 int new_space;
148
149
150 /* An array of page structures is statically allocated.
151  * This helps quickly map between an address its page structure.
152  * NUM_PAGES is set from the size of the dynamic space. */
153 struct page page_table[NUM_PAGES];
154
155 /* To map addresses to page structures the address of the first page
156  * is needed. */
157 static void *heap_base = NULL;
158
159
160 /* Calculate the start address for the given page number. */
161 inline void *
162 page_address(int page_num)
163 {
164     return (heap_base + (page_num * PAGE_BYTES));
165 }
166
167 /* Find the page index within the page_table for the given
168  * address. Return -1 on failure. */
169 inline int
170 find_page_index(void *addr)
171 {
172     int index = addr-heap_base;
173
174     if (index >= 0) {
175         index = ((unsigned int)index)/PAGE_BYTES;
176         if (index < NUM_PAGES)
177             return (index);
178     }
179
180     return (-1);
181 }
182
183 /* a structure to hold the state of a generation */
184 struct generation {
185
186     /* the first page that gc_alloc() checks on its next call */
187     int alloc_start_page;
188
189     /* the first page that gc_alloc_unboxed() checks on its next call */
190     int alloc_unboxed_start_page;
191
192     /* the first page that gc_alloc_large (boxed) considers on its next
193      * call. (Although it always allocates after the boxed_region.) */
194     int alloc_large_start_page;
195
196     /* the first page that gc_alloc_large (unboxed) considers on its
197      * next call. (Although it always allocates after the
198      * current_unboxed_region.) */
199     int alloc_large_unboxed_start_page;
200
201     /* the bytes allocated to this generation */
202     int bytes_allocated;
203
204     /* the number of bytes at which to trigger a GC */
205     int gc_trigger;
206
207     /* to calculate a new level for gc_trigger */
208     int bytes_consed_between_gc;
209
210     /* the number of GCs since the last raise */
211     int num_gc;
212
213     /* the average age after which a GC will raise objects to the
214      * next generation */
215     int trigger_age;
216
217     /* the cumulative sum of the bytes allocated to this generation. It is
218      * cleared after a GC on this generations, and update before new
219      * objects are added from a GC of a younger generation. Dividing by
220      * the bytes_allocated will give the average age of the memory in
221      * this generation since its last GC. */
222     int cum_sum_bytes_allocated;
223
224     /* a minimum average memory age before a GC will occur helps
225      * prevent a GC when a large number of new live objects have been
226      * added, in which case a GC could be a waste of time */
227     double min_av_mem_age;
228 };
229 /* the number of actual generations. (The number of 'struct
230  * generation' objects is one more than this, because one object
231  * serves as scratch when GC'ing.) */
232 #define NUM_GENERATIONS 6
233
234 /* an array of generation structures. There needs to be one more
235  * generation structure than actual generations as the oldest
236  * generation is temporarily raised then lowered. */
237 struct generation generations[NUM_GENERATIONS+1];
238
239 /* the oldest generation that is will currently be GCed by default.
240  * Valid values are: 0, 1, ... (NUM_GENERATIONS-1)
241  *
242  * The default of (NUM_GENERATIONS-1) enables GC on all generations.
243  *
244  * Setting this to 0 effectively disables the generational nature of
245  * the GC. In some applications generational GC may not be useful
246  * because there are no long-lived objects.
247  *
248  * An intermediate value could be handy after moving long-lived data
249  * into an older generation so an unnecessary GC of this long-lived
250  * data can be avoided. */
251 unsigned int  gencgc_oldest_gen_to_gc = NUM_GENERATIONS-1;
252
253 /* The maximum free page in the heap is maintained and used to update
254  * ALLOCATION_POINTER which is used by the room function to limit its
255  * search of the heap. XX Gencgc obviously needs to be better
256  * integrated with the Lisp code. */
257 static int  last_free_page;
258 \f
259 /* This lock is to prevent multiple threads from simultaneously
260  * allocating new regions which overlap each other.  Note that the
261  * majority of GC is single-threaded, but alloc() may be called from
262  * >1 thread at a time and must be thread-safe.  This lock must be
263  * seized before all accesses to generations[] or to parts of
264  * page_table[] that other threads may want to see */
265
266 static lispobj free_pages_lock=0;
267
268 \f
269 /*
270  * miscellaneous heap functions
271  */
272
273 /* Count the number of pages which are write-protected within the
274  * given generation. */
275 static int
276 count_write_protect_generation_pages(int generation)
277 {
278     int i;
279     int count = 0;
280
281     for (i = 0; i < last_free_page; i++)
282         if ((page_table[i].allocated != FREE_PAGE)
283             && (page_table[i].gen == generation)
284             && (page_table[i].write_protected == 1))
285             count++;
286     return count;
287 }
288
289 /* Count the number of pages within the given generation. */
290 static int
291 count_generation_pages(int generation)
292 {
293     int i;
294     int count = 0;
295
296     for (i = 0; i < last_free_page; i++)
297         if ((page_table[i].allocated != 0)
298             && (page_table[i].gen == generation))
299             count++;
300     return count;
301 }
302
303 /* Count the number of dont_move pages. */
304 static int
305 count_dont_move_pages(void)
306 {
307     int i;
308     int count = 0;
309     for (i = 0; i < last_free_page; i++) {
310         if ((page_table[i].allocated != 0) && (page_table[i].dont_move != 0)) {
311             ++count;
312         }
313     }
314     return count;
315 }
316
317 /* Work through the pages and add up the number of bytes used for the
318  * given generation. */
319 static int
320 count_generation_bytes_allocated (int gen)
321 {
322     int i;
323     int result = 0;
324     for (i = 0; i < last_free_page; i++) {
325         if ((page_table[i].allocated != 0) && (page_table[i].gen == gen))
326             result += page_table[i].bytes_used;
327     }
328     return result;
329 }
330
331 /* Return the average age of the memory in a generation. */
332 static double
333 gen_av_mem_age(int gen)
334 {
335     if (generations[gen].bytes_allocated == 0)
336         return 0.0;
337
338     return
339         ((double)generations[gen].cum_sum_bytes_allocated)
340         / ((double)generations[gen].bytes_allocated);
341 }
342
343 void fpu_save(int *);           /* defined in x86-assem.S */
344 void fpu_restore(int *);        /* defined in x86-assem.S */
345 /* The verbose argument controls how much to print: 0 for normal
346  * level of detail; 1 for debugging. */
347 static void
348 print_generation_stats(int verbose) /* FIXME: should take FILE argument */
349 {
350     int i, gens;
351     int fpu_state[27];
352
353     /* This code uses the FP instructions which may be set up for Lisp
354      * so they need to be saved and reset for C. */
355     fpu_save(fpu_state);
356
357     /* number of generations to print */
358     if (verbose)
359         gens = NUM_GENERATIONS+1;
360     else
361         gens = NUM_GENERATIONS;
362
363     /* Print the heap stats. */
364     fprintf(stderr,
365             "   Generation Boxed Unboxed LB   LUB    Alloc  Waste   Trig    WP  GCs Mem-age\n");
366
367     for (i = 0; i < gens; i++) {
368         int j;
369         int boxed_cnt = 0;
370         int unboxed_cnt = 0;
371         int large_boxed_cnt = 0;
372         int large_unboxed_cnt = 0;
373
374         for (j = 0; j < last_free_page; j++)
375             if (page_table[j].gen == i) {
376
377                 /* Count the number of boxed pages within the given
378                  * generation. */
379                 if (page_table[j].allocated & BOXED_PAGE) {
380                     if (page_table[j].large_object)
381                         large_boxed_cnt++;
382                     else
383                         boxed_cnt++;
384                 }
385
386                 /* Count the number of unboxed pages within the given
387                  * generation. */
388                 if (page_table[j].allocated & UNBOXED_PAGE) {
389                     if (page_table[j].large_object)
390                         large_unboxed_cnt++;
391                     else
392                         unboxed_cnt++;
393                 }
394             }
395
396         gc_assert(generations[i].bytes_allocated
397                   == count_generation_bytes_allocated(i));
398         fprintf(stderr,
399                 "   %8d: %5d %5d %5d %5d %8d %5d %8d %4d %3d %7.4f\n",
400                 i,
401                 boxed_cnt, unboxed_cnt, large_boxed_cnt, large_unboxed_cnt,
402                 generations[i].bytes_allocated,
403                 (count_generation_pages(i)*PAGE_BYTES
404                  - generations[i].bytes_allocated),
405                 generations[i].gc_trigger,
406                 count_write_protect_generation_pages(i),
407                 generations[i].num_gc,
408                 gen_av_mem_age(i));
409     }
410     fprintf(stderr,"   Total bytes allocated=%ld\n", bytes_allocated);
411
412     fpu_restore(fpu_state);
413 }
414 \f
415 /*
416  * allocation routines
417  */
418
419 /*
420  * To support quick and inline allocation, regions of memory can be
421  * allocated and then allocated from with just a free pointer and a
422  * check against an end address.
423  *
424  * Since objects can be allocated to spaces with different properties
425  * e.g. boxed/unboxed, generation, ages; there may need to be many
426  * allocation regions.
427  *
428  * Each allocation region may be start within a partly used page. Many
429  * features of memory use are noted on a page wise basis, e.g. the
430  * generation; so if a region starts within an existing allocated page
431  * it must be consistent with this page.
432  *
433  * During the scavenging of the newspace, objects will be transported
434  * into an allocation region, and pointers updated to point to this
435  * allocation region. It is possible that these pointers will be
436  * scavenged again before the allocation region is closed, e.g. due to
437  * trans_list which jumps all over the place to cleanup the list. It
438  * is important to be able to determine properties of all objects
439  * pointed to when scavenging, e.g to detect pointers to the oldspace.
440  * Thus it's important that the allocation regions have the correct
441  * properties set when allocated, and not just set when closed. The
442  * region allocation routines return regions with the specified
443  * properties, and grab all the pages, setting their properties
444  * appropriately, except that the amount used is not known.
445  *
446  * These regions are used to support quicker allocation using just a
447  * free pointer. The actual space used by the region is not reflected
448  * in the pages tables until it is closed. It can't be scavenged until
449  * closed.
450  *
451  * When finished with the region it should be closed, which will
452  * update the page tables for the actual space used returning unused
453  * space. Further it may be noted in the new regions which is
454  * necessary when scavenging the newspace.
455  *
456  * Large objects may be allocated directly without an allocation
457  * region, the page tables are updated immediately.
458  *
459  * Unboxed objects don't contain pointers to other objects and so
460  * don't need scavenging. Further they can't contain pointers to
461  * younger generations so WP is not needed. By allocating pages to
462  * unboxed objects the whole page never needs scavenging or
463  * write-protecting. */
464
465 /* We are only using two regions at present. Both are for the current
466  * newspace generation. */
467 struct alloc_region boxed_region;
468 struct alloc_region unboxed_region;
469
470 /* The generation currently being allocated to. */
471 static int gc_alloc_generation;
472
473 /* Find a new region with room for at least the given number of bytes.
474  *
475  * It starts looking at the current generation's alloc_start_page. So
476  * may pick up from the previous region if there is enough space. This
477  * keeps the allocation contiguous when scavenging the newspace.
478  *
479  * The alloc_region should have been closed by a call to
480  * gc_alloc_update_page_tables(), and will thus be in an empty state.
481  *
482  * To assist the scavenging functions write-protected pages are not
483  * used. Free pages should not be write-protected.
484  *
485  * It is critical to the conservative GC that the start of regions be
486  * known. To help achieve this only small regions are allocated at a
487  * time.
488  *
489  * During scavenging, pointers may be found to within the current
490  * region and the page generation must be set so that pointers to the
491  * from space can be recognized. Therefore the generation of pages in
492  * the region are set to gc_alloc_generation. To prevent another
493  * allocation call using the same pages, all the pages in the region
494  * are allocated, although they will initially be empty.
495  */
496 static void
497 gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region)
498 {
499     int first_page;
500     int last_page;
501     int bytes_found;
502     int i;
503
504     /*
505     FSHOW((stderr,
506            "/alloc_new_region for %d bytes from gen %d\n",
507            nbytes, gc_alloc_generation));
508     */
509
510     /* Check that the region is in a reset state. */
511     gc_assert((alloc_region->first_page == 0)
512               && (alloc_region->last_page == -1)
513               && (alloc_region->free_pointer == alloc_region->end_addr));
514     get_spinlock(&free_pages_lock,(int) alloc_region);
515     if (unboxed) {
516         first_page =
517             generations[gc_alloc_generation].alloc_unboxed_start_page;
518     } else {
519         first_page =
520             generations[gc_alloc_generation].alloc_start_page;
521     }
522     last_page=gc_find_freeish_pages(&first_page,nbytes,unboxed,alloc_region);
523     bytes_found=(PAGE_BYTES - page_table[first_page].bytes_used)
524             + PAGE_BYTES*(last_page-first_page);
525
526     /* Set up the alloc_region. */
527     alloc_region->first_page = first_page;
528     alloc_region->last_page = last_page;
529     alloc_region->start_addr = page_table[first_page].bytes_used
530         + page_address(first_page);
531     alloc_region->free_pointer = alloc_region->start_addr;
532     alloc_region->end_addr = alloc_region->start_addr + bytes_found;
533
534     /* Set up the pages. */
535
536     /* The first page may have already been in use. */
537     if (page_table[first_page].bytes_used == 0) {
538         if (unboxed)
539             page_table[first_page].allocated = UNBOXED_PAGE;
540         else
541             page_table[first_page].allocated = BOXED_PAGE;
542         page_table[first_page].gen = gc_alloc_generation;
543         page_table[first_page].large_object = 0;
544         page_table[first_page].first_object_offset = 0;
545     }
546
547     if (unboxed)
548         gc_assert(page_table[first_page].allocated == UNBOXED_PAGE);
549     else
550         gc_assert(page_table[first_page].allocated == BOXED_PAGE);
551     page_table[first_page].allocated |= OPEN_REGION_PAGE; 
552
553     gc_assert(page_table[first_page].gen == gc_alloc_generation);
554     gc_assert(page_table[first_page].large_object == 0);
555
556     for (i = first_page+1; i <= last_page; i++) {
557         if (unboxed)
558             page_table[i].allocated = UNBOXED_PAGE;
559         else
560             page_table[i].allocated = BOXED_PAGE;
561         page_table[i].gen = gc_alloc_generation;
562         page_table[i].large_object = 0;
563         /* This may not be necessary for unboxed regions (think it was
564          * broken before!) */
565         page_table[i].first_object_offset =
566             alloc_region->start_addr - page_address(i);
567         page_table[i].allocated |= OPEN_REGION_PAGE ;
568     }
569     /* Bump up last_free_page. */
570     if (last_page+1 > last_free_page) {
571         last_free_page = last_page+1;
572         SetSymbolValue(ALLOCATION_POINTER,
573                        (lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES),
574                        0);
575     }
576     release_spinlock(&free_pages_lock);
577     
578     /* we can do this after releasing free_pages_lock */
579     if (gencgc_zero_check) {
580         int *p;
581         for (p = (int *)alloc_region->start_addr;
582              p < (int *)alloc_region->end_addr; p++) {
583             if (*p != 0) {
584                 /* KLUDGE: It would be nice to use %lx and explicit casts
585                  * (long) in code like this, so that it is less likely to
586                  * break randomly when running on a machine with different
587                  * word sizes. -- WHN 19991129 */
588                 lose("The new region at %x is not zero.", p);
589             }
590     }
591 }
592
593 }
594
595 /* If the record_new_objects flag is 2 then all new regions created
596  * are recorded.
597  *
598  * If it's 1 then then it is only recorded if the first page of the
599  * current region is <= new_areas_ignore_page. This helps avoid
600  * unnecessary recording when doing full scavenge pass.
601  *
602  * The new_object structure holds the page, byte offset, and size of
603  * new regions of objects. Each new area is placed in the array of
604  * these structures pointer to by new_areas. new_areas_index holds the
605  * offset into new_areas.
606  *
607  * If new_area overflows NUM_NEW_AREAS then it stops adding them. The
608  * later code must detect this and handle it, probably by doing a full
609  * scavenge of a generation. */
610 #define NUM_NEW_AREAS 512
611 static int record_new_objects = 0;
612 static int new_areas_ignore_page;
613 struct new_area {
614     int  page;
615     int  offset;
616     int  size;
617 };
618 static struct new_area (*new_areas)[];
619 static int new_areas_index;
620 int max_new_areas;
621
622 /* Add a new area to new_areas. */
623 static void
624 add_new_area(int first_page, int offset, int size)
625 {
626     unsigned new_area_start,c;
627     int i;
628
629     /* Ignore if full. */
630     if (new_areas_index >= NUM_NEW_AREAS)
631         return;
632
633     switch (record_new_objects) {
634     case 0:
635         return;
636     case 1:
637         if (first_page > new_areas_ignore_page)
638             return;
639         break;
640     case 2:
641         break;
642     default:
643         gc_abort();
644     }
645
646     new_area_start = PAGE_BYTES*first_page + offset;
647
648     /* Search backwards for a prior area that this follows from. If
649        found this will save adding a new area. */
650     for (i = new_areas_index-1, c = 0; (i >= 0) && (c < 8); i--, c++) {
651         unsigned area_end =
652             PAGE_BYTES*((*new_areas)[i].page)
653             + (*new_areas)[i].offset
654             + (*new_areas)[i].size;
655         /*FSHOW((stderr,
656                "/add_new_area S1 %d %d %d %d\n",
657                i, c, new_area_start, area_end));*/
658         if (new_area_start == area_end) {
659             /*FSHOW((stderr,
660                    "/adding to [%d] %d %d %d with %d %d %d:\n",
661                    i,
662                    (*new_areas)[i].page,
663                    (*new_areas)[i].offset,
664                    (*new_areas)[i].size,
665                    first_page,
666                    offset,
667                     size);*/
668             (*new_areas)[i].size += size;
669             return;
670         }
671     }
672
673     (*new_areas)[new_areas_index].page = first_page;
674     (*new_areas)[new_areas_index].offset = offset;
675     (*new_areas)[new_areas_index].size = size;
676     /*FSHOW((stderr,
677            "/new_area %d page %d offset %d size %d\n",
678            new_areas_index, first_page, offset, size));*/
679     new_areas_index++;
680
681     /* Note the max new_areas used. */
682     if (new_areas_index > max_new_areas)
683         max_new_areas = new_areas_index;
684 }
685
686 /* Update the tables for the alloc_region. The region may be added to
687  * the new_areas.
688  *
689  * When done the alloc_region is set up so that the next quick alloc
690  * will fail safely and thus a new region will be allocated. Further
691  * it is safe to try to re-update the page table of this reset
692  * alloc_region. */
693 void
694 gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region)
695 {
696     int more;
697     int first_page;
698     int next_page;
699     int bytes_used;
700     int orig_first_page_bytes_used;
701     int region_size;
702     int byte_cnt;
703
704     /*
705     FSHOW((stderr,
706            "/gc_alloc_update_page_tables() to gen %d:\n",
707            gc_alloc_generation));
708     */
709
710     first_page = alloc_region->first_page;
711
712     /* Catch an unused alloc_region. */
713     if ((first_page == 0) && (alloc_region->last_page == -1))
714         return;
715
716     next_page = first_page+1;
717
718     get_spinlock(&free_pages_lock,(int) alloc_region);
719     if (alloc_region->free_pointer != alloc_region->start_addr) {
720         /* some bytes were allocated in the region */
721         orig_first_page_bytes_used = page_table[first_page].bytes_used;
722
723         gc_assert(alloc_region->start_addr == (page_address(first_page) + page_table[first_page].bytes_used));
724
725         /* All the pages used need to be updated */
726
727         /* Update the first page. */
728
729         /* If the page was free then set up the gen, and
730          * first_object_offset. */
731         if (page_table[first_page].bytes_used == 0)
732             gc_assert(page_table[first_page].first_object_offset == 0);
733         page_table[first_page].allocated &= ~(OPEN_REGION_PAGE);
734
735         if (unboxed)
736             gc_assert(page_table[first_page].allocated == UNBOXED_PAGE);
737         else
738             gc_assert(page_table[first_page].allocated == BOXED_PAGE);
739         gc_assert(page_table[first_page].gen == gc_alloc_generation);
740         gc_assert(page_table[first_page].large_object == 0);
741
742         byte_cnt = 0;
743
744         /* Calculate the number of bytes used in this page. This is not
745          * always the number of new bytes, unless it was free. */
746         more = 0;
747         if ((bytes_used = (alloc_region->free_pointer - page_address(first_page)))>PAGE_BYTES) {
748             bytes_used = PAGE_BYTES;
749             more = 1;
750         }
751         page_table[first_page].bytes_used = bytes_used;
752         byte_cnt += bytes_used;
753
754
755         /* All the rest of the pages should be free. We need to set their
756          * first_object_offset pointer to the start of the region, and set
757          * the bytes_used. */
758         while (more) {
759             page_table[next_page].allocated &= ~(OPEN_REGION_PAGE);
760             if (unboxed)
761                 gc_assert(page_table[next_page].allocated == UNBOXED_PAGE);
762             else
763                 gc_assert(page_table[next_page].allocated == BOXED_PAGE);
764             gc_assert(page_table[next_page].bytes_used == 0);
765             gc_assert(page_table[next_page].gen == gc_alloc_generation);
766             gc_assert(page_table[next_page].large_object == 0);
767
768             gc_assert(page_table[next_page].first_object_offset ==
769                       alloc_region->start_addr - page_address(next_page));
770
771             /* Calculate the number of bytes used in this page. */
772             more = 0;
773             if ((bytes_used = (alloc_region->free_pointer
774                                - page_address(next_page)))>PAGE_BYTES) {
775                 bytes_used = PAGE_BYTES;
776                 more = 1;
777             }
778             page_table[next_page].bytes_used = bytes_used;
779             byte_cnt += bytes_used;
780
781             next_page++;
782         }
783
784         region_size = alloc_region->free_pointer - alloc_region->start_addr;
785         bytes_allocated += region_size;
786         generations[gc_alloc_generation].bytes_allocated += region_size;
787
788         gc_assert((byte_cnt- orig_first_page_bytes_used) == region_size);
789
790         /* Set the generations alloc restart page to the last page of
791          * the region. */
792         if (unboxed)
793             generations[gc_alloc_generation].alloc_unboxed_start_page =
794                 next_page-1;
795         else
796             generations[gc_alloc_generation].alloc_start_page = next_page-1;
797
798         /* Add the region to the new_areas if requested. */
799         if (!unboxed)
800             add_new_area(first_page,orig_first_page_bytes_used, region_size);
801
802         /*
803         FSHOW((stderr,
804                "/gc_alloc_update_page_tables update %d bytes to gen %d\n",
805                region_size,
806                gc_alloc_generation));
807         */
808     } else {
809         /* There are no bytes allocated. Unallocate the first_page if
810          * there are 0 bytes_used. */
811         page_table[first_page].allocated &= ~(OPEN_REGION_PAGE);
812         if (page_table[first_page].bytes_used == 0)
813             page_table[first_page].allocated = FREE_PAGE;
814     }
815
816     /* Unallocate any unused pages. */
817     while (next_page <= alloc_region->last_page) {
818         gc_assert(page_table[next_page].bytes_used == 0);
819         page_table[next_page].allocated = FREE_PAGE;
820         next_page++;
821     }
822     release_spinlock(&free_pages_lock);
823     /* alloc_region is per-thread, we're ok to do this unlocked */
824     gc_set_region_empty(alloc_region);
825 }
826
827 static inline void *gc_quick_alloc(int nbytes);
828
829 /* Allocate a possibly large object. */
830 void *
831 gc_alloc_large(int nbytes, int unboxed, struct alloc_region *alloc_region)
832 {
833     int first_page;
834     int last_page;
835     int orig_first_page_bytes_used;
836     int byte_cnt;
837     int more;
838     int bytes_used;
839     int next_page;
840     int large = (nbytes >= large_object_size);
841
842     /*
843     if (nbytes > 200000)
844         FSHOW((stderr, "/alloc_large %d\n", nbytes));
845     */
846
847     /*
848     FSHOW((stderr,
849            "/gc_alloc_large() for %d bytes from gen %d\n",
850            nbytes, gc_alloc_generation));
851     */
852
853     /* If the object is small, and there is room in the current region
854        then allocate it in the current region. */
855     if (!large
856         && ((alloc_region->end_addr-alloc_region->free_pointer) >= nbytes))
857         return gc_quick_alloc(nbytes);
858
859     /* To allow the allocation of small objects without the danger of
860        using a page in the current boxed region, the search starts after
861        the current boxed free region. XX could probably keep a page
862        index ahead of the current region and bumped up here to save a
863        lot of re-scanning. */
864
865     get_spinlock(&free_pages_lock,(int) alloc_region);
866
867     if (unboxed) {
868         first_page =
869             generations[gc_alloc_generation].alloc_large_unboxed_start_page;
870     } else {
871         first_page = generations[gc_alloc_generation].alloc_large_start_page;
872     }
873     if (first_page <= alloc_region->last_page) {
874         first_page = alloc_region->last_page+1;
875     }
876
877     last_page=gc_find_freeish_pages(&first_page,nbytes,unboxed,0);
878
879     gc_assert(first_page > alloc_region->last_page);
880     if (unboxed)
881         generations[gc_alloc_generation].alloc_large_unboxed_start_page =
882             last_page;
883     else
884         generations[gc_alloc_generation].alloc_large_start_page = last_page;
885
886     /* Set up the pages. */
887     orig_first_page_bytes_used = page_table[first_page].bytes_used;
888
889     /* If the first page was free then set up the gen, and
890      * first_object_offset. */
891     if (page_table[first_page].bytes_used == 0) {
892         if (unboxed)
893             page_table[first_page].allocated = UNBOXED_PAGE;
894         else
895             page_table[first_page].allocated = BOXED_PAGE;
896         page_table[first_page].gen = gc_alloc_generation;
897         page_table[first_page].first_object_offset = 0;
898         page_table[first_page].large_object = large;
899     }
900
901     if (unboxed)
902         gc_assert(page_table[first_page].allocated == UNBOXED_PAGE);
903     else
904         gc_assert(page_table[first_page].allocated == BOXED_PAGE);
905     gc_assert(page_table[first_page].gen == gc_alloc_generation);
906     gc_assert(page_table[first_page].large_object == large);
907
908     byte_cnt = 0;
909
910     /* Calc. the number of bytes used in this page. This is not
911      * always the number of new bytes, unless it was free. */
912     more = 0;
913     if ((bytes_used = nbytes+orig_first_page_bytes_used) > PAGE_BYTES) {
914         bytes_used = PAGE_BYTES;
915         more = 1;
916     }
917     page_table[first_page].bytes_used = bytes_used;
918     byte_cnt += bytes_used;
919
920     next_page = first_page+1;
921
922     /* All the rest of the pages should be free. We need to set their
923      * first_object_offset pointer to the start of the region, and
924      * set the bytes_used. */
925     while (more) {
926         gc_assert(page_table[next_page].allocated == FREE_PAGE);
927         gc_assert(page_table[next_page].bytes_used == 0);
928         if (unboxed)
929             page_table[next_page].allocated = UNBOXED_PAGE;
930         else
931             page_table[next_page].allocated = BOXED_PAGE;
932         page_table[next_page].gen = gc_alloc_generation;
933         page_table[next_page].large_object = large;
934
935         page_table[next_page].first_object_offset =
936             orig_first_page_bytes_used - PAGE_BYTES*(next_page-first_page);
937
938         /* Calculate the number of bytes used in this page. */
939         more = 0;
940         if ((bytes_used=(nbytes+orig_first_page_bytes_used)-byte_cnt) > PAGE_BYTES) {
941             bytes_used = PAGE_BYTES;
942             more = 1;
943         }
944         page_table[next_page].bytes_used = bytes_used;
945         byte_cnt += bytes_used;
946
947         next_page++;
948     }
949
950     gc_assert((byte_cnt-orig_first_page_bytes_used) == nbytes);
951
952     bytes_allocated += nbytes;
953     generations[gc_alloc_generation].bytes_allocated += nbytes;
954
955     /* Add the region to the new_areas if requested. */
956     if (!unboxed)
957         add_new_area(first_page,orig_first_page_bytes_used,nbytes);
958
959     /* Bump up last_free_page */
960     if (last_page+1 > last_free_page) {
961         last_free_page = last_page+1;
962         SetSymbolValue(ALLOCATION_POINTER,
963                        (lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES),0);
964     }
965     release_spinlock(&free_pages_lock);
966
967     return((void *)(page_address(first_page)+orig_first_page_bytes_used));
968 }
969
970 int
971 gc_find_freeish_pages(int *restart_page_ptr, int nbytes, int unboxed, struct alloc_region *alloc_region)
972 {
973     /* if alloc_region is 0, we assume this is for a potentially large
974        object */
975     int first_page;
976     int last_page;
977     int region_size;
978     int restart_page=*restart_page_ptr;
979     int bytes_found;
980     int num_pages;
981     int large = !alloc_region && (nbytes >= large_object_size);
982
983     gc_assert(free_pages_lock);
984     /* Search for a contiguous free space of at least nbytes. If it's a
985        large object then align it on a page boundary by searching for a
986        free page. */
987
988     /* To allow the allocation of small objects without the danger of
989        using a page in the current boxed region, the search starts after
990        the current boxed free region. XX could probably keep a page
991        index ahead of the current region and bumped up here to save a
992        lot of re-scanning. */
993
994     do {
995         first_page = restart_page;
996         if (large)              
997             while ((first_page < NUM_PAGES)
998                    && (page_table[first_page].allocated != FREE_PAGE))
999                 first_page++;
1000         else
1001             while (first_page < NUM_PAGES) {
1002                 if(page_table[first_page].allocated == FREE_PAGE)
1003                     break;
1004                 /* I don't know why we need the gen=0 test, but it
1005                  * breaks randomly if that's omitted -dan 2003.02.26
1006                  */
1007                 if((page_table[first_page].allocated ==
1008                     (unboxed ? UNBOXED_PAGE : BOXED_PAGE)) &&
1009                    (page_table[first_page].large_object == 0) &&
1010                    (gc_alloc_generation == 0) &&
1011                    (page_table[first_page].gen == gc_alloc_generation) &&
1012                    (page_table[first_page].bytes_used < (PAGE_BYTES-32)) &&
1013                    (page_table[first_page].write_protected == 0) &&
1014                    (page_table[first_page].dont_move == 0))
1015                     break;
1016                 first_page++;
1017             }
1018         
1019         if (first_page >= NUM_PAGES) {
1020             fprintf(stderr,
1021                     "Argh! gc_find_free_space failed (first_page), nbytes=%d.\n",
1022                     nbytes);
1023             print_generation_stats(1);
1024             lose(NULL);
1025         }
1026
1027         gc_assert(page_table[first_page].write_protected == 0);
1028
1029         last_page = first_page;
1030         bytes_found = PAGE_BYTES - page_table[first_page].bytes_used;
1031         num_pages = 1;
1032         while (((bytes_found < nbytes) 
1033                 || (alloc_region && (num_pages < 2)))
1034                && (last_page < (NUM_PAGES-1))
1035                && (page_table[last_page+1].allocated == FREE_PAGE)) {
1036             last_page++;
1037             num_pages++;
1038             bytes_found += PAGE_BYTES;
1039             gc_assert(page_table[last_page].write_protected == 0);
1040         }
1041
1042         region_size = (PAGE_BYTES - page_table[first_page].bytes_used)
1043             + PAGE_BYTES*(last_page-first_page);
1044
1045         gc_assert(bytes_found == region_size);
1046         restart_page = last_page + 1;
1047     } while ((restart_page < NUM_PAGES) && (bytes_found < nbytes));
1048
1049     /* Check for a failure */
1050     if ((restart_page >= NUM_PAGES) && (bytes_found < nbytes)) {
1051         fprintf(stderr,
1052                 "Argh! gc_find_freeish_pages failed (restart_page), nbytes=%d.\n",
1053                 nbytes);
1054         print_generation_stats(1);
1055         lose(NULL);
1056     }
1057     *restart_page_ptr=first_page;
1058     return last_page;
1059 }
1060
1061 /* Allocate bytes.  All the rest of the special-purpose allocation
1062  * functions will eventually call this (instead of just duplicating
1063  * parts of its code) */
1064
1065 void *
1066 gc_alloc_with_region(int nbytes,int unboxed_p, struct alloc_region *my_region,
1067                      int quick_p)
1068 {
1069     void *new_free_pointer;
1070
1071     /* FSHOW((stderr, "/gc_alloc %d\n", nbytes)); */
1072
1073     /* Check whether there is room in the current alloc region. */
1074     new_free_pointer = my_region->free_pointer + nbytes;
1075
1076     if (new_free_pointer <= my_region->end_addr) {
1077         /* If so then allocate from the current alloc region. */
1078         void *new_obj = my_region->free_pointer;
1079         my_region->free_pointer = new_free_pointer;
1080
1081         /* Unless a `quick' alloc was requested, check whether the
1082            alloc region is almost empty. */
1083         if (!quick_p &&
1084             (my_region->end_addr - my_region->free_pointer) <= 32) {
1085             /* If so, finished with the current region. */
1086             gc_alloc_update_page_tables(unboxed_p, my_region);
1087             /* Set up a new region. */
1088             gc_alloc_new_region(32 /*bytes*/, unboxed_p, my_region);
1089         }
1090
1091         return((void *)new_obj);
1092     }
1093
1094     /* Else not enough free space in the current region. */
1095
1096     /* If there some room left in the current region, enough to be worth
1097      * saving, then allocate a large object. */
1098     /* FIXME: "32" should be a named parameter. */
1099     if ((my_region->end_addr-my_region->free_pointer) > 32)
1100         return gc_alloc_large(nbytes, unboxed_p, my_region);
1101
1102     /* Else find a new region. */
1103
1104     /* Finished with the current region. */
1105     gc_alloc_update_page_tables(unboxed_p, my_region);
1106
1107     /* Set up a new region. */
1108     gc_alloc_new_region(nbytes, unboxed_p, my_region);
1109
1110     /* Should now be enough room. */
1111
1112     /* Check whether there is room in the current region. */
1113     new_free_pointer = my_region->free_pointer + nbytes;
1114
1115     if (new_free_pointer <= my_region->end_addr) {
1116         /* If so then allocate from the current region. */
1117         void *new_obj = my_region->free_pointer;
1118         my_region->free_pointer = new_free_pointer;
1119         /* Check whether the current region is almost empty. */
1120         if ((my_region->end_addr - my_region->free_pointer) <= 32) {
1121             /* If so find, finished with the current region. */
1122             gc_alloc_update_page_tables(unboxed_p, my_region);
1123
1124             /* Set up a new region. */
1125             gc_alloc_new_region(32, unboxed_p, my_region);
1126         }
1127
1128         return((void *)new_obj);
1129     }
1130
1131     /* shouldn't happen */
1132     gc_assert(0);
1133     return((void *) NIL); /* dummy value: return something ... */
1134 }
1135
1136 void *
1137 gc_general_alloc(int nbytes,int unboxed_p,int quick_p)
1138 {
1139     struct alloc_region *my_region = 
1140       unboxed_p ? &unboxed_region : &boxed_region;
1141     return gc_alloc_with_region(nbytes,unboxed_p, my_region,quick_p);
1142 }
1143
1144
1145
1146 static void *
1147 gc_alloc(int nbytes,int unboxed_p)
1148 {
1149     /* this is the only function that the external interface to
1150      * allocation presently knows how to call: Lisp code will never
1151      * allocate large objects, or to unboxed space, or `quick'ly.
1152      * Any of that stuff will only ever happen inside of GC */
1153     return gc_general_alloc(nbytes,unboxed_p,0);
1154 }
1155
1156 /* Allocate space from the boxed_region. If there is not enough free
1157  * space then call gc_alloc to do the job. A pointer to the start of
1158  * the object is returned. */
1159 static inline void *
1160 gc_quick_alloc(int nbytes)
1161 {
1162     return gc_general_alloc(nbytes,ALLOC_BOXED,ALLOC_QUICK);
1163 }
1164
1165 /* Allocate space for the possibly large boxed object. If it is a
1166  * large object then do a large alloc else use gc_quick_alloc.  Note
1167  * that gc_quick_alloc will eventually fall through to
1168  * gc_general_alloc which may allocate the object in a large way
1169  * anyway, but based on decisions about the free space in the current
1170  * region, not the object size itself */
1171
1172 static inline void *
1173 gc_quick_alloc_large(int nbytes)
1174 {
1175     if (nbytes >= large_object_size)
1176         return gc_alloc_large(nbytes, ALLOC_BOXED, &boxed_region);
1177     else
1178         return gc_general_alloc(nbytes,ALLOC_BOXED,ALLOC_QUICK);
1179 }
1180
1181 static inline void *
1182 gc_alloc_unboxed(int nbytes)
1183 {
1184     return gc_general_alloc(nbytes,ALLOC_UNBOXED,0);
1185 }
1186
1187 static inline void *
1188 gc_quick_alloc_unboxed(int nbytes)
1189 {
1190     return gc_general_alloc(nbytes,ALLOC_UNBOXED,ALLOC_QUICK);
1191 }
1192
1193 /* Allocate space for the object. If it is a large object then do a
1194  * large alloc else allocate from the current region. If there is not
1195  * enough free space then call general gc_alloc_unboxed() to do the job.
1196  *
1197  * A pointer to the start of the object is returned. */
1198 static inline void *
1199 gc_quick_alloc_large_unboxed(int nbytes)
1200 {
1201     if (nbytes >= large_object_size)
1202         return gc_alloc_large(nbytes,ALLOC_UNBOXED,&unboxed_region);
1203     else
1204         return gc_quick_alloc_unboxed(nbytes);
1205 }
1206 \f
1207 /*
1208  * scavenging/transporting routines derived from gc.c in CMU CL ca. 18b
1209  */
1210
1211 extern int (*scavtab[256])(lispobj *where, lispobj object);
1212 extern lispobj (*transother[256])(lispobj object);
1213 extern int (*sizetab[256])(lispobj *where);
1214
1215 /* Copy a large boxed object. If the object is in a large object
1216  * region then it is simply promoted, else it is copied. If it's large
1217  * enough then it's copied to a large object region.
1218  *
1219  * Vectors may have shrunk. If the object is not copied the space
1220  * needs to be reclaimed, and the page_tables corrected. */
1221 lispobj
1222 copy_large_object(lispobj object, int nwords)
1223 {
1224     int tag;
1225     lispobj *new;
1226     lispobj *source, *dest;
1227     int first_page;
1228
1229     gc_assert(is_lisp_pointer(object));
1230     gc_assert(from_space_p(object));
1231     gc_assert((nwords & 0x01) == 0);
1232
1233
1234     /* Check whether it's a large object. */
1235     first_page = find_page_index((void *)object);
1236     gc_assert(first_page >= 0);
1237
1238     if (page_table[first_page].large_object) {
1239
1240         /* Promote the object. */
1241
1242         int remaining_bytes;
1243         int next_page;
1244         int bytes_freed;
1245         int old_bytes_used;
1246
1247         /* Note: Any page write-protection must be removed, else a
1248          * later scavenge_newspace may incorrectly not scavenge these
1249          * pages. This would not be necessary if they are added to the
1250          * new areas, but let's do it for them all (they'll probably
1251          * be written anyway?). */
1252
1253         gc_assert(page_table[first_page].first_object_offset == 0);
1254
1255         next_page = first_page;
1256         remaining_bytes = nwords*4;
1257         while (remaining_bytes > PAGE_BYTES) {
1258             gc_assert(page_table[next_page].gen == from_space);
1259             gc_assert(page_table[next_page].allocated == BOXED_PAGE);
1260             gc_assert(page_table[next_page].large_object);
1261             gc_assert(page_table[next_page].first_object_offset==
1262                       -PAGE_BYTES*(next_page-first_page));
1263             gc_assert(page_table[next_page].bytes_used == PAGE_BYTES);
1264
1265             page_table[next_page].gen = new_space;
1266
1267             /* Remove any write-protection. We should be able to rely
1268              * on the write-protect flag to avoid redundant calls. */
1269             if (page_table[next_page].write_protected) {
1270                 os_protect(page_address(next_page), PAGE_BYTES, OS_VM_PROT_ALL);
1271                 page_table[next_page].write_protected = 0;
1272             }
1273             remaining_bytes -= PAGE_BYTES;
1274             next_page++;
1275         }
1276
1277         /* Now only one page remains, but the object may have shrunk
1278          * so there may be more unused pages which will be freed. */
1279
1280         /* The object may have shrunk but shouldn't have grown. */
1281         gc_assert(page_table[next_page].bytes_used >= remaining_bytes);
1282
1283         page_table[next_page].gen = new_space;
1284         gc_assert(page_table[next_page].allocated == BOXED_PAGE);
1285
1286         /* Adjust the bytes_used. */
1287         old_bytes_used = page_table[next_page].bytes_used;
1288         page_table[next_page].bytes_used = remaining_bytes;
1289
1290         bytes_freed = old_bytes_used - remaining_bytes;
1291
1292         /* Free any remaining pages; needs care. */
1293         next_page++;
1294         while ((old_bytes_used == PAGE_BYTES) &&
1295                (page_table[next_page].gen == from_space) &&
1296                (page_table[next_page].allocated == BOXED_PAGE) &&
1297                page_table[next_page].large_object &&
1298                (page_table[next_page].first_object_offset ==
1299                 -(next_page - first_page)*PAGE_BYTES)) {
1300             /* Checks out OK, free the page. Don't need to bother zeroing
1301              * pages as this should have been done before shrinking the
1302              * object. These pages shouldn't be write-protected as they
1303              * should be zero filled. */
1304             gc_assert(page_table[next_page].write_protected == 0);
1305
1306             old_bytes_used = page_table[next_page].bytes_used;
1307             page_table[next_page].allocated = FREE_PAGE;
1308             page_table[next_page].bytes_used = 0;
1309             bytes_freed += old_bytes_used;
1310             next_page++;
1311         }
1312
1313         generations[from_space].bytes_allocated -= 4*nwords + bytes_freed;
1314         generations[new_space].bytes_allocated += 4*nwords;
1315         bytes_allocated -= bytes_freed;
1316
1317         /* Add the region to the new_areas if requested. */
1318         add_new_area(first_page,0,nwords*4);
1319
1320         return(object);
1321     } else {
1322         /* Get tag of object. */
1323         tag = lowtag_of(object);
1324
1325         /* Allocate space. */
1326         new = gc_quick_alloc_large(nwords*4);
1327
1328         dest = new;
1329         source = (lispobj *) native_pointer(object);
1330
1331         /* Copy the object. */
1332         while (nwords > 0) {
1333             dest[0] = source[0];
1334             dest[1] = source[1];
1335             dest += 2;
1336             source += 2;
1337             nwords -= 2;
1338         }
1339
1340         /* Return Lisp pointer of new object. */
1341         return ((lispobj) new) | tag;
1342     }
1343 }
1344
1345 /* to copy unboxed objects */
1346 lispobj
1347 copy_unboxed_object(lispobj object, int nwords)
1348 {
1349     int tag;
1350     lispobj *new;
1351     lispobj *source, *dest;
1352
1353     gc_assert(is_lisp_pointer(object));
1354     gc_assert(from_space_p(object));
1355     gc_assert((nwords & 0x01) == 0);
1356
1357     /* Get tag of object. */
1358     tag = lowtag_of(object);
1359
1360     /* Allocate space. */
1361     new = gc_quick_alloc_unboxed(nwords*4);
1362
1363     dest = new;
1364     source = (lispobj *) native_pointer(object);
1365
1366     /* Copy the object. */
1367     while (nwords > 0) {
1368         dest[0] = source[0];
1369         dest[1] = source[1];
1370         dest += 2;
1371         source += 2;
1372         nwords -= 2;
1373     }
1374
1375     /* Return Lisp pointer of new object. */
1376     return ((lispobj) new) | tag;
1377 }
1378
1379 /* to copy large unboxed objects
1380  *
1381  * If the object is in a large object region then it is simply
1382  * promoted, else it is copied. If it's large enough then it's copied
1383  * to a large object region.
1384  *
1385  * Bignums and vectors may have shrunk. If the object is not copied
1386  * the space needs to be reclaimed, and the page_tables corrected.
1387  *
1388  * KLUDGE: There's a lot of cut-and-paste duplication between this
1389  * function and copy_large_object(..). -- WHN 20000619 */
1390 lispobj
1391 copy_large_unboxed_object(lispobj object, int nwords)
1392 {
1393     int tag;
1394     lispobj *new;
1395     lispobj *source, *dest;
1396     int first_page;
1397
1398     gc_assert(is_lisp_pointer(object));
1399     gc_assert(from_space_p(object));
1400     gc_assert((nwords & 0x01) == 0);
1401
1402     if ((nwords > 1024*1024) && gencgc_verbose)
1403         FSHOW((stderr, "/copy_large_unboxed_object: %d bytes\n", nwords*4));
1404
1405     /* Check whether it's a large object. */
1406     first_page = find_page_index((void *)object);
1407     gc_assert(first_page >= 0);
1408
1409     if (page_table[first_page].large_object) {
1410         /* Promote the object. Note: Unboxed objects may have been
1411          * allocated to a BOXED region so it may be necessary to
1412          * change the region to UNBOXED. */
1413         int remaining_bytes;
1414         int next_page;
1415         int bytes_freed;
1416         int old_bytes_used;
1417
1418         gc_assert(page_table[first_page].first_object_offset == 0);
1419
1420         next_page = first_page;
1421         remaining_bytes = nwords*4;
1422         while (remaining_bytes > PAGE_BYTES) {
1423             gc_assert(page_table[next_page].gen == from_space);
1424             gc_assert((page_table[next_page].allocated == UNBOXED_PAGE)
1425                       || (page_table[next_page].allocated == BOXED_PAGE));
1426             gc_assert(page_table[next_page].large_object);
1427             gc_assert(page_table[next_page].first_object_offset==
1428                       -PAGE_BYTES*(next_page-first_page));
1429             gc_assert(page_table[next_page].bytes_used == PAGE_BYTES);
1430
1431             page_table[next_page].gen = new_space;
1432             page_table[next_page].allocated = UNBOXED_PAGE;
1433             remaining_bytes -= PAGE_BYTES;
1434             next_page++;
1435         }
1436
1437         /* Now only one page remains, but the object may have shrunk so
1438          * there may be more unused pages which will be freed. */
1439
1440         /* Object may have shrunk but shouldn't have grown - check. */
1441         gc_assert(page_table[next_page].bytes_used >= remaining_bytes);
1442
1443         page_table[next_page].gen = new_space;
1444         page_table[next_page].allocated = UNBOXED_PAGE;
1445
1446         /* Adjust the bytes_used. */
1447         old_bytes_used = page_table[next_page].bytes_used;
1448         page_table[next_page].bytes_used = remaining_bytes;
1449
1450         bytes_freed = old_bytes_used - remaining_bytes;
1451
1452         /* Free any remaining pages; needs care. */
1453         next_page++;
1454         while ((old_bytes_used == PAGE_BYTES) &&
1455                (page_table[next_page].gen == from_space) &&
1456                ((page_table[next_page].allocated == UNBOXED_PAGE)
1457                 || (page_table[next_page].allocated == BOXED_PAGE)) &&
1458                page_table[next_page].large_object &&
1459                (page_table[next_page].first_object_offset ==
1460                 -(next_page - first_page)*PAGE_BYTES)) {
1461             /* Checks out OK, free the page. Don't need to both zeroing
1462              * pages as this should have been done before shrinking the
1463              * object. These pages shouldn't be write-protected, even if
1464              * boxed they should be zero filled. */
1465             gc_assert(page_table[next_page].write_protected == 0);
1466
1467             old_bytes_used = page_table[next_page].bytes_used;
1468             page_table[next_page].allocated = FREE_PAGE;
1469             page_table[next_page].bytes_used = 0;
1470             bytes_freed += old_bytes_used;
1471             next_page++;
1472         }
1473
1474         if ((bytes_freed > 0) && gencgc_verbose)
1475             FSHOW((stderr,
1476                    "/copy_large_unboxed bytes_freed=%d\n",
1477                    bytes_freed));
1478
1479         generations[from_space].bytes_allocated -= 4*nwords + bytes_freed;
1480         generations[new_space].bytes_allocated += 4*nwords;
1481         bytes_allocated -= bytes_freed;
1482
1483         return(object);
1484     }
1485     else {
1486         /* Get tag of object. */
1487         tag = lowtag_of(object);
1488
1489         /* Allocate space. */
1490         new = gc_quick_alloc_large_unboxed(nwords*4);
1491
1492         dest = new;
1493         source = (lispobj *) native_pointer(object);
1494
1495         /* Copy the object. */
1496         while (nwords > 0) {
1497             dest[0] = source[0];
1498             dest[1] = source[1];
1499             dest += 2;
1500             source += 2;
1501             nwords -= 2;
1502         }
1503
1504         /* Return Lisp pointer of new object. */
1505         return ((lispobj) new) | tag;
1506     }
1507 }
1508
1509
1510
1511 \f
1512
1513 /*
1514  * code and code-related objects
1515  */
1516 /*
1517 static lispobj trans_fun_header(lispobj object);
1518 static lispobj trans_boxed(lispobj object);
1519 */
1520
1521 /* Scan a x86 compiled code object, looking for possible fixups that
1522  * have been missed after a move.
1523  *
1524  * Two types of fixups are needed:
1525  * 1. Absolute fixups to within the code object.
1526  * 2. Relative fixups to outside the code object.
1527  *
1528  * Currently only absolute fixups to the constant vector, or to the
1529  * code area are checked. */
1530 void
1531 sniff_code_object(struct code *code, unsigned displacement)
1532 {
1533     int nheader_words, ncode_words, nwords;
1534     void *p;
1535     void *constants_start_addr, *constants_end_addr;
1536     void *code_start_addr, *code_end_addr;
1537     int fixup_found = 0;
1538
1539     if (!check_code_fixups)
1540         return;
1541
1542     ncode_words = fixnum_value(code->code_size);
1543     nheader_words = HeaderValue(*(lispobj *)code);
1544     nwords = ncode_words + nheader_words;
1545
1546     constants_start_addr = (void *)code + 5*4;
1547     constants_end_addr = (void *)code + nheader_words*4;
1548     code_start_addr = (void *)code + nheader_words*4;
1549     code_end_addr = (void *)code + nwords*4;
1550
1551     /* Work through the unboxed code. */
1552     for (p = code_start_addr; p < code_end_addr; p++) {
1553         void *data = *(void **)p;
1554         unsigned d1 = *((unsigned char *)p - 1);
1555         unsigned d2 = *((unsigned char *)p - 2);
1556         unsigned d3 = *((unsigned char *)p - 3);
1557         unsigned d4 = *((unsigned char *)p - 4);
1558 #if QSHOW
1559         unsigned d5 = *((unsigned char *)p - 5);
1560         unsigned d6 = *((unsigned char *)p - 6);
1561 #endif
1562
1563         /* Check for code references. */
1564         /* Check for a 32 bit word that looks like an absolute
1565            reference to within the code adea of the code object. */
1566         if ((data >= (code_start_addr-displacement))
1567             && (data < (code_end_addr-displacement))) {
1568             /* function header */
1569             if ((d4 == 0x5e)
1570                 && (((unsigned)p - 4 - 4*HeaderValue(*((unsigned *)p-1))) == (unsigned)code)) {
1571                 /* Skip the function header */
1572                 p += 6*4 - 4 - 1;
1573                 continue;
1574             }
1575             /* the case of PUSH imm32 */
1576             if (d1 == 0x68) {
1577                 fixup_found = 1;
1578                 FSHOW((stderr,
1579                        "/code ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1580                        p, d6, d5, d4, d3, d2, d1, data));
1581                 FSHOW((stderr, "/PUSH $0x%.8x\n", data));
1582             }
1583             /* the case of MOV [reg-8],imm32 */
1584             if ((d3 == 0xc7)
1585                 && (d2==0x40 || d2==0x41 || d2==0x42 || d2==0x43
1586                     || d2==0x45 || d2==0x46 || d2==0x47)
1587                 && (d1 == 0xf8)) {
1588                 fixup_found = 1;
1589                 FSHOW((stderr,
1590                        "/code ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1591                        p, d6, d5, d4, d3, d2, d1, data));
1592                 FSHOW((stderr, "/MOV [reg-8],$0x%.8x\n", data));
1593             }
1594             /* the case of LEA reg,[disp32] */
1595             if ((d2 == 0x8d) && ((d1 & 0xc7) == 5)) {
1596                 fixup_found = 1;
1597                 FSHOW((stderr,
1598                        "/code ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1599                        p, d6, d5, d4, d3, d2, d1, data));
1600                 FSHOW((stderr,"/LEA reg,[$0x%.8x]\n", data));
1601             }
1602         }
1603
1604         /* Check for constant references. */
1605         /* Check for a 32 bit word that looks like an absolute
1606            reference to within the constant vector. Constant references
1607            will be aligned. */
1608         if ((data >= (constants_start_addr-displacement))
1609             && (data < (constants_end_addr-displacement))
1610             && (((unsigned)data & 0x3) == 0)) {
1611             /*  Mov eax,m32 */
1612             if (d1 == 0xa1) {
1613                 fixup_found = 1;
1614                 FSHOW((stderr,
1615                        "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1616                        p, d6, d5, d4, d3, d2, d1, data));
1617                 FSHOW((stderr,"/MOV eax,0x%.8x\n", data));
1618             }
1619
1620             /*  the case of MOV m32,EAX */
1621             if (d1 == 0xa3) {
1622                 fixup_found = 1;
1623                 FSHOW((stderr,
1624                        "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1625                        p, d6, d5, d4, d3, d2, d1, data));
1626                 FSHOW((stderr, "/MOV 0x%.8x,eax\n", data));
1627             }
1628
1629             /* the case of CMP m32,imm32 */             
1630             if ((d1 == 0x3d) && (d2 == 0x81)) {
1631                 fixup_found = 1;
1632                 FSHOW((stderr,
1633                        "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1634                        p, d6, d5, d4, d3, d2, d1, data));
1635                 /* XX Check this */
1636                 FSHOW((stderr, "/CMP 0x%.8x,immed32\n", data));
1637             }
1638
1639             /* Check for a mod=00, r/m=101 byte. */
1640             if ((d1 & 0xc7) == 5) {
1641                 /* Cmp m32,reg */
1642                 if (d2 == 0x39) {
1643                     fixup_found = 1;
1644                     FSHOW((stderr,
1645                            "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1646                            p, d6, d5, d4, d3, d2, d1, data));
1647                     FSHOW((stderr,"/CMP 0x%.8x,reg\n", data));
1648                 }
1649                 /* the case of CMP reg32,m32 */
1650                 if (d2 == 0x3b) {
1651                     fixup_found = 1;
1652                     FSHOW((stderr,
1653                            "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1654                            p, d6, d5, d4, d3, d2, d1, data));
1655                     FSHOW((stderr, "/CMP reg32,0x%.8x\n", data));
1656                 }
1657                 /* the case of MOV m32,reg32 */
1658                 if (d2 == 0x89) {
1659                     fixup_found = 1;
1660                     FSHOW((stderr,
1661                            "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1662                            p, d6, d5, d4, d3, d2, d1, data));
1663                     FSHOW((stderr, "/MOV 0x%.8x,reg32\n", data));
1664                 }
1665                 /* the case of MOV reg32,m32 */
1666                 if (d2 == 0x8b) {
1667                     fixup_found = 1;
1668                     FSHOW((stderr,
1669                            "/abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1670                            p, d6, d5, d4, d3, d2, d1, data));
1671                     FSHOW((stderr, "/MOV reg32,0x%.8x\n", data));
1672                 }
1673                 /* the case of LEA reg32,m32 */
1674                 if (d2 == 0x8d) {
1675                     fixup_found = 1;
1676                     FSHOW((stderr,
1677                            "abs const ref @%x: %.2x %.2x %.2x %.2x %.2x %.2x (%.8x)\n",
1678                            p, d6, d5, d4, d3, d2, d1, data));
1679                     FSHOW((stderr, "/LEA reg32,0x%.8x\n", data));
1680                 }
1681             }
1682         }
1683     }
1684
1685     /* If anything was found, print some information on the code
1686      * object. */
1687     if (fixup_found) {
1688         FSHOW((stderr,
1689                "/compiled code object at %x: header words = %d, code words = %d\n",
1690                code, nheader_words, ncode_words));
1691         FSHOW((stderr,
1692                "/const start = %x, end = %x\n",
1693                constants_start_addr, constants_end_addr));
1694         FSHOW((stderr,
1695                "/code start = %x, end = %x\n",
1696                code_start_addr, code_end_addr));
1697     }
1698 }
1699
1700 void
1701 gencgc_apply_code_fixups(struct code *old_code, struct code *new_code)
1702 {
1703     int nheader_words, ncode_words, nwords;
1704     void *constants_start_addr, *constants_end_addr;
1705     void *code_start_addr, *code_end_addr;
1706     lispobj fixups = NIL;
1707     unsigned displacement = (unsigned)new_code - (unsigned)old_code;
1708     struct vector *fixups_vector;
1709
1710     ncode_words = fixnum_value(new_code->code_size);
1711     nheader_words = HeaderValue(*(lispobj *)new_code);
1712     nwords = ncode_words + nheader_words;
1713     /* FSHOW((stderr,
1714              "/compiled code object at %x: header words = %d, code words = %d\n",
1715              new_code, nheader_words, ncode_words)); */
1716     constants_start_addr = (void *)new_code + 5*4;
1717     constants_end_addr = (void *)new_code + nheader_words*4;
1718     code_start_addr = (void *)new_code + nheader_words*4;
1719     code_end_addr = (void *)new_code + nwords*4;
1720     /*
1721     FSHOW((stderr,
1722            "/const start = %x, end = %x\n",
1723            constants_start_addr,constants_end_addr));
1724     FSHOW((stderr,
1725            "/code start = %x; end = %x\n",
1726            code_start_addr,code_end_addr));
1727     */
1728
1729     /* The first constant should be a pointer to the fixups for this
1730        code objects. Check. */
1731     fixups = new_code->constants[0];
1732
1733     /* It will be 0 or the unbound-marker if there are no fixups, and
1734      * will be an other pointer if it is valid. */
1735     if ((fixups == 0) || (fixups == UNBOUND_MARKER_WIDETAG) ||
1736         !is_lisp_pointer(fixups)) {
1737         /* Check for possible errors. */
1738         if (check_code_fixups)
1739             sniff_code_object(new_code, displacement);
1740
1741         /*fprintf(stderr,"Fixups for code object not found!?\n");
1742           fprintf(stderr,"*** Compiled code object at %x: header_words=%d code_words=%d .\n",
1743           new_code, nheader_words, ncode_words);
1744           fprintf(stderr,"*** Const. start = %x; end= %x; Code start = %x; end = %x\n",
1745           constants_start_addr,constants_end_addr,
1746           code_start_addr,code_end_addr);*/
1747         return;
1748     }
1749
1750     fixups_vector = (struct vector *)native_pointer(fixups);
1751
1752     /* Could be pointing to a forwarding pointer. */
1753     if (is_lisp_pointer(fixups) &&
1754         (find_page_index((void*)fixups_vector) != -1) &&
1755         (fixups_vector->header == 0x01)) {
1756         /* If so, then follow it. */
1757         /*SHOW("following pointer to a forwarding pointer");*/
1758         fixups_vector = (struct vector *)native_pointer((lispobj)fixups_vector->length);
1759     }
1760
1761     /*SHOW("got fixups");*/
1762
1763     if (widetag_of(fixups_vector->header) ==
1764         SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG) {
1765         /* Got the fixups for the code block. Now work through the vector,
1766            and apply a fixup at each address. */
1767         int length = fixnum_value(fixups_vector->length);
1768         int i;
1769         for (i = 0; i < length; i++) {
1770             unsigned offset = fixups_vector->data[i];
1771             /* Now check the current value of offset. */
1772             unsigned old_value =
1773                 *(unsigned *)((unsigned)code_start_addr + offset);
1774
1775             /* If it's within the old_code object then it must be an
1776              * absolute fixup (relative ones are not saved) */
1777             if ((old_value >= (unsigned)old_code)
1778                 && (old_value < ((unsigned)old_code + nwords*4)))
1779                 /* So add the dispacement. */
1780                 *(unsigned *)((unsigned)code_start_addr + offset) =
1781                     old_value + displacement;
1782             else
1783                 /* It is outside the old code object so it must be a
1784                  * relative fixup (absolute fixups are not saved). So
1785                  * subtract the displacement. */
1786                 *(unsigned *)((unsigned)code_start_addr + offset) =
1787                     old_value - displacement;
1788         }
1789     }
1790
1791     /* Check for possible errors. */
1792     if (check_code_fixups) {
1793         sniff_code_object(new_code,displacement);
1794     }
1795 }
1796
1797
1798 static lispobj
1799 trans_boxed_large(lispobj object)
1800 {
1801     lispobj header;
1802     unsigned long length;
1803
1804     gc_assert(is_lisp_pointer(object));
1805
1806     header = *((lispobj *) native_pointer(object));
1807     length = HeaderValue(header) + 1;
1808     length = CEILING(length, 2);
1809
1810     return copy_large_object(object, length);
1811 }
1812
1813
1814 static lispobj
1815 trans_unboxed_large(lispobj object)
1816 {
1817     lispobj header;
1818     unsigned long length;
1819
1820
1821     gc_assert(is_lisp_pointer(object));
1822
1823     header = *((lispobj *) native_pointer(object));
1824     length = HeaderValue(header) + 1;
1825     length = CEILING(length, 2);
1826
1827     return copy_large_unboxed_object(object, length);
1828 }
1829
1830 \f
1831 /*
1832  * vector-like objects
1833  */
1834
1835
1836 /* FIXME: What does this mean? */
1837 int gencgc_hash = 1;
1838
1839 static int
1840 scav_vector(lispobj *where, lispobj object)
1841 {
1842     unsigned int kv_length;
1843     lispobj *kv_vector;
1844     unsigned int length = 0; /* (0 = dummy to stop GCC warning) */
1845     lispobj *hash_table;
1846     lispobj empty_symbol;
1847     unsigned int *index_vector = NULL; /* (NULL = dummy to stop GCC warning) */
1848     unsigned int *next_vector = NULL; /* (NULL = dummy to stop GCC warning) */
1849     unsigned int *hash_vector = NULL; /* (NULL = dummy to stop GCC warning) */
1850     lispobj weak_p_obj;
1851     unsigned next_vector_length = 0;
1852
1853     /* FIXME: A comment explaining this would be nice. It looks as
1854      * though SB-VM:VECTOR-VALID-HASHING-SUBTYPE is set for EQ-based
1855      * hash tables in the Lisp HASH-TABLE code, and nowhere else. */
1856     if (HeaderValue(object) != subtype_VectorValidHashing)
1857         return 1;
1858
1859     if (!gencgc_hash) {
1860         /* This is set for backward compatibility. FIXME: Do we need
1861          * this any more? */
1862         *where =
1863             (subtype_VectorMustRehash<<N_WIDETAG_BITS) | SIMPLE_VECTOR_WIDETAG;
1864         return 1;
1865     }
1866
1867     kv_length = fixnum_value(where[1]);
1868     kv_vector = where + 2;  /* Skip the header and length. */
1869     /*FSHOW((stderr,"/kv_length = %d\n", kv_length));*/
1870
1871     /* Scavenge element 0, which may be a hash-table structure. */
1872     scavenge(where+2, 1);
1873     if (!is_lisp_pointer(where[2])) {
1874         lose("no pointer at %x in hash table", where[2]);
1875     }
1876     hash_table = (lispobj *)native_pointer(where[2]);
1877     /*FSHOW((stderr,"/hash_table = %x\n", hash_table));*/
1878     if (widetag_of(hash_table[0]) != INSTANCE_HEADER_WIDETAG) {
1879         lose("hash table not instance (%x at %x)", hash_table[0], hash_table);
1880     }
1881
1882     /* Scavenge element 1, which should be some internal symbol that
1883      * the hash table code reserves for marking empty slots. */
1884     scavenge(where+3, 1);
1885     if (!is_lisp_pointer(where[3])) {
1886         lose("not empty-hash-table-slot symbol pointer: %x", where[3]);
1887     }
1888     empty_symbol = where[3];
1889     /* fprintf(stderr,"* empty_symbol = %x\n", empty_symbol);*/
1890     if (widetag_of(*(lispobj *)native_pointer(empty_symbol)) !=
1891         SYMBOL_HEADER_WIDETAG) {
1892         lose("not a symbol where empty-hash-table-slot symbol expected: %x",
1893              *(lispobj *)native_pointer(empty_symbol));
1894     }
1895
1896     /* Scavenge hash table, which will fix the positions of the other
1897      * needed objects. */
1898     scavenge(hash_table, 16);
1899
1900     /* Cross-check the kv_vector. */
1901     if (where != (lispobj *)native_pointer(hash_table[9])) {
1902         lose("hash_table table!=this table %x", hash_table[9]);
1903     }
1904
1905     /* WEAK-P */
1906     weak_p_obj = hash_table[10];
1907
1908     /* index vector */
1909     {
1910         lispobj index_vector_obj = hash_table[13];
1911
1912         if (is_lisp_pointer(index_vector_obj) &&
1913             (widetag_of(*(lispobj *)native_pointer(index_vector_obj)) ==
1914              SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG)) {
1915             index_vector = ((unsigned int *)native_pointer(index_vector_obj)) + 2;
1916             /*FSHOW((stderr, "/index_vector = %x\n",index_vector));*/
1917             length = fixnum_value(((unsigned int *)native_pointer(index_vector_obj))[1]);
1918             /*FSHOW((stderr, "/length = %d\n", length));*/
1919         } else {
1920             lose("invalid index_vector %x", index_vector_obj);
1921         }
1922     }
1923
1924     /* next vector */
1925     {
1926         lispobj next_vector_obj = hash_table[14];
1927
1928         if (is_lisp_pointer(next_vector_obj) &&
1929             (widetag_of(*(lispobj *)native_pointer(next_vector_obj)) ==
1930              SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG)) {
1931             next_vector = ((unsigned int *)native_pointer(next_vector_obj)) + 2;
1932             /*FSHOW((stderr, "/next_vector = %x\n", next_vector));*/
1933             next_vector_length = fixnum_value(((unsigned int *)native_pointer(next_vector_obj))[1]);
1934             /*FSHOW((stderr, "/next_vector_length = %d\n", next_vector_length));*/
1935         } else {
1936             lose("invalid next_vector %x", next_vector_obj);
1937         }
1938     }
1939
1940     /* maybe hash vector */
1941     {
1942         /* FIXME: This bare "15" offset should become a symbolic
1943          * expression of some sort. And all the other bare offsets
1944          * too. And the bare "16" in scavenge(hash_table, 16). And
1945          * probably other stuff too. Ugh.. */
1946         lispobj hash_vector_obj = hash_table[15];
1947
1948         if (is_lisp_pointer(hash_vector_obj) &&
1949             (widetag_of(*(lispobj *)native_pointer(hash_vector_obj))
1950              == SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG)) {
1951             hash_vector = ((unsigned int *)native_pointer(hash_vector_obj)) + 2;
1952             /*FSHOW((stderr, "/hash_vector = %x\n", hash_vector));*/
1953             gc_assert(fixnum_value(((unsigned int *)native_pointer(hash_vector_obj))[1])
1954                       == next_vector_length);
1955         } else {
1956             hash_vector = NULL;
1957             /*FSHOW((stderr, "/no hash_vector: %x\n", hash_vector_obj));*/
1958         }
1959     }
1960
1961     /* These lengths could be different as the index_vector can be a
1962      * different length from the others, a larger index_vector could help
1963      * reduce collisions. */
1964     gc_assert(next_vector_length*2 == kv_length);
1965
1966     /* now all set up.. */
1967
1968     /* Work through the KV vector. */
1969     {
1970         int i;
1971         for (i = 1; i < next_vector_length; i++) {
1972             lispobj old_key = kv_vector[2*i];
1973             unsigned int  old_index = (old_key & 0x1fffffff)%length;
1974
1975             /* Scavenge the key and value. */
1976             scavenge(&kv_vector[2*i],2);
1977
1978             /* Check whether the key has moved and is EQ based. */
1979             {
1980                 lispobj new_key = kv_vector[2*i];
1981                 unsigned int new_index = (new_key & 0x1fffffff)%length;
1982
1983                 if ((old_index != new_index) &&
1984                     ((!hash_vector) || (hash_vector[i] == 0x80000000)) &&
1985                     ((new_key != empty_symbol) ||
1986                      (kv_vector[2*i] != empty_symbol))) {
1987
1988                     /*FSHOW((stderr,
1989                            "* EQ key %d moved from %x to %x; index %d to %d\n",
1990                            i, old_key, new_key, old_index, new_index));*/
1991
1992                     if (index_vector[old_index] != 0) {
1993                         /*FSHOW((stderr, "/P1 %d\n", index_vector[old_index]));*/
1994
1995                         /* Unlink the key from the old_index chain. */
1996                         if (index_vector[old_index] == i) {
1997                             /*FSHOW((stderr, "/P2a %d\n", next_vector[i]));*/
1998                             index_vector[old_index] = next_vector[i];
1999                             /* Link it into the needing rehash chain. */
2000                             next_vector[i] = fixnum_value(hash_table[11]);
2001                             hash_table[11] = make_fixnum(i);
2002                             /*SHOW("P2");*/
2003                         } else {
2004                             unsigned prior = index_vector[old_index];
2005                             unsigned next = next_vector[prior];
2006
2007                             /*FSHOW((stderr, "/P3a %d %d\n", prior, next));*/
2008
2009                             while (next != 0) {
2010                                 /*FSHOW((stderr, "/P3b %d %d\n", prior, next));*/
2011                                 if (next == i) {
2012                                     /* Unlink it. */
2013                                     next_vector[prior] = next_vector[next];
2014                                     /* Link it into the needing rehash
2015                                      * chain. */
2016                                     next_vector[next] =
2017                                         fixnum_value(hash_table[11]);
2018                                     hash_table[11] = make_fixnum(next);
2019                                     /*SHOW("/P3");*/
2020                                     break;
2021                                 }
2022                                 prior = next;
2023                                 next = next_vector[next];
2024                             }
2025                         }
2026                     }
2027                 }
2028             }
2029         }
2030     }
2031     return (CEILING(kv_length + 2, 2));
2032 }
2033
2034
2035 \f
2036 /*
2037  * weak pointers
2038  */
2039
2040 /* XX This is a hack adapted from cgc.c. These don't work too
2041  * efficiently with the gencgc as a list of the weak pointers is
2042  * maintained within the objects which causes writes to the pages. A
2043  * limited attempt is made to avoid unnecessary writes, but this needs
2044  * a re-think. */
2045 #define WEAK_POINTER_NWORDS \
2046     CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
2047
2048 static int
2049 scav_weak_pointer(lispobj *where, lispobj object)
2050 {
2051     struct weak_pointer *wp = weak_pointers;
2052     /* Push the weak pointer onto the list of weak pointers.
2053      * Do I have to watch for duplicates? Originally this was
2054      * part of trans_weak_pointer but that didn't work in the
2055      * case where the WP was in a promoted region.
2056      */
2057
2058     /* Check whether it's already in the list. */
2059     while (wp != NULL) {
2060         if (wp == (struct weak_pointer*)where) {
2061             break;
2062         }
2063         wp = wp->next;
2064     }
2065     if (wp == NULL) {
2066         /* Add it to the start of the list. */
2067         wp = (struct weak_pointer*)where;
2068         if (wp->next != weak_pointers) {
2069             wp->next = weak_pointers;
2070         } else {
2071             /*SHOW("avoided write to weak pointer");*/
2072         }
2073         weak_pointers = wp;
2074     }
2075
2076     /* Do not let GC scavenge the value slot of the weak pointer.
2077      * (That is why it is a weak pointer.) */
2078
2079     return WEAK_POINTER_NWORDS;
2080 }
2081
2082 \f
2083 /* Scan an area looking for an object which encloses the given pointer.
2084  * Return the object start on success or NULL on failure. */
2085 static lispobj *
2086 search_space(lispobj *start, size_t words, lispobj *pointer)
2087 {
2088     while (words > 0) {
2089         size_t count = 1;
2090         lispobj thing = *start;
2091
2092         /* If thing is an immediate then this is a cons. */
2093         if (is_lisp_pointer(thing)
2094             || ((thing & 3) == 0) /* fixnum */
2095             || (widetag_of(thing) == BASE_CHAR_WIDETAG)
2096             || (widetag_of(thing) == UNBOUND_MARKER_WIDETAG))
2097             count = 2;
2098         else
2099             count = (sizetab[widetag_of(thing)])(start);
2100
2101         /* Check whether the pointer is within this object. */
2102         if ((pointer >= start) && (pointer < (start+count))) {
2103             /* found it! */
2104             /*FSHOW((stderr,"/found %x in %x %x\n", pointer, start, thing));*/
2105             return(start);
2106         }
2107
2108         /* Round up the count. */
2109         count = CEILING(count,2);
2110
2111         start += count;
2112         words -= count;
2113     }
2114     return (NULL);
2115 }
2116
2117 static lispobj*
2118 search_read_only_space(lispobj *pointer)
2119 {
2120     lispobj* start = (lispobj*)READ_ONLY_SPACE_START;
2121     lispobj* end = (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0);
2122     if ((pointer < start) || (pointer >= end))
2123         return NULL;
2124     return (search_space(start, (pointer+2)-start, pointer));
2125 }
2126
2127 static lispobj *
2128 search_static_space(lispobj *pointer)
2129 {
2130     lispobj* start = (lispobj*)STATIC_SPACE_START;
2131     lispobj* end = (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER,0);
2132     if ((pointer < start) || (pointer >= end))
2133         return NULL;
2134     return (search_space(start, (pointer+2)-start, pointer));
2135 }
2136
2137 /* a faster version for searching the dynamic space. This will work even
2138  * if the object is in a current allocation region. */
2139 lispobj *
2140 search_dynamic_space(lispobj *pointer)
2141 {
2142     int  page_index = find_page_index(pointer);
2143     lispobj *start;
2144
2145     /* The address may be invalid, so do some checks. */
2146     if ((page_index == -1) || (page_table[page_index].allocated == FREE_PAGE))
2147         return NULL;
2148     start = (lispobj *)((void *)page_address(page_index)
2149                         + page_table[page_index].first_object_offset);
2150     return (search_space(start, (pointer+2)-start, pointer));
2151 }
2152
2153 /* Is there any possibility that pointer is a valid Lisp object
2154  * reference, and/or something else (e.g. subroutine call return
2155  * address) which should prevent us from moving the referred-to thing?
2156  * This is called from preserve_pointers() */
2157 static int
2158 possibly_valid_dynamic_space_pointer(lispobj *pointer)
2159 {
2160     lispobj *start_addr;
2161
2162     /* Find the object start address. */
2163     if ((start_addr = search_dynamic_space(pointer)) == NULL) {
2164         return 0;
2165     }
2166
2167     /* We need to allow raw pointers into Code objects for return
2168      * addresses. This will also pick up pointers to functions in code
2169      * objects. */
2170     if (widetag_of(*start_addr) == CODE_HEADER_WIDETAG) {
2171         /* XXX could do some further checks here */
2172         return 1;
2173     }
2174
2175     /* If it's not a return address then it needs to be a valid Lisp
2176      * pointer. */
2177     if (!is_lisp_pointer((lispobj)pointer)) {
2178         return 0;
2179     }
2180
2181     /* Check that the object pointed to is consistent with the pointer
2182      * low tag.
2183      */
2184     switch (lowtag_of((lispobj)pointer)) {
2185     case FUN_POINTER_LOWTAG:
2186         /* Start_addr should be the enclosing code object, or a closure
2187          * header. */
2188         switch (widetag_of(*start_addr)) {
2189         case CODE_HEADER_WIDETAG:
2190             /* This case is probably caught above. */
2191             break;
2192         case CLOSURE_HEADER_WIDETAG:
2193         case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
2194             if ((unsigned)pointer !=
2195                 ((unsigned)start_addr+FUN_POINTER_LOWTAG)) {
2196                 if (gencgc_verbose)
2197                     FSHOW((stderr,
2198                            "/Wf2: %x %x %x\n",
2199                            pointer, start_addr, *start_addr));
2200                 return 0;
2201             }
2202             break;
2203         default:
2204             if (gencgc_verbose)
2205                 FSHOW((stderr,
2206                        "/Wf3: %x %x %x\n",
2207                        pointer, start_addr, *start_addr));
2208             return 0;
2209         }
2210         break;
2211     case LIST_POINTER_LOWTAG:
2212         if ((unsigned)pointer !=
2213             ((unsigned)start_addr+LIST_POINTER_LOWTAG)) {
2214             if (gencgc_verbose)
2215                 FSHOW((stderr,
2216                        "/Wl1: %x %x %x\n",
2217                        pointer, start_addr, *start_addr));
2218             return 0;
2219         }
2220         /* Is it plausible cons? */
2221         if ((is_lisp_pointer(start_addr[0])
2222             || ((start_addr[0] & 3) == 0) /* fixnum */
2223             || (widetag_of(start_addr[0]) == BASE_CHAR_WIDETAG)
2224             || (widetag_of(start_addr[0]) == UNBOUND_MARKER_WIDETAG))
2225            && (is_lisp_pointer(start_addr[1])
2226                || ((start_addr[1] & 3) == 0) /* fixnum */
2227                || (widetag_of(start_addr[1]) == BASE_CHAR_WIDETAG)
2228                || (widetag_of(start_addr[1]) == UNBOUND_MARKER_WIDETAG)))
2229             break;
2230         else {
2231             if (gencgc_verbose)
2232                 FSHOW((stderr,
2233                        "/Wl2: %x %x %x\n",
2234                        pointer, start_addr, *start_addr));
2235             return 0;
2236         }
2237     case INSTANCE_POINTER_LOWTAG:
2238         if ((unsigned)pointer !=
2239             ((unsigned)start_addr+INSTANCE_POINTER_LOWTAG)) {
2240             if (gencgc_verbose)
2241                 FSHOW((stderr,
2242                        "/Wi1: %x %x %x\n",
2243                        pointer, start_addr, *start_addr));
2244             return 0;
2245         }
2246         if (widetag_of(start_addr[0]) != INSTANCE_HEADER_WIDETAG) {
2247             if (gencgc_verbose)
2248                 FSHOW((stderr,
2249                        "/Wi2: %x %x %x\n",
2250                        pointer, start_addr, *start_addr));
2251             return 0;
2252         }
2253         break;
2254     case OTHER_POINTER_LOWTAG:
2255         if ((unsigned)pointer !=
2256             ((int)start_addr+OTHER_POINTER_LOWTAG)) {
2257             if (gencgc_verbose)
2258                 FSHOW((stderr,
2259                        "/Wo1: %x %x %x\n",
2260                        pointer, start_addr, *start_addr));
2261             return 0;
2262         }
2263         /* Is it plausible?  Not a cons. XXX should check the headers. */
2264         if (is_lisp_pointer(start_addr[0]) || ((start_addr[0] & 3) == 0)) {
2265             if (gencgc_verbose)
2266                 FSHOW((stderr,
2267                        "/Wo2: %x %x %x\n",
2268                        pointer, start_addr, *start_addr));
2269             return 0;
2270         }
2271         switch (widetag_of(start_addr[0])) {
2272         case UNBOUND_MARKER_WIDETAG:
2273         case BASE_CHAR_WIDETAG:
2274             if (gencgc_verbose)
2275                 FSHOW((stderr,
2276                        "*Wo3: %x %x %x\n",
2277                        pointer, start_addr, *start_addr));
2278             return 0;
2279
2280             /* only pointed to by function pointers? */
2281         case CLOSURE_HEADER_WIDETAG:
2282         case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
2283             if (gencgc_verbose)
2284                 FSHOW((stderr,
2285                        "*Wo4: %x %x %x\n",
2286                        pointer, start_addr, *start_addr));
2287             return 0;
2288
2289         case INSTANCE_HEADER_WIDETAG:
2290             if (gencgc_verbose)
2291                 FSHOW((stderr,
2292                        "*Wo5: %x %x %x\n",
2293                        pointer, start_addr, *start_addr));
2294             return 0;
2295
2296             /* the valid other immediate pointer objects */
2297         case SIMPLE_VECTOR_WIDETAG:
2298         case RATIO_WIDETAG:
2299         case COMPLEX_WIDETAG:
2300 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
2301         case COMPLEX_SINGLE_FLOAT_WIDETAG:
2302 #endif
2303 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
2304         case COMPLEX_DOUBLE_FLOAT_WIDETAG:
2305 #endif
2306 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
2307         case COMPLEX_LONG_FLOAT_WIDETAG:
2308 #endif
2309         case SIMPLE_ARRAY_WIDETAG:
2310         case COMPLEX_BASE_STRING_WIDETAG:
2311         case COMPLEX_VECTOR_NIL_WIDETAG:
2312         case COMPLEX_BIT_VECTOR_WIDETAG:
2313         case COMPLEX_VECTOR_WIDETAG:
2314         case COMPLEX_ARRAY_WIDETAG:
2315         case VALUE_CELL_HEADER_WIDETAG:
2316         case SYMBOL_HEADER_WIDETAG:
2317         case FDEFN_WIDETAG:
2318         case CODE_HEADER_WIDETAG:
2319         case BIGNUM_WIDETAG:
2320         case SINGLE_FLOAT_WIDETAG:
2321         case DOUBLE_FLOAT_WIDETAG:
2322 #ifdef LONG_FLOAT_WIDETAG
2323         case LONG_FLOAT_WIDETAG:
2324 #endif
2325         case SIMPLE_BASE_STRING_WIDETAG:
2326         case SIMPLE_BIT_VECTOR_WIDETAG:
2327         case SIMPLE_ARRAY_NIL_WIDETAG:
2328         case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
2329         case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
2330         case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
2331         case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
2332         case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
2333         case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
2334         case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
2335         case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
2336         case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
2337 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
2338         case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
2339 #endif
2340 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
2341         case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
2342 #endif
2343 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
2344         case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
2345 #endif
2346 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
2347         case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
2348 #endif
2349         case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
2350         case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
2351 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
2352         case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
2353 #endif
2354 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
2355         case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
2356 #endif
2357 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
2358         case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
2359 #endif
2360 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
2361         case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
2362 #endif
2363         case SAP_WIDETAG:
2364         case WEAK_POINTER_WIDETAG:
2365             break;
2366
2367         default:
2368             if (gencgc_verbose)
2369                 FSHOW((stderr,
2370                        "/Wo6: %x %x %x\n",
2371                        pointer, start_addr, *start_addr));
2372             return 0;
2373         }
2374         break;
2375     default:
2376         if (gencgc_verbose)
2377             FSHOW((stderr,
2378                    "*W?: %x %x %x\n",
2379                    pointer, start_addr, *start_addr));
2380         return 0;
2381     }
2382
2383     /* looks good */
2384     return 1;
2385 }
2386
2387 /* Adjust large bignum and vector objects. This will adjust the
2388  * allocated region if the size has shrunk, and move unboxed objects
2389  * into unboxed pages. The pages are not promoted here, and the
2390  * promoted region is not added to the new_regions; this is really
2391  * only designed to be called from preserve_pointer(). Shouldn't fail
2392  * if this is missed, just may delay the moving of objects to unboxed
2393  * pages, and the freeing of pages. */
2394 static void
2395 maybe_adjust_large_object(lispobj *where)
2396 {
2397     int first_page;
2398     int nwords;
2399
2400     int remaining_bytes;
2401     int next_page;
2402     int bytes_freed;
2403     int old_bytes_used;
2404
2405     int boxed;
2406
2407     /* Check whether it's a vector or bignum object. */
2408     switch (widetag_of(where[0])) {
2409     case SIMPLE_VECTOR_WIDETAG:
2410         boxed = BOXED_PAGE;
2411         break;
2412     case BIGNUM_WIDETAG:
2413     case SIMPLE_BASE_STRING_WIDETAG:
2414     case SIMPLE_BIT_VECTOR_WIDETAG:
2415     case SIMPLE_ARRAY_NIL_WIDETAG:
2416     case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
2417     case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
2418     case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
2419     case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
2420     case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
2421     case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
2422     case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
2423     case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
2424     case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
2425 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
2426     case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
2427 #endif
2428 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
2429     case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
2430 #endif
2431 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
2432     case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
2433 #endif
2434 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
2435     case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
2436 #endif
2437     case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
2438     case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
2439 #ifdef SIMPLE_ARRAY_LONG_FLOAT_WIDETAG
2440     case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
2441 #endif
2442 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
2443     case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
2444 #endif
2445 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
2446     case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
2447 #endif
2448 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
2449     case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
2450 #endif
2451         boxed = UNBOXED_PAGE;
2452         break;
2453     default:
2454         return;
2455     }
2456
2457     /* Find its current size. */
2458     nwords = (sizetab[widetag_of(where[0])])(where);
2459
2460     first_page = find_page_index((void *)where);
2461     gc_assert(first_page >= 0);
2462
2463     /* Note: Any page write-protection must be removed, else a later
2464      * scavenge_newspace may incorrectly not scavenge these pages.
2465      * This would not be necessary if they are added to the new areas,
2466      * but lets do it for them all (they'll probably be written
2467      * anyway?). */
2468
2469     gc_assert(page_table[first_page].first_object_offset == 0);
2470
2471     next_page = first_page;
2472     remaining_bytes = nwords*4;
2473     while (remaining_bytes > PAGE_BYTES) {
2474         gc_assert(page_table[next_page].gen == from_space);
2475         gc_assert((page_table[next_page].allocated == BOXED_PAGE)
2476                   || (page_table[next_page].allocated == UNBOXED_PAGE));
2477         gc_assert(page_table[next_page].large_object);
2478         gc_assert(page_table[next_page].first_object_offset ==
2479                   -PAGE_BYTES*(next_page-first_page));
2480         gc_assert(page_table[next_page].bytes_used == PAGE_BYTES);
2481
2482         page_table[next_page].allocated = boxed;
2483
2484         /* Shouldn't be write-protected at this stage. Essential that the
2485          * pages aren't. */
2486         gc_assert(!page_table[next_page].write_protected);
2487         remaining_bytes -= PAGE_BYTES;
2488         next_page++;
2489     }
2490
2491     /* Now only one page remains, but the object may have shrunk so
2492      * there may be more unused pages which will be freed. */
2493
2494     /* Object may have shrunk but shouldn't have grown - check. */
2495     gc_assert(page_table[next_page].bytes_used >= remaining_bytes);
2496
2497     page_table[next_page].allocated = boxed;
2498     gc_assert(page_table[next_page].allocated ==
2499               page_table[first_page].allocated);
2500
2501     /* Adjust the bytes_used. */
2502     old_bytes_used = page_table[next_page].bytes_used;
2503     page_table[next_page].bytes_used = remaining_bytes;
2504
2505     bytes_freed = old_bytes_used - remaining_bytes;
2506
2507     /* Free any remaining pages; needs care. */
2508     next_page++;
2509     while ((old_bytes_used == PAGE_BYTES) &&
2510            (page_table[next_page].gen == from_space) &&
2511            ((page_table[next_page].allocated == UNBOXED_PAGE)
2512             || (page_table[next_page].allocated == BOXED_PAGE)) &&
2513            page_table[next_page].large_object &&
2514            (page_table[next_page].first_object_offset ==
2515             -(next_page - first_page)*PAGE_BYTES)) {
2516         /* It checks out OK, free the page. We don't need to both zeroing
2517          * pages as this should have been done before shrinking the
2518          * object. These pages shouldn't be write protected as they
2519          * should be zero filled. */
2520         gc_assert(page_table[next_page].write_protected == 0);
2521
2522         old_bytes_used = page_table[next_page].bytes_used;
2523         page_table[next_page].allocated = FREE_PAGE;
2524         page_table[next_page].bytes_used = 0;
2525         bytes_freed += old_bytes_used;
2526         next_page++;
2527     }
2528
2529     if ((bytes_freed > 0) && gencgc_verbose) {
2530         FSHOW((stderr,
2531                "/maybe_adjust_large_object() freed %d\n",
2532                bytes_freed));
2533     }
2534
2535     generations[from_space].bytes_allocated -= bytes_freed;
2536     bytes_allocated -= bytes_freed;
2537
2538     return;
2539 }
2540
2541 /* Take a possible pointer to a Lisp object and mark its page in the
2542  * page_table so that it will not be relocated during a GC.
2543  *
2544  * This involves locating the page it points to, then backing up to
2545  * the first page that has its first object start at offset 0, and
2546  * then marking all pages dont_move from the first until a page that
2547  * ends by being full, or having free gen.
2548  *
2549  * This ensures that objects spanning pages are not broken.
2550  *
2551  * It is assumed that all the page static flags have been cleared at
2552  * the start of a GC.
2553  *
2554  * It is also assumed that the current gc_alloc() region has been
2555  * flushed and the tables updated. */
2556 static void
2557 preserve_pointer(void *addr)
2558 {
2559     int addr_page_index = find_page_index(addr);
2560     int first_page;
2561     int i;
2562     unsigned region_allocation;
2563
2564     /* quick check 1: Address is quite likely to have been invalid. */
2565     if ((addr_page_index == -1)
2566         || (page_table[addr_page_index].allocated == FREE_PAGE)
2567         || (page_table[addr_page_index].bytes_used == 0)
2568         || (page_table[addr_page_index].gen != from_space)
2569         /* Skip if already marked dont_move. */
2570         || (page_table[addr_page_index].dont_move != 0))
2571         return;
2572     gc_assert(!(page_table[addr_page_index].allocated & OPEN_REGION_PAGE));
2573     /* (Now that we know that addr_page_index is in range, it's
2574      * safe to index into page_table[] with it.) */
2575     region_allocation = page_table[addr_page_index].allocated;
2576
2577     /* quick check 2: Check the offset within the page.
2578      *
2579      */
2580     if (((unsigned)addr & (PAGE_BYTES - 1)) > page_table[addr_page_index].bytes_used)
2581         return;
2582
2583     /* Filter out anything which can't be a pointer to a Lisp object
2584      * (or, as a special case which also requires dont_move, a return
2585      * address referring to something in a CodeObject). This is
2586      * expensive but important, since it vastly reduces the
2587      * probability that random garbage will be bogusly interpreted as
2588      * a pointer which prevents a page from moving. */
2589     if (!(possibly_valid_dynamic_space_pointer(addr)))
2590         return;
2591     first_page = addr_page_index;
2592
2593     /* Work backwards to find a page with a first_object_offset of 0.
2594      * The pages should be contiguous with all bytes used in the same
2595      * gen. Assumes the first_object_offset is negative or zero. */
2596
2597     /* this is probably needlessly conservative.  The first object in
2598      * the page may not even be the one we were passed a pointer to:
2599      * if this is the case, we will write-protect all the previous
2600      * object's pages too.
2601      */
2602
2603     while (page_table[first_page].first_object_offset != 0) {
2604         --first_page;
2605         /* Do some checks. */
2606         gc_assert(page_table[first_page].bytes_used == PAGE_BYTES);
2607         gc_assert(page_table[first_page].gen == from_space);
2608         gc_assert(page_table[first_page].allocated == region_allocation);
2609     }
2610
2611     /* Adjust any large objects before promotion as they won't be
2612      * copied after promotion. */
2613     if (page_table[first_page].large_object) {
2614         maybe_adjust_large_object(page_address(first_page));
2615         /* If a large object has shrunk then addr may now point to a
2616          * free area in which case it's ignored here. Note it gets
2617          * through the valid pointer test above because the tail looks
2618          * like conses. */
2619         if ((page_table[addr_page_index].allocated == FREE_PAGE)
2620             || (page_table[addr_page_index].bytes_used == 0)
2621             /* Check the offset within the page. */
2622             || (((unsigned)addr & (PAGE_BYTES - 1))
2623                 > page_table[addr_page_index].bytes_used)) {
2624             FSHOW((stderr,
2625                    "weird? ignore ptr 0x%x to freed area of large object\n",
2626                    addr));
2627             return;
2628         }
2629         /* It may have moved to unboxed pages. */
2630         region_allocation = page_table[first_page].allocated;
2631     }
2632
2633     /* Now work forward until the end of this contiguous area is found,
2634      * marking all pages as dont_move. */
2635     for (i = first_page; ;i++) {
2636         gc_assert(page_table[i].allocated == region_allocation);
2637
2638         /* Mark the page static. */
2639         page_table[i].dont_move = 1;
2640
2641         /* Move the page to the new_space. XX I'd rather not do this
2642          * but the GC logic is not quite able to copy with the static
2643          * pages remaining in the from space. This also requires the
2644          * generation bytes_allocated counters be updated. */
2645         page_table[i].gen = new_space;
2646         generations[new_space].bytes_allocated += page_table[i].bytes_used;
2647         generations[from_space].bytes_allocated -= page_table[i].bytes_used;
2648
2649         /* It is essential that the pages are not write protected as
2650          * they may have pointers into the old-space which need
2651          * scavenging. They shouldn't be write protected at this
2652          * stage. */
2653         gc_assert(!page_table[i].write_protected);
2654
2655         /* Check whether this is the last page in this contiguous block.. */
2656         if ((page_table[i].bytes_used < PAGE_BYTES)
2657             /* ..or it is PAGE_BYTES and is the last in the block */
2658             || (page_table[i+1].allocated == FREE_PAGE)
2659             || (page_table[i+1].bytes_used == 0) /* next page free */
2660             || (page_table[i+1].gen != from_space) /* diff. gen */
2661             || (page_table[i+1].first_object_offset == 0))
2662             break;
2663     }
2664
2665     /* Check that the page is now static. */
2666     gc_assert(page_table[addr_page_index].dont_move != 0);
2667 }
2668 \f
2669 /* If the given page is not write-protected, then scan it for pointers
2670  * to younger generations or the top temp. generation, if no
2671  * suspicious pointers are found then the page is write-protected.
2672  *
2673  * Care is taken to check for pointers to the current gc_alloc()
2674  * region if it is a younger generation or the temp. generation. This
2675  * frees the caller from doing a gc_alloc_update_page_tables(). Actually
2676  * the gc_alloc_generation does not need to be checked as this is only
2677  * called from scavenge_generation() when the gc_alloc generation is
2678  * younger, so it just checks if there is a pointer to the current
2679  * region.
2680  *
2681  * We return 1 if the page was write-protected, else 0. */
2682 static int
2683 update_page_write_prot(int page)
2684 {
2685     int gen = page_table[page].gen;
2686     int j;
2687     int wp_it = 1;
2688     void **page_addr = (void **)page_address(page);
2689     int num_words = page_table[page].bytes_used / 4;
2690
2691     /* Shouldn't be a free page. */
2692     gc_assert(page_table[page].allocated != FREE_PAGE);
2693     gc_assert(page_table[page].bytes_used != 0);
2694
2695     /* Skip if it's already write-protected, pinned, or unboxed */
2696     if (page_table[page].write_protected
2697         || page_table[page].dont_move
2698         || (page_table[page].allocated & UNBOXED_PAGE))
2699         return (0);
2700
2701     /* Scan the page for pointers to younger generations or the
2702      * top temp. generation. */
2703
2704     for (j = 0; j < num_words; j++) {
2705         void *ptr = *(page_addr+j);
2706         int index = find_page_index(ptr);
2707
2708         /* Check that it's in the dynamic space */
2709         if (index != -1)
2710             if (/* Does it point to a younger or the temp. generation? */
2711                 ((page_table[index].allocated != FREE_PAGE)
2712                  && (page_table[index].bytes_used != 0)
2713                  && ((page_table[index].gen < gen)
2714                      || (page_table[index].gen == NUM_GENERATIONS)))
2715
2716                 /* Or does it point within a current gc_alloc() region? */
2717                 || ((boxed_region.start_addr <= ptr)
2718                     && (ptr <= boxed_region.free_pointer))
2719                 || ((unboxed_region.start_addr <= ptr)
2720                     && (ptr <= unboxed_region.free_pointer))) {
2721                 wp_it = 0;
2722                 break;
2723             }
2724     }
2725
2726     if (wp_it == 1) {
2727         /* Write-protect the page. */
2728         /*FSHOW((stderr, "/write-protecting page %d gen %d\n", page, gen));*/
2729
2730         os_protect((void *)page_addr,
2731                    PAGE_BYTES,
2732                    OS_VM_PROT_READ|OS_VM_PROT_EXECUTE);
2733
2734         /* Note the page as protected in the page tables. */
2735         page_table[page].write_protected = 1;
2736     }
2737
2738     return (wp_it);
2739 }
2740
2741 /* Scavenge a generation.
2742  *
2743  * This will not resolve all pointers when generation is the new
2744  * space, as new objects may be added which are not check here - use
2745  * scavenge_newspace generation.
2746  *
2747  * Write-protected pages should not have any pointers to the
2748  * from_space so do need scavenging; thus write-protected pages are
2749  * not always scavenged. There is some code to check that these pages
2750  * are not written; but to check fully the write-protected pages need
2751  * to be scavenged by disabling the code to skip them.
2752  *
2753  * Under the current scheme when a generation is GCed the younger
2754  * generations will be empty. So, when a generation is being GCed it
2755  * is only necessary to scavenge the older generations for pointers
2756  * not the younger. So a page that does not have pointers to younger
2757  * generations does not need to be scavenged.
2758  *
2759  * The write-protection can be used to note pages that don't have
2760  * pointers to younger pages. But pages can be written without having
2761  * pointers to younger generations. After the pages are scavenged here
2762  * they can be scanned for pointers to younger generations and if
2763  * there are none the page can be write-protected.
2764  *
2765  * One complication is when the newspace is the top temp. generation.
2766  *
2767  * Enabling SC_GEN_CK scavenges the write-protected pages and checks
2768  * that none were written, which they shouldn't be as they should have
2769  * no pointers to younger generations. This breaks down for weak
2770  * pointers as the objects contain a link to the next and are written
2771  * if a weak pointer is scavenged. Still it's a useful check. */
2772 static void
2773 scavenge_generation(int generation)
2774 {
2775     int i;
2776     int num_wp = 0;
2777
2778 #define SC_GEN_CK 0
2779 #if SC_GEN_CK
2780     /* Clear the write_protected_cleared flags on all pages. */
2781     for (i = 0; i < NUM_PAGES; i++)
2782         page_table[i].write_protected_cleared = 0;
2783 #endif
2784
2785     for (i = 0; i < last_free_page; i++) {
2786         if ((page_table[i].allocated & BOXED_PAGE)
2787             && (page_table[i].bytes_used != 0)
2788             && (page_table[i].gen == generation)) {
2789             int last_page;
2790
2791             /* This should be the start of a contiguous block. */
2792             gc_assert(page_table[i].first_object_offset == 0);
2793
2794             /* We need to find the full extent of this contiguous
2795              * block in case objects span pages. */
2796
2797             /* Now work forward until the end of this contiguous area
2798              * is found. A small area is preferred as there is a
2799              * better chance of its pages being write-protected. */
2800             for (last_page = i; ; last_page++)
2801                 /* Check whether this is the last page in this contiguous
2802                  * block. */
2803                 if ((page_table[last_page].bytes_used < PAGE_BYTES)
2804                     /* Or it is PAGE_BYTES and is the last in the block */
2805                     || (!(page_table[last_page+1].allocated & BOXED_PAGE))
2806                     || (page_table[last_page+1].bytes_used == 0)
2807                     || (page_table[last_page+1].gen != generation)
2808                     || (page_table[last_page+1].first_object_offset == 0))
2809                     break;
2810
2811             /* Do a limited check for write_protected pages. If all pages
2812              * are write_protected then there is no need to scavenge. */
2813             {
2814                 int j, all_wp = 1;
2815                 for (j = i; j <= last_page; j++)
2816                     if (page_table[j].write_protected == 0) {
2817                         all_wp = 0;
2818                         break;
2819                     }
2820 #if !SC_GEN_CK
2821                 if (all_wp == 0)
2822 #endif
2823                     {
2824                         scavenge(page_address(i), (page_table[last_page].bytes_used
2825                                                    + (last_page-i)*PAGE_BYTES)/4);
2826
2827                         /* Now scan the pages and write protect those
2828                          * that don't have pointers to younger
2829                          * generations. */
2830                         if (enable_page_protection) {
2831                             for (j = i; j <= last_page; j++) {
2832                                 num_wp += update_page_write_prot(j);
2833                             }
2834                         }
2835                     }
2836             }
2837             i = last_page;
2838         }
2839     }
2840
2841     if ((gencgc_verbose > 1) && (num_wp != 0)) {
2842         FSHOW((stderr,
2843                "/write protected %d pages within generation %d\n",
2844                num_wp, generation));
2845     }
2846
2847 #if SC_GEN_CK
2848     /* Check that none of the write_protected pages in this generation
2849      * have been written to. */
2850     for (i = 0; i < NUM_PAGES; i++) {
2851         if ((page_table[i].allocation ! =FREE_PAGE)
2852             && (page_table[i].bytes_used != 0)
2853             && (page_table[i].gen == generation)
2854             && (page_table[i].write_protected_cleared != 0)) {
2855             FSHOW((stderr, "/scavenge_generation() %d\n", generation));
2856             FSHOW((stderr,
2857                    "/page bytes_used=%d first_object_offset=%d dont_move=%d\n",
2858                     page_table[i].bytes_used,
2859                     page_table[i].first_object_offset,
2860                     page_table[i].dont_move));
2861             lose("write to protected page %d in scavenge_generation()", i);
2862         }
2863     }
2864 #endif
2865 }
2866
2867 \f
2868 /* Scavenge a newspace generation. As it is scavenged new objects may
2869  * be allocated to it; these will also need to be scavenged. This
2870  * repeats until there are no more objects unscavenged in the
2871  * newspace generation.
2872  *
2873  * To help improve the efficiency, areas written are recorded by
2874  * gc_alloc() and only these scavenged. Sometimes a little more will be
2875  * scavenged, but this causes no harm. An easy check is done that the
2876  * scavenged bytes equals the number allocated in the previous
2877  * scavenge.
2878  *
2879  * Write-protected pages are not scanned except if they are marked
2880  * dont_move in which case they may have been promoted and still have
2881  * pointers to the from space.
2882  *
2883  * Write-protected pages could potentially be written by alloc however
2884  * to avoid having to handle re-scavenging of write-protected pages
2885  * gc_alloc() does not write to write-protected pages.
2886  *
2887  * New areas of objects allocated are recorded alternatively in the two
2888  * new_areas arrays below. */
2889 static struct new_area new_areas_1[NUM_NEW_AREAS];
2890 static struct new_area new_areas_2[NUM_NEW_AREAS];
2891
2892 /* Do one full scan of the new space generation. This is not enough to
2893  * complete the job as new objects may be added to the generation in
2894  * the process which are not scavenged. */
2895 static void
2896 scavenge_newspace_generation_one_scan(int generation)
2897 {
2898     int i;
2899
2900     FSHOW((stderr,
2901            "/starting one full scan of newspace generation %d\n",
2902            generation));
2903     for (i = 0; i < last_free_page; i++) {
2904         /* note that this skips over open regions when it encounters them */
2905         if ((page_table[i].allocated == BOXED_PAGE)
2906             && (page_table[i].bytes_used != 0)
2907             && (page_table[i].gen == generation)
2908             && ((page_table[i].write_protected == 0)
2909                 /* (This may be redundant as write_protected is now
2910                  * cleared before promotion.) */
2911                 || (page_table[i].dont_move == 1))) {
2912             int last_page;
2913
2914             /* The scavenge will start at the first_object_offset of page i.
2915              *
2916              * We need to find the full extent of this contiguous
2917              * block in case objects span pages.
2918              *
2919              * Now work forward until the end of this contiguous area
2920              * is found. A small area is preferred as there is a
2921              * better chance of its pages being write-protected. */
2922             for (last_page = i; ;last_page++) {
2923                 /* Check whether this is the last page in this
2924                  * contiguous block */
2925                 if ((page_table[last_page].bytes_used < PAGE_BYTES)
2926                     /* Or it is PAGE_BYTES and is the last in the block */
2927                     || (!(page_table[last_page+1].allocated & BOXED_PAGE))
2928                     || (page_table[last_page+1].bytes_used == 0)
2929                     || (page_table[last_page+1].gen != generation)
2930                     || (page_table[last_page+1].first_object_offset == 0))
2931                     break;
2932             }
2933
2934             /* Do a limited check for write-protected pages. If all
2935              * pages are write-protected then no need to scavenge,
2936              * except if the pages are marked dont_move. */
2937             {
2938                 int j, all_wp = 1;
2939                 for (j = i; j <= last_page; j++)
2940                     if ((page_table[j].write_protected == 0)
2941                         || (page_table[j].dont_move != 0)) {
2942                         all_wp = 0;
2943                         break;
2944                     }
2945
2946                 if (!all_wp) {
2947                     int size;
2948
2949                     /* Calculate the size. */
2950                     if (last_page == i)
2951                         size = (page_table[last_page].bytes_used
2952                                 - page_table[i].first_object_offset)/4;
2953                     else
2954                         size = (page_table[last_page].bytes_used
2955                                 + (last_page-i)*PAGE_BYTES
2956                                 - page_table[i].first_object_offset)/4;
2957                     
2958                     {
2959                         new_areas_ignore_page = last_page;
2960                         
2961                         scavenge(page_address(i) +
2962                                  page_table[i].first_object_offset,
2963                                  size);
2964
2965                     }
2966                 }
2967             }
2968
2969             i = last_page;
2970         }
2971     }
2972     FSHOW((stderr,
2973            "/done with one full scan of newspace generation %d\n",
2974            generation));
2975 }
2976
2977 /* Do a complete scavenge of the newspace generation. */
2978 static void
2979 scavenge_newspace_generation(int generation)
2980 {
2981     int i;
2982
2983     /* the new_areas array currently being written to by gc_alloc() */
2984     struct new_area (*current_new_areas)[] = &new_areas_1;
2985     int current_new_areas_index;
2986
2987     /* the new_areas created but the previous scavenge cycle */
2988     struct new_area (*previous_new_areas)[] = NULL;
2989     int previous_new_areas_index;
2990
2991     /* Flush the current regions updating the tables. */
2992     gc_alloc_update_all_page_tables();
2993
2994     /* Turn on the recording of new areas by gc_alloc(). */
2995     new_areas = current_new_areas;
2996     new_areas_index = 0;
2997
2998     /* Don't need to record new areas that get scavenged anyway during
2999      * scavenge_newspace_generation_one_scan. */
3000     record_new_objects = 1;
3001
3002     /* Start with a full scavenge. */
3003     scavenge_newspace_generation_one_scan(generation);
3004
3005     /* Record all new areas now. */
3006     record_new_objects = 2;
3007
3008     /* Flush the current regions updating the tables. */
3009     gc_alloc_update_all_page_tables();
3010
3011     /* Grab new_areas_index. */
3012     current_new_areas_index = new_areas_index;
3013
3014     /*FSHOW((stderr,
3015              "The first scan is finished; current_new_areas_index=%d.\n",
3016              current_new_areas_index));*/
3017
3018     while (current_new_areas_index > 0) {
3019         /* Move the current to the previous new areas */
3020         previous_new_areas = current_new_areas;
3021         previous_new_areas_index = current_new_areas_index;
3022
3023         /* Scavenge all the areas in previous new areas. Any new areas
3024          * allocated are saved in current_new_areas. */
3025
3026         /* Allocate an array for current_new_areas; alternating between
3027          * new_areas_1 and 2 */
3028         if (previous_new_areas == &new_areas_1)
3029             current_new_areas = &new_areas_2;
3030         else
3031             current_new_areas = &new_areas_1;
3032
3033         /* Set up for gc_alloc(). */
3034         new_areas = current_new_areas;
3035         new_areas_index = 0;
3036
3037         /* Check whether previous_new_areas had overflowed. */
3038         if (previous_new_areas_index >= NUM_NEW_AREAS) {
3039
3040             /* New areas of objects allocated have been lost so need to do a
3041              * full scan to be sure! If this becomes a problem try
3042              * increasing NUM_NEW_AREAS. */
3043             if (gencgc_verbose)
3044                 SHOW("new_areas overflow, doing full scavenge");
3045
3046             /* Don't need to record new areas that get scavenge anyway
3047              * during scavenge_newspace_generation_one_scan. */
3048             record_new_objects = 1;
3049
3050             scavenge_newspace_generation_one_scan(generation);
3051
3052             /* Record all new areas now. */
3053             record_new_objects = 2;
3054
3055             /* Flush the current regions updating the tables. */
3056             gc_alloc_update_all_page_tables();
3057
3058         } else {
3059
3060             /* Work through previous_new_areas. */
3061             for (i = 0; i < previous_new_areas_index; i++) {
3062                 /* FIXME: All these bare *4 and /4 should be something
3063                  * like BYTES_PER_WORD or WBYTES. */
3064                 int page = (*previous_new_areas)[i].page;
3065                 int offset = (*previous_new_areas)[i].offset;
3066                 int size = (*previous_new_areas)[i].size / 4;
3067                 gc_assert((*previous_new_areas)[i].size % 4 == 0);
3068                 scavenge(page_address(page)+offset, size);
3069             }
3070
3071             /* Flush the current regions updating the tables. */
3072             gc_alloc_update_all_page_tables();
3073         }
3074
3075         current_new_areas_index = new_areas_index;
3076
3077         /*FSHOW((stderr,
3078                  "The re-scan has finished; current_new_areas_index=%d.\n",
3079                  current_new_areas_index));*/
3080     }
3081
3082     /* Turn off recording of areas allocated by gc_alloc(). */
3083     record_new_objects = 0;
3084
3085 #if SC_NS_GEN_CK
3086     /* Check that none of the write_protected pages in this generation
3087      * have been written to. */
3088     for (i = 0; i < NUM_PAGES; i++) {
3089         if ((page_table[i].allocation != FREE_PAGE)
3090             && (page_table[i].bytes_used != 0)
3091             && (page_table[i].gen == generation)
3092             && (page_table[i].write_protected_cleared != 0)
3093             && (page_table[i].dont_move == 0)) {
3094             lose("write protected page %d written to in scavenge_newspace_generation\ngeneration=%d dont_move=%d",
3095                  i, generation, page_table[i].dont_move);
3096         }
3097     }
3098 #endif
3099 }
3100 \f
3101 /* Un-write-protect all the pages in from_space. This is done at the
3102  * start of a GC else there may be many page faults while scavenging
3103  * the newspace (I've seen drive the system time to 99%). These pages
3104  * would need to be unprotected anyway before unmapping in
3105  * free_oldspace; not sure what effect this has on paging.. */
3106 static void
3107 unprotect_oldspace(void)
3108 {
3109     int i;
3110
3111     for (i = 0; i < last_free_page; i++) {
3112         if ((page_table[i].allocated != FREE_PAGE)
3113             && (page_table[i].bytes_used != 0)
3114             && (page_table[i].gen == from_space)) {
3115             void *page_start;
3116
3117             page_start = (void *)page_address(i);
3118
3119             /* Remove any write-protection. We should be able to rely
3120              * on the write-protect flag to avoid redundant calls. */
3121             if (page_table[i].write_protected) {
3122                 os_protect(page_start, PAGE_BYTES, OS_VM_PROT_ALL);
3123                 page_table[i].write_protected = 0;
3124             }
3125         }
3126     }
3127 }
3128
3129 /* Work through all the pages and free any in from_space. This
3130  * assumes that all objects have been copied or promoted to an older
3131  * generation. Bytes_allocated and the generation bytes_allocated
3132  * counter are updated. The number of bytes freed is returned. */
3133 extern void i586_bzero(void *addr, int nbytes);
3134 static int
3135 free_oldspace(void)
3136 {
3137     int bytes_freed = 0;
3138     int first_page, last_page;
3139
3140     first_page = 0;
3141
3142     do {
3143         /* Find a first page for the next region of pages. */
3144         while ((first_page < last_free_page)
3145                && ((page_table[first_page].allocated == FREE_PAGE)
3146                    || (page_table[first_page].bytes_used == 0)
3147                    || (page_table[first_page].gen != from_space)))
3148             first_page++;
3149
3150         if (first_page >= last_free_page)
3151             break;
3152
3153         /* Find the last page of this region. */
3154         last_page = first_page;
3155
3156         do {
3157             /* Free the page. */
3158             bytes_freed += page_table[last_page].bytes_used;
3159             generations[page_table[last_page].gen].bytes_allocated -=
3160                 page_table[last_page].bytes_used;
3161             page_table[last_page].allocated = FREE_PAGE;
3162             page_table[last_page].bytes_used = 0;
3163
3164             /* Remove any write-protection. We should be able to rely
3165              * on the write-protect flag to avoid redundant calls. */
3166             {
3167                 void  *page_start = (void *)page_address(last_page);
3168         
3169                 if (page_table[last_page].write_protected) {
3170                     os_protect(page_start, PAGE_BYTES, OS_VM_PROT_ALL);
3171                     page_table[last_page].write_protected = 0;
3172                 }
3173             }
3174             last_page++;
3175         }
3176         while ((last_page < last_free_page)
3177                && (page_table[last_page].allocated != FREE_PAGE)
3178                && (page_table[last_page].bytes_used != 0)
3179                && (page_table[last_page].gen == from_space));
3180
3181         /* Zero pages from first_page to (last_page-1).
3182          *
3183          * FIXME: Why not use os_zero(..) function instead of
3184          * hand-coding this again? (Check other gencgc_unmap_zero
3185          * stuff too. */
3186         if (gencgc_unmap_zero) {
3187             void *page_start, *addr;
3188
3189             page_start = (void *)page_address(first_page);
3190
3191             os_invalidate(page_start, PAGE_BYTES*(last_page-first_page));
3192             addr = os_validate(page_start, PAGE_BYTES*(last_page-first_page));
3193             if (addr == NULL || addr != page_start) {
3194                 /* Is this an error condition? I couldn't really tell from
3195                  * the old CMU CL code, which fprintf'ed a message with
3196                  * an exclamation point at the end. But I've never seen the
3197                  * message, so it must at least be unusual..
3198                  *
3199                  * (The same condition is also tested for in gc_free_heap.)
3200                  *
3201                  * -- WHN 19991129 */
3202                 lose("i586_bzero: page moved, 0x%08x ==> 0x%08x",
3203                      page_start,
3204                      addr);
3205             }
3206         } else {
3207             int *page_start;
3208
3209             page_start = (int *)page_address(first_page);
3210             i586_bzero(page_start, PAGE_BYTES*(last_page-first_page));
3211         }
3212
3213         first_page = last_page;
3214
3215     } while (first_page < last_free_page);
3216
3217     bytes_allocated -= bytes_freed;
3218     return bytes_freed;
3219 }
3220 \f
3221 #if 0
3222 /* Print some information about a pointer at the given address. */
3223 static void
3224 print_ptr(lispobj *addr)
3225 {
3226     /* If addr is in the dynamic space then out the page information. */
3227     int pi1 = find_page_index((void*)addr);
3228
3229     if (pi1 != -1)
3230         fprintf(stderr,"  %x: page %d  alloc %d  gen %d  bytes_used %d  offset %d  dont_move %d\n",
3231                 (unsigned int) addr,
3232                 pi1,
3233                 page_table[pi1].allocated,
3234                 page_table[pi1].gen,
3235                 page_table[pi1].bytes_used,
3236                 page_table[pi1].first_object_offset,
3237                 page_table[pi1].dont_move);
3238     fprintf(stderr,"  %x %x %x %x (%x) %x %x %x %x\n",
3239             *(addr-4),
3240             *(addr-3),
3241             *(addr-2),
3242             *(addr-1),
3243             *(addr-0),
3244             *(addr+1),
3245             *(addr+2),
3246             *(addr+3),
3247             *(addr+4));
3248 }
3249 #endif
3250
3251 extern int undefined_tramp;
3252
3253 static void
3254 verify_space(lispobj *start, size_t words)
3255 {
3256     int is_in_dynamic_space = (find_page_index((void*)start) != -1);
3257     int is_in_readonly_space =
3258         (READ_ONLY_SPACE_START <= (unsigned)start &&
3259          (unsigned)start < SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0));
3260
3261     while (words > 0) {
3262         size_t count = 1;
3263         lispobj thing = *(lispobj*)start;
3264
3265         if (is_lisp_pointer(thing)) {
3266             int page_index = find_page_index((void*)thing);
3267             int to_readonly_space =
3268                 (READ_ONLY_SPACE_START <= thing &&
3269                  thing < SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0));
3270             int to_static_space =
3271                 (STATIC_SPACE_START <= thing &&
3272                  thing < SymbolValue(STATIC_SPACE_FREE_POINTER,0));
3273
3274             /* Does it point to the dynamic space? */
3275             if (page_index != -1) {
3276                 /* If it's within the dynamic space it should point to a used
3277                  * page. XX Could check the offset too. */
3278                 if ((page_table[page_index].allocated != FREE_PAGE)
3279                     && (page_table[page_index].bytes_used == 0))
3280                     lose ("Ptr %x @ %x sees free page.", thing, start);
3281                 /* Check that it doesn't point to a forwarding pointer! */
3282                 if (*((lispobj *)native_pointer(thing)) == 0x01) {
3283                     lose("Ptr %x @ %x sees forwarding ptr.", thing, start);
3284                 }
3285                 /* Check that its not in the RO space as it would then be a
3286                  * pointer from the RO to the dynamic space. */
3287                 if (is_in_readonly_space) {
3288                     lose("ptr to dynamic space %x from RO space %x",
3289                          thing, start);
3290                 }
3291                 /* Does it point to a plausible object? This check slows
3292                  * it down a lot (so it's commented out).
3293                  *
3294                  * "a lot" is serious: it ate 50 minutes cpu time on
3295                  * my duron 950 before I came back from lunch and
3296                  * killed it.
3297                  *
3298                  *   FIXME: Add a variable to enable this
3299                  * dynamically. */
3300                 /*
3301                 if (!possibly_valid_dynamic_space_pointer((lispobj *)thing)) {
3302                     lose("ptr %x to invalid object %x", thing, start); 
3303                 }
3304                 */
3305             } else {
3306                 /* Verify that it points to another valid space. */
3307                 if (!to_readonly_space && !to_static_space
3308                     && (thing != (unsigned)&undefined_tramp)) {
3309                     lose("Ptr %x @ %x sees junk.", thing, start);
3310                 }
3311             }
3312         } else {
3313             if (thing & 0x3) { /* Skip fixnums. FIXME: There should be an
3314                                 * is_fixnum for this. */
3315
3316                 switch(widetag_of(*start)) {
3317
3318                     /* boxed objects */
3319                 case SIMPLE_VECTOR_WIDETAG:
3320                 case RATIO_WIDETAG:
3321                 case COMPLEX_WIDETAG:
3322                 case SIMPLE_ARRAY_WIDETAG:
3323                 case COMPLEX_BASE_STRING_WIDETAG:
3324                 case COMPLEX_VECTOR_NIL_WIDETAG:
3325                 case COMPLEX_BIT_VECTOR_WIDETAG:
3326                 case COMPLEX_VECTOR_WIDETAG:
3327                 case COMPLEX_ARRAY_WIDETAG:
3328                 case CLOSURE_HEADER_WIDETAG:
3329                 case FUNCALLABLE_INSTANCE_HEADER_WIDETAG:
3330                 case VALUE_CELL_HEADER_WIDETAG:
3331                 case SYMBOL_HEADER_WIDETAG:
3332                 case BASE_CHAR_WIDETAG:
3333                 case UNBOUND_MARKER_WIDETAG:
3334                 case INSTANCE_HEADER_WIDETAG:
3335                 case FDEFN_WIDETAG:
3336                     count = 1;
3337                     break;
3338
3339                 case CODE_HEADER_WIDETAG:
3340                     {
3341                         lispobj object = *start;
3342                         struct code *code;
3343                         int nheader_words, ncode_words, nwords;
3344                         lispobj fheaderl;
3345                         struct simple_fun *fheaderp;
3346
3347                         code = (struct code *) start;
3348
3349                         /* Check that it's not in the dynamic space.
3350                          * FIXME: Isn't is supposed to be OK for code
3351                          * objects to be in the dynamic space these days? */
3352                         if (is_in_dynamic_space
3353                             /* It's ok if it's byte compiled code. The trace
3354                              * table offset will be a fixnum if it's x86
3355                              * compiled code - check.
3356                              *
3357                              * FIXME: #^#@@! lack of abstraction here..
3358                              * This line can probably go away now that
3359                              * there's no byte compiler, but I've got
3360                              * too much to worry about right now to try
3361                              * to make sure. -- WHN 2001-10-06 */
3362                             && !(code->trace_table_offset & 0x3)
3363                             /* Only when enabled */
3364                             && verify_dynamic_code_check) {
3365                             FSHOW((stderr,
3366                                    "/code object at %x in the dynamic space\n",
3367                                    start));
3368                         }
3369
3370                         ncode_words = fixnum_value(code->code_size);
3371                         nheader_words = HeaderValue(object);
3372                         nwords = ncode_words + nheader_words;
3373                         nwords = CEILING(nwords, 2);
3374                         /* Scavenge the boxed section of the code data block */
3375                         verify_space(start + 1, nheader_words - 1);
3376
3377                         /* Scavenge the boxed section of each function
3378                          * object in the code data block. */
3379                         fheaderl = code->entry_points;
3380                         while (fheaderl != NIL) {
3381                             fheaderp =
3382                                 (struct simple_fun *) native_pointer(fheaderl);
3383                             gc_assert(widetag_of(fheaderp->header) == SIMPLE_FUN_HEADER_WIDETAG);
3384                             verify_space(&fheaderp->name, 1);
3385                             verify_space(&fheaderp->arglist, 1);
3386                             verify_space(&fheaderp->type, 1);
3387                             fheaderl = fheaderp->next;
3388                         }
3389                         count = nwords;
3390                         break;
3391                     }
3392         
3393                     /* unboxed objects */
3394                 case BIGNUM_WIDETAG:
3395                 case SINGLE_FLOAT_WIDETAG:
3396                 case DOUBLE_FLOAT_WIDETAG:
3397 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
3398                 case LONG_FLOAT_WIDETAG:
3399 #endif
3400 #ifdef COMPLEX_SINGLE_FLOAT_WIDETAG
3401                 case COMPLEX_SINGLE_FLOAT_WIDETAG:
3402 #endif
3403 #ifdef COMPLEX_DOUBLE_FLOAT_WIDETAG
3404                 case COMPLEX_DOUBLE_FLOAT_WIDETAG:
3405 #endif
3406 #ifdef COMPLEX_LONG_FLOAT_WIDETAG
3407                 case COMPLEX_LONG_FLOAT_WIDETAG:
3408 #endif
3409                 case SIMPLE_BASE_STRING_WIDETAG:
3410                 case SIMPLE_BIT_VECTOR_WIDETAG:
3411                 case SIMPLE_ARRAY_NIL_WIDETAG:
3412                 case SIMPLE_ARRAY_UNSIGNED_BYTE_2_WIDETAG:
3413                 case SIMPLE_ARRAY_UNSIGNED_BYTE_4_WIDETAG:
3414                 case SIMPLE_ARRAY_UNSIGNED_BYTE_7_WIDETAG:
3415                 case SIMPLE_ARRAY_UNSIGNED_BYTE_8_WIDETAG:
3416                 case SIMPLE_ARRAY_UNSIGNED_BYTE_15_WIDETAG:
3417                 case SIMPLE_ARRAY_UNSIGNED_BYTE_16_WIDETAG:
3418                 case SIMPLE_ARRAY_UNSIGNED_BYTE_29_WIDETAG:
3419                 case SIMPLE_ARRAY_UNSIGNED_BYTE_31_WIDETAG:
3420                 case SIMPLE_ARRAY_UNSIGNED_BYTE_32_WIDETAG:
3421 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG
3422                 case SIMPLE_ARRAY_SIGNED_BYTE_8_WIDETAG:
3423 #endif
3424 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG
3425                 case SIMPLE_ARRAY_SIGNED_BYTE_16_WIDETAG:
3426 #endif
3427 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG
3428                 case SIMPLE_ARRAY_SIGNED_BYTE_30_WIDETAG:
3429 #endif
3430 #ifdef SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG
3431                 case SIMPLE_ARRAY_SIGNED_BYTE_32_WIDETAG:
3432 #endif
3433                 case SIMPLE_ARRAY_SINGLE_FLOAT_WIDETAG:
3434                 case SIMPLE_ARRAY_DOUBLE_FLOAT_WIDETAG:
3435 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
3436                 case SIMPLE_ARRAY_LONG_FLOAT_WIDETAG:
3437 #endif
3438 #ifdef SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG
3439                 case SIMPLE_ARRAY_COMPLEX_SINGLE_FLOAT_WIDETAG:
3440 #endif
3441 #ifdef SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG
3442                 case SIMPLE_ARRAY_COMPLEX_DOUBLE_FLOAT_WIDETAG:
3443 #endif
3444 #ifdef SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG
3445                 case SIMPLE_ARRAY_COMPLEX_LONG_FLOAT_WIDETAG:
3446 #endif
3447                 case SAP_WIDETAG:
3448                 case WEAK_POINTER_WIDETAG:
3449                     count = (sizetab[widetag_of(*start)])(start);
3450                     break;
3451
3452                 default:
3453                     gc_abort();
3454                 }
3455             }
3456         }
3457         start += count;
3458         words -= count;
3459     }
3460 }
3461
3462 static void
3463 verify_gc(void)
3464 {
3465     /* FIXME: It would be nice to make names consistent so that
3466      * foo_size meant size *in* *bytes* instead of size in some
3467      * arbitrary units. (Yes, this caused a bug, how did you guess?:-)
3468      * Some counts of lispobjs are called foo_count; it might be good
3469      * to grep for all foo_size and rename the appropriate ones to
3470      * foo_count. */
3471     int read_only_space_size =
3472         (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER,0)
3473         - (lispobj*)READ_ONLY_SPACE_START;
3474     int static_space_size =
3475         (lispobj*)SymbolValue(STATIC_SPACE_FREE_POINTER,0)
3476         - (lispobj*)STATIC_SPACE_START;
3477     struct thread *th;
3478     for_each_thread(th) {
3479     int binding_stack_size =
3480             (lispobj*)SymbolValue(BINDING_STACK_POINTER,th)
3481             - (lispobj*)th->binding_stack_start;
3482         verify_space(th->binding_stack_start, binding_stack_size);
3483     }
3484     verify_space((lispobj*)READ_ONLY_SPACE_START, read_only_space_size);
3485     verify_space((lispobj*)STATIC_SPACE_START   , static_space_size);
3486 }
3487
3488 static void
3489 verify_generation(int  generation)
3490 {
3491     int i;
3492
3493     for (i = 0; i < last_free_page; i++) {
3494         if ((page_table[i].allocated != FREE_PAGE)
3495             && (page_table[i].bytes_used != 0)
3496             && (page_table[i].gen == generation)) {
3497             int last_page;
3498             int region_allocation = page_table[i].allocated;
3499
3500             /* This should be the start of a contiguous block */
3501             gc_assert(page_table[i].first_object_offset == 0);
3502
3503             /* Need to find the full extent of this contiguous block in case
3504                objects span pages. */
3505
3506             /* Now work forward until the end of this contiguous area is
3507                found. */
3508             for (last_page = i; ;last_page++)
3509                 /* Check whether this is the last page in this contiguous
3510                  * block. */
3511                 if ((page_table[last_page].bytes_used < PAGE_BYTES)
3512                     /* Or it is PAGE_BYTES and is the last in the block */
3513                     || (page_table[last_page+1].allocated != region_allocation)
3514                     || (page_table[last_page+1].bytes_used == 0)
3515                     || (page_table[last_page+1].gen != generation)
3516                     || (page_table[last_page+1].first_object_offset == 0))
3517                     break;
3518
3519             verify_space(page_address(i), (page_table[last_page].bytes_used
3520                                            + (last_page-i)*PAGE_BYTES)/4);
3521             i = last_page;
3522         }
3523     }
3524 }
3525
3526 /* Check that all the free space is zero filled. */
3527 static void
3528 verify_zero_fill(void)
3529 {
3530     int page;
3531
3532     for (page = 0; page < last_free_page; page++) {
3533         if (page_table[page].allocated == FREE_PAGE) {
3534             /* The whole page should be zero filled. */
3535             int *start_addr = (int *)page_address(page);
3536             int size = 1024;
3537             int i;
3538             for (i = 0; i < size; i++) {
3539                 if (start_addr[i] != 0) {
3540                     lose("free page not zero at %x", start_addr + i);
3541                 }
3542             }
3543         } else {
3544             int free_bytes = PAGE_BYTES - page_table[page].bytes_used;
3545             if (free_bytes > 0) {
3546                 int *start_addr = (int *)((unsigned)page_address(page)
3547                                           + page_table[page].bytes_used);
3548                 int size = free_bytes / 4;
3549                 int i;
3550                 for (i = 0; i < size; i++) {
3551                     if (start_addr[i] != 0) {
3552                         lose("free region not zero at %x", start_addr + i);
3553                     }
3554                 }
3555             }
3556         }
3557     }
3558 }
3559
3560 /* External entry point for verify_zero_fill */
3561 void
3562 gencgc_verify_zero_fill(void)
3563 {
3564     /* Flush the alloc regions updating the tables. */
3565     gc_alloc_update_all_page_tables();
3566     SHOW("verifying zero fill");
3567     verify_zero_fill();
3568 }
3569
3570 static void
3571 verify_dynamic_space(void)
3572 {
3573     int i;
3574
3575     for (i = 0; i < NUM_GENERATIONS; i++)
3576         verify_generation(i);
3577
3578     if (gencgc_enable_verify_zero_fill)
3579         verify_zero_fill();
3580 }
3581 \f
3582 /* Write-protect all the dynamic boxed pages in the given generation. */
3583 static void
3584 write_protect_generation_pages(int generation)
3585 {
3586     int i;
3587
3588     gc_assert(generation < NUM_GENERATIONS);
3589
3590     for (i = 0; i < last_free_page; i++)
3591         if ((page_table[i].allocated == BOXED_PAGE)
3592             && (page_table[i].bytes_used != 0)
3593             && !page_table[i].dont_move
3594             && (page_table[i].gen == generation))  {
3595             void *page_start;
3596
3597             page_start = (void *)page_address(i);
3598
3599             os_protect(page_start,
3600                        PAGE_BYTES,
3601                        OS_VM_PROT_READ | OS_VM_PROT_EXECUTE);
3602
3603             /* Note the page as protected in the page tables. */
3604             page_table[i].write_protected = 1;
3605         }
3606
3607     if (gencgc_verbose > 1) {
3608         FSHOW((stderr,
3609                "/write protected %d of %d pages in generation %d\n",
3610                count_write_protect_generation_pages(generation),
3611                count_generation_pages(generation),
3612                generation));
3613     }
3614 }
3615
3616 /* Garbage collect a generation. If raise is 0 then the remains of the
3617  * generation are not raised to the next generation. */
3618 static void
3619 garbage_collect_generation(int generation, int raise)
3620 {
3621     unsigned long bytes_freed;
3622     unsigned long i;
3623     unsigned long static_space_size;
3624     struct thread *th;
3625     gc_assert(generation <= (NUM_GENERATIONS-1));
3626
3627     /* The oldest generation can't be raised. */
3628     gc_assert((generation != (NUM_GENERATIONS-1)) || (raise == 0));
3629
3630     /* Initialize the weak pointer list. */
3631     weak_pointers = NULL;
3632
3633     /* When a generation is not being raised it is transported to a
3634      * temporary generation (NUM_GENERATIONS), and lowered when
3635      * done. Set up this new generation. There should be no pages
3636      * allocated to it yet. */
3637     if (!raise)
3638         gc_assert(generations[NUM_GENERATIONS].bytes_allocated == 0);
3639
3640     /* Set the global src and dest. generations */
3641     from_space = generation;
3642     if (raise)
3643         new_space = generation+1;
3644     else
3645         new_space = NUM_GENERATIONS;
3646
3647     /* Change to a new space for allocation, resetting the alloc_start_page */
3648     gc_alloc_generation = new_space;
3649     generations[new_space].alloc_start_page = 0;
3650     generations[new_space].alloc_unboxed_start_page = 0;
3651     generations[new_space].alloc_large_start_page = 0;
3652     generations[new_space].alloc_large_unboxed_start_page = 0;
3653
3654     /* Before any pointers are preserved, the dont_move flags on the
3655      * pages need to be cleared. */
3656     for (i = 0; i < last_free_page; i++)
3657         if(page_table[i].gen==from_space)
3658             page_table[i].dont_move = 0;
3659
3660     /* Un-write-protect the old-space pages. This is essential for the
3661      * promoted pages as they may contain pointers into the old-space
3662      * which need to be scavenged. It also helps avoid unnecessary page
3663      * faults as forwarding pointers are written into them. They need to
3664      * be un-protected anyway before unmapping later. */
3665     unprotect_oldspace();
3666
3667     /* Scavenge the stacks' conservative roots. */
3668
3669     /* there are potentially two stacks for each thread: the main
3670      * stack, which may contain Lisp pointers, and the alternate stack.
3671      * We don't ever run Lisp code on the altstack, but it may 
3672      * host a sigcontext with lisp objects in it */
3673
3674     /* what we need to do: (1) find the stack pointer for the main
3675      * stack; scavenge it (2) find the interrupt context on the
3676      * alternate stack that might contain lisp values, and scavenge
3677      * that */
3678
3679     /* we assume that none of the preceding applies to the thread that
3680      * initiates GC.  If you ever call GC from inside an altstack
3681      * handler, you will lose. */
3682     for_each_thread(th) {
3683         void **ptr;
3684         void **esp=(void **)-1;
3685         int i,free;
3686 #ifdef LISP_FEATURE_SB_THREAD
3687         if(th==arch_os_get_current_thread()) {
3688             esp = (void **) &raise;
3689         } else {
3690             void **esp1;
3691             free=fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX,th));
3692             for(i=free-1;i>=0;i--) {
3693                 os_context_t *c=th->interrupt_contexts[i];
3694                 esp1 = (void **) *os_context_register_addr(c,reg_ESP);
3695                 if(esp1>=th->control_stack_start&& esp1<th->control_stack_end){
3696                     if(esp1<esp) esp=esp1;
3697                     for(ptr = (void **)(c+1); ptr>=(void **)c; ptr--) {
3698                         preserve_pointer(*ptr);
3699                     }
3700                 }
3701             }
3702         }
3703 #else
3704         esp = (void **) &raise;
3705 #endif
3706         for (ptr = (void **)th->control_stack_end; ptr > esp;  ptr--) {
3707             preserve_pointer(*ptr);
3708         }
3709     }
3710
3711 #if QSHOW
3712     if (gencgc_verbose > 1) {
3713         int num_dont_move_pages = count_dont_move_pages();
3714         fprintf(stderr,
3715                 "/non-movable pages due to conservative pointers = %d (%d bytes)\n",
3716                 num_dont_move_pages,
3717                 num_dont_move_pages * PAGE_BYTES);
3718     }
3719 #endif
3720
3721     /* Scavenge all the rest of the roots. */
3722
3723     /* Scavenge the Lisp functions of the interrupt handlers, taking
3724      * care to avoid SIG_DFL and SIG_IGN. */
3725     for_each_thread(th) {
3726         struct interrupt_data *data=th->interrupt_data;
3727     for (i = 0; i < NSIG; i++) {
3728             union interrupt_handler handler = data->interrupt_handlers[i];
3729         if (!ARE_SAME_HANDLER(handler.c, SIG_IGN) &&
3730             !ARE_SAME_HANDLER(handler.c, SIG_DFL)) {
3731                 scavenge((lispobj *)(data->interrupt_handlers + i), 1);
3732             }
3733         }
3734     }
3735     /* Scavenge the binding stacks. */
3736  {
3737      struct thread *th;
3738      for_each_thread(th) {
3739          long len= (lispobj *)SymbolValue(BINDING_STACK_POINTER,th) -
3740              th->binding_stack_start;
3741          scavenge((lispobj *) th->binding_stack_start,len);
3742 #ifdef LISP_FEATURE_SB_THREAD
3743          /* do the tls as well */
3744          len=fixnum_value(SymbolValue(FREE_TLS_INDEX,0)) -
3745              (sizeof (struct thread))/(sizeof (lispobj));
3746          scavenge((lispobj *) (th+1),len);
3747 #endif
3748         }
3749     }
3750
3751     /* The original CMU CL code had scavenge-read-only-space code
3752      * controlled by the Lisp-level variable
3753      * *SCAVENGE-READ-ONLY-SPACE*. It was disabled by default, and it
3754      * wasn't documented under what circumstances it was useful or
3755      * safe to turn it on, so it's been turned off in SBCL. If you
3756      * want/need this functionality, and can test and document it,
3757      * please submit a patch. */
3758 #if 0
3759     if (SymbolValue(SCAVENGE_READ_ONLY_SPACE) != NIL) {
3760         unsigned long read_only_space_size =
3761             (lispobj*)SymbolValue(READ_ONLY_SPACE_FREE_POINTER) -
3762             (lispobj*)READ_ONLY_SPACE_START;
3763         FSHOW((stderr,
3764                "/scavenge read only space: %d bytes\n",
3765                read_only_space_size * sizeof(lispobj)));
3766         scavenge( (lispobj *) READ_ONLY_SPACE_START, read_only_space_size);
3767     }
3768 #endif
3769
3770     /* Scavenge static space. */
3771     static_space_size =
3772         (lispobj *)SymbolValue(STATIC_SPACE_FREE_POINTER,0) -
3773         (lispobj *)STATIC_SPACE_START;
3774     if (gencgc_verbose > 1) {
3775         FSHOW((stderr,
3776                "/scavenge static space: %d bytes\n",
3777                static_space_size * sizeof(lispobj)));
3778     }
3779     scavenge( (lispobj *) STATIC_SPACE_START, static_space_size);
3780
3781     /* All generations but the generation being GCed need to be
3782      * scavenged. The new_space generation needs special handling as
3783      * objects may be moved in - it is handled separately below. */
3784     for (i = 0; i < NUM_GENERATIONS; i++) {
3785         if ((i != generation) && (i != new_space)) {
3786             scavenge_generation(i);
3787         }
3788     }
3789
3790     /* Finally scavenge the new_space generation. Keep going until no
3791      * more objects are moved into the new generation */
3792     scavenge_newspace_generation(new_space);
3793
3794     /* FIXME: I tried reenabling this check when debugging unrelated
3795      * GC weirdness ca. sbcl-0.6.12.45, and it failed immediately.
3796      * Since the current GC code seems to work well, I'm guessing that
3797      * this debugging code is just stale, but I haven't tried to
3798      * figure it out. It should be figured out and then either made to
3799      * work or just deleted. */
3800 #define RESCAN_CHECK 0
3801 #if RESCAN_CHECK
3802     /* As a check re-scavenge the newspace once; no new objects should
3803      * be found. */
3804     {
3805         int old_bytes_allocated = bytes_allocated;
3806         int bytes_allocated;
3807
3808         /* Start with a full scavenge. */
3809         scavenge_newspace_generation_one_scan(new_space);
3810
3811         /* Flush the current regions, updating the tables. */
3812         gc_alloc_update_all_page_tables();
3813
3814         bytes_allocated = bytes_allocated - old_bytes_allocated;
3815
3816         if (bytes_allocated != 0) {
3817             lose("Rescan of new_space allocated %d more bytes.",
3818                  bytes_allocated);
3819         }
3820     }
3821 #endif
3822
3823     scan_weak_pointers();
3824
3825     /* Flush the current regions, updating the tables. */
3826     gc_alloc_update_all_page_tables();
3827
3828     /* Free the pages in oldspace, but not those marked dont_move. */
3829     bytes_freed = free_oldspace();
3830
3831     /* If the GC is not raising the age then lower the generation back
3832      * to its normal generation number */
3833     if (!raise) {
3834         for (i = 0; i < last_free_page; i++)
3835             if ((page_table[i].bytes_used != 0)
3836                 && (page_table[i].gen == NUM_GENERATIONS))
3837                 page_table[i].gen = generation;
3838         gc_assert(generations[generation].bytes_allocated == 0);
3839         generations[generation].bytes_allocated =
3840             generations[NUM_GENERATIONS].bytes_allocated;
3841         generations[NUM_GENERATIONS].bytes_allocated = 0;
3842     }
3843
3844     /* Reset the alloc_start_page for generation. */
3845     generations[generation].alloc_start_page = 0;
3846     generations[generation].alloc_unboxed_start_page = 0;
3847     generations[generation].alloc_large_start_page = 0;
3848     generations[generation].alloc_large_unboxed_start_page = 0;
3849
3850     if (generation >= verify_gens) {
3851         if (gencgc_verbose)
3852             SHOW("verifying");
3853         verify_gc();
3854         verify_dynamic_space();
3855     }
3856
3857     /* Set the new gc trigger for the GCed generation. */
3858     generations[generation].gc_trigger =
3859         generations[generation].bytes_allocated
3860         + generations[generation].bytes_consed_between_gc;
3861
3862     if (raise)
3863         generations[generation].num_gc = 0;
3864     else
3865         ++generations[generation].num_gc;
3866 }
3867
3868 /* Update last_free_page, then SymbolValue(ALLOCATION_POINTER). */
3869 int
3870 update_x86_dynamic_space_free_pointer(void)
3871 {
3872     int last_page = -1;
3873     int i;
3874
3875     for (i = 0; i < NUM_PAGES; i++)
3876         if ((page_table[i].allocated != FREE_PAGE)
3877             && (page_table[i].bytes_used != 0))
3878             last_page = i;
3879
3880     last_free_page = last_page+1;
3881
3882     SetSymbolValue(ALLOCATION_POINTER,
3883                    (lispobj)(((char *)heap_base) + last_free_page*PAGE_BYTES),0);
3884     return 0; /* dummy value: return something ... */
3885 }
3886
3887 /* GC all generations newer than last_gen, raising the objects in each
3888  * to the next older generation - we finish when all generations below
3889  * last_gen are empty.  Then if last_gen is due for a GC, or if
3890  * last_gen==NUM_GENERATIONS (the scratch generation?  eh?) we GC that
3891  * too.  The valid range for last_gen is: 0,1,...,NUM_GENERATIONS.
3892  *
3893  * We stop collecting at gencgc_oldest_gen_to_gc, even if this is less than
3894  * last_gen (oh, and note that by default it is NUM_GENERATIONS-1) */
3895  
3896 void
3897 collect_garbage(unsigned last_gen)
3898 {
3899     int gen = 0;
3900     int raise;
3901     int gen_to_wp;
3902     int i;
3903
3904     FSHOW((stderr, "/entering collect_garbage(%d)\n", last_gen));
3905
3906     if (last_gen > NUM_GENERATIONS) {
3907         FSHOW((stderr,
3908                "/collect_garbage: last_gen = %d, doing a level 0 GC\n",
3909                last_gen));
3910         last_gen = 0;
3911     }
3912
3913     /* Flush the alloc regions updating the tables. */
3914     gc_alloc_update_all_page_tables();
3915
3916     /* Verify the new objects created by Lisp code. */
3917     if (pre_verify_gen_0) {
3918         FSHOW((stderr, "pre-checking generation 0\n"));
3919         verify_generation(0);
3920     }
3921
3922     if (gencgc_verbose > 1)
3923         print_generation_stats(0);
3924
3925     do {
3926         /* Collect the generation. */
3927
3928         if (gen >= gencgc_oldest_gen_to_gc) {
3929             /* Never raise the oldest generation. */
3930             raise = 0;
3931         } else {
3932             raise =
3933                 (gen < last_gen)
3934                 || (generations[gen].num_gc >= generations[gen].trigger_age);
3935         }
3936
3937         if (gencgc_verbose > 1) {
3938             FSHOW((stderr,
3939                    "starting GC of generation %d with raise=%d alloc=%d trig=%d GCs=%d\n",
3940                    gen,
3941                    raise,
3942                    generations[gen].bytes_allocated,
3943                    generations[gen].gc_trigger,
3944                    generations[gen].num_gc));
3945         }
3946
3947         /* If an older generation is being filled, then update its
3948          * memory age. */
3949         if (raise == 1) {
3950             generations[gen+1].cum_sum_bytes_allocated +=
3951                 generations[gen+1].bytes_allocated;
3952         }
3953
3954         garbage_collect_generation(gen, raise);
3955
3956         /* Reset the memory age cum_sum. */
3957         generations[gen].cum_sum_bytes_allocated = 0;
3958
3959         if (gencgc_verbose > 1) {
3960             FSHOW((stderr, "GC of generation %d finished:\n", gen));
3961             print_generation_stats(0);
3962         }
3963
3964         gen++;
3965     } while ((gen <= gencgc_oldest_gen_to_gc)
3966              && ((gen < last_gen)
3967                  || ((gen <= gencgc_oldest_gen_to_gc)
3968                      && raise
3969                      && (generations[gen].bytes_allocated
3970                          > generations[gen].gc_trigger)
3971                      && (gen_av_mem_age(gen)
3972                          > generations[gen].min_av_mem_age))));
3973
3974     /* Now if gen-1 was raised all generations before gen are empty.
3975      * If it wasn't raised then all generations before gen-1 are empty.
3976      *
3977      * Now objects within this gen's pages cannot point to younger
3978      * generations unless they are written to. This can be exploited
3979      * by write-protecting the pages of gen; then when younger
3980      * generations are GCed only the pages which have been written
3981      * need scanning. */
3982     if (raise)
3983         gen_to_wp = gen;
3984     else
3985         gen_to_wp = gen - 1;
3986
3987     /* There's not much point in WPing pages in generation 0 as it is
3988      * never scavenged (except promoted pages). */
3989     if ((gen_to_wp > 0) && enable_page_protection) {
3990         /* Check that they are all empty. */
3991         for (i = 0; i < gen_to_wp; i++) {
3992             if (generations[i].bytes_allocated)
3993                 lose("trying to write-protect gen. %d when gen. %d nonempty",
3994                      gen_to_wp, i);
3995         }
3996         write_protect_generation_pages(gen_to_wp);
3997     }
3998
3999     /* Set gc_alloc() back to generation 0. The current regions should
4000      * be flushed after the above GCs. */
4001     gc_assert((boxed_region.free_pointer - boxed_region.start_addr) == 0);
4002     gc_alloc_generation = 0;
4003
4004     update_x86_dynamic_space_free_pointer();
4005     auto_gc_trigger = bytes_allocated + bytes_consed_between_gcs;
4006     if(gencgc_verbose)
4007         fprintf(stderr,"Next gc when %ld bytes have been consed\n",
4008                 auto_gc_trigger);
4009     SHOW("returning from collect_garbage");
4010 }
4011
4012 /* This is called by Lisp PURIFY when it is finished. All live objects
4013  * will have been moved to the RO and Static heaps. The dynamic space
4014  * will need a full re-initialization. We don't bother having Lisp
4015  * PURIFY flush the current gc_alloc() region, as the page_tables are
4016  * re-initialized, and every page is zeroed to be sure. */
4017 void
4018 gc_free_heap(void)
4019 {
4020     int page;
4021
4022     if (gencgc_verbose > 1)
4023         SHOW("entering gc_free_heap");
4024
4025     for (page = 0; page < NUM_PAGES; page++) {
4026         /* Skip free pages which should already be zero filled. */
4027         if (page_table[page].allocated != FREE_PAGE) {
4028             void *page_start, *addr;
4029
4030             /* Mark the page free. The other slots are assumed invalid
4031              * when it is a FREE_PAGE and bytes_used is 0 and it
4032              * should not be write-protected -- except that the
4033              * generation is used for the current region but it sets
4034              * that up. */
4035             page_table[page].allocated = FREE_PAGE;
4036             page_table[page].bytes_used = 0;
4037
4038             /* Zero the page. */
4039             page_start = (void *)page_address(page);
4040
4041             /* First, remove any write-protection. */
4042             os_protect(page_start, PAGE_BYTES, OS_VM_PROT_ALL);
4043             page_table[page].write_protected = 0;
4044
4045             os_invalidate(page_start,PAGE_BYTES);
4046             addr = os_validate(page_start,PAGE_BYTES);
4047             if (addr == NULL || addr != page_start) {
4048                 lose("gc_free_heap: page moved, 0x%08x ==> 0x%08x",
4049                      page_start,
4050                      addr);
4051             }
4052         } else if (gencgc_zero_check_during_free_heap) {
4053             /* Double-check that the page is zero filled. */
4054             int *page_start, i;
4055             gc_assert(page_table[page].allocated == FREE_PAGE);
4056             gc_assert(page_table[page].bytes_used == 0);
4057             page_start = (int *)page_address(page);
4058             for (i=0; i<1024; i++) {
4059                 if (page_start[i] != 0) {
4060                     lose("free region not zero at %x", page_start + i);
4061                 }
4062             }
4063         }
4064     }
4065
4066     bytes_allocated = 0;
4067
4068     /* Initialize the generations. */
4069     for (page = 0; page < NUM_GENERATIONS; page++) {
4070         generations[page].alloc_start_page = 0;
4071         generations[page].alloc_unboxed_start_page = 0;
4072         generations[page].alloc_large_start_page = 0;
4073         generations[page].alloc_large_unboxed_start_page = 0;
4074         generations[page].bytes_allocated = 0;
4075         generations[page].gc_trigger = 2000000;
4076         generations[page].num_gc = 0;
4077         generations[page].cum_sum_bytes_allocated = 0;
4078     }
4079
4080     if (gencgc_verbose > 1)
4081         print_generation_stats(0);
4082
4083     /* Initialize gc_alloc(). */
4084     gc_alloc_generation = 0;
4085
4086     gc_set_region_empty(&boxed_region);
4087     gc_set_region_empty(&unboxed_region);
4088
4089     last_free_page = 0;
4090     SetSymbolValue(ALLOCATION_POINTER, (lispobj)((char *)heap_base),0);
4091
4092     if (verify_after_free_heap) {
4093         /* Check whether purify has left any bad pointers. */
4094         if (gencgc_verbose)
4095             SHOW("checking after free_heap\n");
4096         verify_gc();
4097     }
4098 }
4099 \f
4100 void
4101 gc_init(void)
4102 {
4103     int i;
4104
4105     gc_init_tables();
4106     scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector;
4107     scavtab[WEAK_POINTER_WIDETAG] = scav_weak_pointer;
4108     transother[SIMPLE_ARRAY_WIDETAG] = trans_boxed_large;
4109
4110     heap_base = (void*)DYNAMIC_SPACE_START;
4111
4112     /* Initialize each page structure. */
4113     for (i = 0; i < NUM_PAGES; i++) {
4114         /* Initialize all pages as free. */
4115         page_table[i].allocated = FREE_PAGE;
4116         page_table[i].bytes_used = 0;
4117
4118         /* Pages are not write-protected at startup. */
4119         page_table[i].write_protected = 0;
4120     }
4121
4122     bytes_allocated = 0;
4123
4124     /* Initialize the generations.
4125      *
4126      * FIXME: very similar to code in gc_free_heap(), should be shared */
4127     for (i = 0; i < NUM_GENERATIONS; i++) {
4128         generations[i].alloc_start_page = 0;
4129         generations[i].alloc_unboxed_start_page = 0;
4130         generations[i].alloc_large_start_page = 0;
4131         generations[i].alloc_large_unboxed_start_page = 0;
4132         generations[i].bytes_allocated = 0;
4133         generations[i].gc_trigger = 2000000;
4134         generations[i].num_gc = 0;
4135         generations[i].cum_sum_bytes_allocated = 0;
4136         /* the tune-able parameters */
4137         generations[i].bytes_consed_between_gc = 2000000;
4138         generations[i].trigger_age = 1;
4139         generations[i].min_av_mem_age = 0.75;
4140     }
4141
4142     /* Initialize gc_alloc. */
4143     gc_alloc_generation = 0;
4144     gc_set_region_empty(&boxed_region);
4145     gc_set_region_empty(&unboxed_region);
4146
4147     last_free_page = 0;
4148
4149 }
4150
4151 /*  Pick up the dynamic space from after a core load.
4152  *
4153  *  The ALLOCATION_POINTER points to the end of the dynamic space.
4154  *
4155  *  XX A scan is needed to identify the closest first objects for pages. */
4156 static void
4157 gencgc_pickup_dynamic(void)
4158 {
4159     int page = 0;
4160     int addr = DYNAMIC_SPACE_START;
4161     int alloc_ptr = SymbolValue(ALLOCATION_POINTER,0);
4162
4163     /* Initialize the first region. */
4164     do {
4165         page_table[page].allocated = BOXED_PAGE;
4166         page_table[page].gen = 0;
4167         page_table[page].bytes_used = PAGE_BYTES;
4168         page_table[page].large_object = 0;
4169         page_table[page].first_object_offset =
4170             (void *)DYNAMIC_SPACE_START - page_address(page);
4171         addr += PAGE_BYTES;
4172         page++;
4173     } while (addr < alloc_ptr);
4174
4175     generations[0].bytes_allocated = PAGE_BYTES*page;
4176     bytes_allocated = PAGE_BYTES*page;
4177
4178 }
4179
4180 void
4181 gc_initialize_pointers(void)
4182 {
4183     gencgc_pickup_dynamic();
4184 }
4185
4186
4187 \f
4188
4189 /* alloc(..) is the external interface for memory allocation. It
4190  * allocates to generation 0. It is not called from within the garbage
4191  * collector as it is only external uses that need the check for heap
4192  * size (GC trigger) and to disable the interrupts (interrupts are
4193  * always disabled during a GC).
4194  *
4195  * The vops that call alloc(..) assume that the returned space is zero-filled.
4196  * (E.g. the most significant word of a 2-word bignum in MOVE-FROM-UNSIGNED.)
4197  *
4198  * The check for a GC trigger is only performed when the current
4199  * region is full, so in most cases it's not needed. */
4200
4201 char *
4202 alloc(int nbytes)
4203 {
4204     struct thread *th=arch_os_get_current_thread();
4205     struct alloc_region *region= 
4206         th ? &(th->alloc_region) : &boxed_region; 
4207     void *new_obj;
4208     void *new_free_pointer;
4209
4210     /* Check for alignment allocation problems. */
4211     gc_assert((((unsigned)region->free_pointer & 0x7) == 0)
4212               && ((nbytes & 0x7) == 0));
4213     if(all_threads)
4214         /* there are a few places in the C code that allocate data in the
4215          * heap before Lisp starts.  This is before interrupts are enabled,
4216          * so we don't need to check for pseudo-atomic */
4217 #ifdef LISP_FEATURE_SB_THREAD
4218         if(!SymbolValue(PSEUDO_ATOMIC_ATOMIC,th)) {
4219             register u32 fs;
4220             fprintf(stderr, "fatal error in thread 0x%x, pid=%d\n",
4221                     th,getpid());
4222             __asm__("movl %fs,%0" : "=r" (fs)  : );
4223             fprintf(stderr, "fs is %x, th->tls_cookie=%x (should be identical)\n",
4224                     debug_get_fs(),th->tls_cookie);
4225             lose("If you see this message before 2003.12.01, mail details to sbcl-devel\n");
4226         }
4227 #else
4228     gc_assert(SymbolValue(PSEUDO_ATOMIC_ATOMIC,th));
4229 #endif
4230     
4231     /* maybe we can do this quickly ... */
4232     new_free_pointer = region->free_pointer + nbytes;
4233     if (new_free_pointer <= region->end_addr) {
4234         new_obj = (void*)(region->free_pointer);
4235         region->free_pointer = new_free_pointer;
4236         return(new_obj);        /* yup */
4237     }
4238     
4239     /* we have to go the long way around, it seems.  Check whether 
4240      * we should GC in the near future
4241      */
4242     if (auto_gc_trigger && bytes_allocated > auto_gc_trigger) {
4243         /* set things up so that GC happens when we finish the PA
4244          * section.  We only do this if there wasn't a pending handler
4245          * already, in case it was a gc.  If it wasn't a GC, the next
4246          * allocation will get us back to this point anyway, so no harm done
4247          */
4248         struct interrupt_data *data=th->interrupt_data;
4249         if(!data->pending_handler) 
4250             maybe_defer_handler(interrupt_maybe_gc_int,data,0,0,0);
4251     }
4252     new_obj = gc_alloc_with_region(nbytes,0,region,0);
4253     return (new_obj);
4254 }
4255
4256 \f
4257 /* Find the code object for the given pc, or return NULL on failure.
4258  *
4259  * FIXME: PC shouldn't be lispobj*, should it? Maybe void*? */
4260 lispobj *
4261 component_ptr_from_pc(lispobj *pc)
4262 {
4263     lispobj *object = NULL;
4264
4265     if ( (object = search_read_only_space(pc)) )
4266         ;
4267     else if ( (object = search_static_space(pc)) )
4268         ;
4269     else
4270         object = search_dynamic_space(pc);
4271
4272     if (object) /* if we found something */
4273         if (widetag_of(*object) == CODE_HEADER_WIDETAG) /* if it's a code object */
4274             return(object);
4275
4276     return (NULL);
4277 }
4278 \f
4279 /*
4280  * shared support for the OS-dependent signal handlers which
4281  * catch GENCGC-related write-protect violations
4282  */
4283
4284 void unhandled_sigmemoryfault(void);
4285
4286 /* Depending on which OS we're running under, different signals might
4287  * be raised for a violation of write protection in the heap. This
4288  * function factors out the common generational GC magic which needs
4289  * to invoked in this case, and should be called from whatever signal
4290  * handler is appropriate for the OS we're running under.
4291  *
4292  * Return true if this signal is a normal generational GC thing that
4293  * we were able to handle, or false if it was abnormal and control
4294  * should fall through to the general SIGSEGV/SIGBUS/whatever logic. */
4295
4296 int
4297 gencgc_handle_wp_violation(void* fault_addr)
4298 {
4299     int  page_index = find_page_index(fault_addr);
4300
4301 #if defined QSHOW_SIGNALS
4302     FSHOW((stderr, "heap WP violation? fault_addr=%x, page_index=%d\n",
4303            fault_addr, page_index));
4304 #endif
4305
4306     /* Check whether the fault is within the dynamic space. */
4307     if (page_index == (-1)) {
4308
4309         /* It can be helpful to be able to put a breakpoint on this
4310          * case to help diagnose low-level problems. */
4311         unhandled_sigmemoryfault();
4312
4313         /* not within the dynamic space -- not our responsibility */
4314         return 0;
4315
4316     } else {
4317         if (page_table[page_index].write_protected) {
4318             /* Unprotect the page. */
4319             os_protect(page_address(page_index), PAGE_BYTES, OS_VM_PROT_ALL);
4320             page_table[page_index].write_protected_cleared = 1;
4321             page_table[page_index].write_protected = 0;
4322         } else {  
4323             /* The only acceptable reason for this signal on a heap
4324              * access is that GENCGC write-protected the page.
4325              * However, if two CPUs hit a wp page near-simultaneously,
4326              * we had better not have the second one lose here if it
4327              * does this test after the first one has already set wp=0
4328              */
4329             if(page_table[page_index].write_protected_cleared != 1) 
4330                 lose("fault in heap page not marked as write-protected");
4331         }
4332         /* Don't worry, we can handle it. */
4333         return 1;
4334     }
4335 }
4336 /* This is to be called when we catch a SIGSEGV/SIGBUS, determine that
4337  * it's not just a case of the program hitting the write barrier, and
4338  * are about to let Lisp deal with it. It's basically just a
4339  * convenient place to set a gdb breakpoint. */
4340 void
4341 unhandled_sigmemoryfault()
4342 {}
4343
4344 void gc_alloc_update_all_page_tables(void)
4345 {
4346     /* Flush the alloc regions updating the tables. */
4347     struct thread *th;
4348     for_each_thread(th) 
4349         gc_alloc_update_page_tables(0, &th->alloc_region);
4350     gc_alloc_update_page_tables(1, &unboxed_region);
4351     gc_alloc_update_page_tables(0, &boxed_region);
4352 }
4353 void 
4354 gc_set_region_empty(struct alloc_region *region)
4355 {
4356     region->first_page = 0;
4357     region->last_page = -1;
4358     region->start_addr = page_address(0);
4359     region->free_pointer = page_address(0);
4360     region->end_addr = page_address(0);
4361 }
4362