src/lisp/os.h:
[projects/cmucl/cmucl.git] / src / lisp / gencgc.c
CommitLineData
0c41e522 1/*
2 * Generational Conservative Garbage Collector for CMUCL x86.
3 *
4 * This code was written by Douglas T. Crosher, based on Public Domain
5 * codes from Carnegie Mellon University. This code has been placed in
6 * the public domain, and is provided 'as is'.
7 *
2bf0de4c 8 * Douglas Crosher, 1996, 1997, 1998, 1999.
0c41e522 9 *
9dcff02e 10 * $Header: /project/cmucl/cvsroot/src/lisp/gencgc.c,v 1.112 2011-01-09 00:12:36 rtoy Exp $
2bf0de4c 11 *
12 */
0c41e522 13
f0d2aa86 14#include <limits.h>
0c41e522 15#include <stdio.h>
9e89e4e5 16#include <stdlib.h>
0c41e522 17#include <signal.h>
5a1bf534 18#include <string.h>
0c41e522 19#include "lisp.h"
c66586ed 20#include "arch.h"
0c41e522 21#include "internals.h"
22#include "os.h"
23#include "globals.h"
24#include "interrupt.h"
25#include "validate.h"
26#include "lispregs.h"
c66586ed 27#include "interr.h"
0c41e522 28#include "gencgc.h"
29
eff841d2 30/*
31 * This value in a hash table hash-vector means that the key uses
32 * EQ-based hashing. That is, the key might be using EQ or EQL for
33 * the test. This MUST match the value used in hash-new.lisp!
34 */
35#define EQ_BASED_HASH_VALUE 0x80000000
46a4f482 36
0c41e522 37#define gc_abort() lose("GC invariant lost! File \"%s\", line %d\n", \
38 __FILE__, __LINE__)
39
3f2ead72 40#if (defined(i386) || defined(__x86_64))
e31f8138 41
42#define set_alloc_pointer(value) \
43 SetSymbolValue (ALLOCATION_POINTER, (value))
44#define get_alloc_pointer() \
45 SymbolValue (ALLOCATION_POINTER)
46#define get_binding_stack_pointer() \
47 SymbolValue (BINDING_STACK_POINTER)
48#define get_pseudo_atomic_atomic() \
49 SymbolValue (PSEUDO_ATOMIC_ATOMIC)
50#define set_pseudo_atomic_atomic() \
51 SetSymbolValue (PSEUDO_ATOMIC_ATOMIC, make_fixnum (1))
52#define clr_pseudo_atomic_atomic() \
53 SetSymbolValue (PSEUDO_ATOMIC_ATOMIC, make_fixnum (0))
54#define get_pseudo_atomic_interrupted() \
55 SymbolValue (PSEUDO_ATOMIC_INTERRUPTED)
56#define clr_pseudo_atomic_interrupted() \
57 SetSymbolValue (PSEUDO_ATOMIC_INTERRUPTED, make_fixnum (0))
58
723055bb 59#define set_current_region_free(value) \
60 SetSymbolValue(CURRENT_REGION_FREE_POINTER, (value))
61#define set_current_region_end(value) \
62 SetSymbolValue(CURRENT_REGION_END_ADDR, (value))
63#define get_current_region_free() \
64 SymbolValue(CURRENT_REGION_FREE_POINTER)
65
66#define set_current_region_end(value) \
67 SetSymbolValue(CURRENT_REGION_END_ADDR, (value))
68
af867264 69#elif defined(sparc)
e31f8138 70
b76a726f 71/*
72 * current_dynamic_space_free_pointer contains the pseudo-atomic
73 * stuff, so we need to preserve those bits when we give it a value.
74 * This value better not have any bits set there either!
75 */
feaa7104 76
77/*
78 * On sparc, we don't need to set the alloc_pointer in the code here
79 * because the alloc pointer (current_dynamic_space_free_pointer) is
80 * the same as *current-region-free-pointer* and is stored in
81 * alloc-tn.
82 */
9a8c1c2f 83#define set_alloc_pointer(value)
e31f8138 84#define get_alloc_pointer() \
12e350c5 85 ((unsigned long) current_dynamic_space_free_pointer & ~lowtag_Mask)
e31f8138 86#define get_binding_stack_pointer() \
87 (current_binding_stack_pointer)
af867264 88#define get_pseudo_atomic_atomic() \
263f0353 89 ((unsigned long)current_dynamic_space_free_pointer & pseudo_atomic_Value)
af867264 90#define set_pseudo_atomic_atomic() \
e31f8138 91 (current_dynamic_space_free_pointer \
263f0353 92 = (lispobj*) ((unsigned long)current_dynamic_space_free_pointer | pseudo_atomic_Value))
af867264 93#define clr_pseudo_atomic_atomic() \
e31f8138 94 (current_dynamic_space_free_pointer \
263f0353 95 = (lispobj*) ((unsigned long) current_dynamic_space_free_pointer & ~pseudo_atomic_Value))
e31f8138 96#define get_pseudo_atomic_interrupted() \
263f0353 97 ((unsigned long) current_dynamic_space_free_pointer & pseudo_atomic_InterruptedValue)
af867264 98#define clr_pseudo_atomic_interrupted() \
e31f8138 99 (current_dynamic_space_free_pointer \
263f0353 100 = (lispobj*) ((unsigned long) current_dynamic_space_free_pointer & ~pseudo_atomic_InterruptedValue))
e31f8138 101
723055bb 102#define set_current_region_free(value) \
103 current_dynamic_space_free_pointer = (lispobj*)((value) | ((long)current_dynamic_space_free_pointer & lowtag_Mask))
104
105#define get_current_region_free() \
106 ((long)current_dynamic_space_free_pointer & (~(lowtag_Mask)))
723055bb 107
108#define set_current_region_end(value) \
109 SetSymbolValue(CURRENT_REGION_END_ADDR, (value))
110
555746e0 111#elif defined(DARWIN) && defined(__ppc__)
46a4f482 112#ifndef pseudo_atomic_InterruptedValue
113#define pseudo_atomic_InterruptedValue 1
114#endif
115#ifndef pseudo_atomic_Value
116#define pseudo_atomic_Value 4
117#endif
118
119#define set_alloc_pointer(value)
120#define get_alloc_pointer() \
121 ((unsigned long) current_dynamic_space_free_pointer & ~lowtag_Mask)
122#define get_binding_stack_pointer() \
123 (current_binding_stack_pointer)
124#define get_pseudo_atomic_atomic() \
125 ((unsigned long)current_dynamic_space_free_pointer & pseudo_atomic_Value)
126#define set_pseudo_atomic_atomic() \
127 (current_dynamic_space_free_pointer \
128 = (lispobj*) ((unsigned long)current_dynamic_space_free_pointer | pseudo_atomic_Value))
129#define clr_pseudo_atomic_atomic() \
130 (current_dynamic_space_free_pointer \
131 = (lispobj*) ((unsigned long) current_dynamic_space_free_pointer & ~pseudo_atomic_Value))
132#define get_pseudo_atomic_interrupted() \
133 ((unsigned long) current_dynamic_space_free_pointer & pseudo_atomic_InterruptedValue)
134#define clr_pseudo_atomic_interrupted() \
135 (current_dynamic_space_free_pointer \
136 = (lispobj*) ((unsigned long) current_dynamic_space_free_pointer & ~pseudo_atomic_InterruptedValue))
137
138#define set_current_region_free(value) \
139 current_dynamic_space_free_pointer = (lispobj*)((value) | ((long)current_dynamic_space_free_pointer & lowtag_Mask))
140
141#define get_current_region_free() \
142 ((long)current_dynamic_space_free_pointer & (~(lowtag_Mask)))
143
144#define set_current_region_end(value) \
145 SetSymbolValue(CURRENT_REGION_END_ADDR, (value))
146
af867264 147#else
e31f8138 148#error gencgc is not supported on this platform
af867264 149#endif
150
c197af2f 151/* Define for activating assertions. */
152
6438e048 153#if defined(x86) && defined(SOLARIS)
c197af2f 154#define GC_ASSERTIONS 1
155#endif
156
157/* Check for references to stack-allocated objects. */
158
159#ifdef GC_ASSERTIONS
160
161static void *invalid_stack_start, *invalid_stack_end;
162
163static inline void
9a8c1c2f 164check_escaped_stack_object(lispobj * where, lispobj obj)
165{
555746e0 166#if !defined(DARWIN) && !defined(__ppc__)
9a8c1c2f 167 void *p;
168
169 if (Pointerp(obj)
170 && (p = (void *) PTR(obj),
171 (p >= (void *) CONTROL_STACK_START
e7997cb6 172 && p < (void *) control_stack_end))) {
9a8c1c2f 173 char *space;
174
175 if (where >= (lispobj *) DYNAMIC_0_SPACE_START
e7997cb6 176 && where < (lispobj *) (DYNAMIC_0_SPACE_START + dynamic_space_size))
9a8c1c2f 177 space = "dynamic space";
178 else if (where >= (lispobj *) STATIC_SPACE_START
179 && where <
e7997cb6 180 (lispobj *) (STATIC_SPACE_START + static_space_size)) space =
9a8c1c2f 181 "static space";
182 else if (where >= (lispobj *) READ_ONLY_SPACE_START
183 && where <
184 (lispobj *) (READ_ONLY_SPACE_START +
e7997cb6 185 read_only_space_size)) space = "read-only space";
9a8c1c2f 186 else
187 space = NULL;
188
189 /* GC itself uses some stack, so we can't tell exactly where the
190 invalid stack area starts. Usually, it should be an error if a
191 reference to a stack-allocated object is found, although it
192 is valid to store a reference to a stack-allocated object
193 temporarily in another reachable object, as long as the
194 reference goes away at the end of a dynamic extent. */
195
196 if (p >= invalid_stack_start && p < invalid_stack_end)
197 lose("Escaped stack-allocated object 0x%08lx at %p in %s\n",
198 (unsigned long) obj, where, space);
fb64dc30 199#ifndef i386
9a8c1c2f 200 else if ((where >= (lispobj *) CONTROL_STACK_START
e7997cb6 201 && where < (lispobj *) (control_stack_end))
9a8c1c2f 202 || (space == NULL)) {
203 /* Do nothing if it the reference is from the control stack,
204 because that will happen, and that's ok. Or if it's from
205 an unknown space (typically from scavenging an interrupt
206 context. */
207 }
208#endif
209
210 else
211 fprintf(stderr,
212 "Reference to stack-allocated object 0x%08lx at %p in %s\n",
213 (unsigned long) obj, where,
214 space ? space : "Unknown space");
c197af2f 215 }
46a4f482 216#endif
c197af2f 217}
218
219#endif /* GC_ASSERTIONS */
220
221
c197af2f 222#ifdef GC_ASSERTIONS
223#define gc_assert(ex) \
224 do { \
225 if (!(ex)) gc_abort (); \
226 } while (0)
0c41e522 227#else
9e89e4e5 228#define gc_assert(ex) (void) 0
0c41e522 229#endif
0c41e522 230\f
9a8c1c2f 231
2bf0de4c 232/*
233 * The number of generations, an extra is added to this for use as a temp.
234 */
0c41e522 235#define NUM_GENERATIONS 6
236
237/* Debugging variables. */
238
2bf0de4c 239/*
240 * The verbose level. All non-error messages are disabled at level 0;
241 * and only a few rare messages are printed at level 1.
242 */
ac5034a9 243unsigned gencgc_verbose = 0;
65f0bdc0 244unsigned counters_verbose = 0;
0c41e522 245
2bf0de4c 246/*
83376964 247 * If true, then some debugging information is printed when scavenging
248 * static (malloc'ed) arrays.
249 */
250boolean debug_static_array_p = 0;
251
252/*
2bf0de4c 253 * To enable the use of page protection to help avoid the scavenging
254 * of pages that don't have pointers to younger generations.
255 */
9a8c1c2f 256boolean enable_page_protection = TRUE;
65f0bdc0 257
2bf0de4c 258/*
259 * Hunt for pointers to old-space, when GCing generations >= verify_gen.
260 * Set to NUM_GENERATIONS to disable.
261 */
bd46c00c 262int verify_gens = NUM_GENERATIONS;
0c41e522 263
2bf0de4c 264/*
af867264 265 * Enable a pre-scan verify of generation 0 before it's GCed. (This
266 * makes GC very, very slow, so don't enable this unless you really
267 * need it!)
2bf0de4c 268 */
0c41e522 269boolean pre_verify_gen_0 = FALSE;
270
bd46c00c 271/*
2bf0de4c 272 * Enable checking for bad pointers after gc_free_heap called from purify.
bd46c00c 273 */
906452d6 274#if 0 && defined(DARWIN)
46a4f482 275boolean verify_after_free_heap = TRUE;
276#else
bd46c00c 277boolean verify_after_free_heap = FALSE;
46a4f482 278#endif
bd46c00c 279
2bf0de4c 280/*
281 * Enable the printing of a note when code objects are found in the
282 * dynamic space during a heap verify.
283 */
0c41e522 284boolean verify_dynamic_code_check = FALSE;
285
2bf0de4c 286/*
287 * Enable the checking of code objects for fixup errors after they are
af867264 288 * transported. (Only used for x86.)
2bf0de4c 289 */
bd46c00c 290boolean check_code_fixups = FALSE;
0c41e522 291
2bf0de4c 292/*
293 * To enable unmapping of a page and re-mmaping it to have it zero filled.
b39b25d0 294 * Note: this can waste a lot of swap on FreeBSD and Open/NetBSD(?) so
295 * don't unmap.
2bf0de4c 296 */
b39b25d0 297#if defined(__FreeBSD__) || defined(__OpenBSD__) || defined(__NetBSD__)
0c41e522 298boolean gencgc_unmap_zero = FALSE;
299#else
300boolean gencgc_unmap_zero = TRUE;
301#endif
302
2bf0de4c 303/*
304 * Enable checking that newly allocated regions are zero filled.
305 */
906452d6 306#if 0 && defined(DARWIN)
46a4f482 307boolean gencgc_zero_check = TRUE;
308boolean gencgc_enable_verify_zero_fill = TRUE;
309#else
0c41e522 310boolean gencgc_zero_check = FALSE;
3bf953cb 311boolean gencgc_enable_verify_zero_fill = FALSE;
46a4f482 312#endif
3bf953cb 313
bd46c00c 314/*
315 * Enable checking that free pages are zero filled during gc_free_heap
316 * called after purify.
317 */
906452d6 318#if 0 && defined(DARWIN)
46a4f482 319boolean gencgc_zero_check_during_free_heap = TRUE;
320#else
bd46c00c 321boolean gencgc_zero_check_during_free_heap = FALSE;
46a4f482 322#endif
bd46c00c 323
2bf0de4c 324/*
325 * The minimum size for a large object.
326 */
0b2b8885 327unsigned large_object_size = 4 * GC_PAGE_SIZE;
0c41e522 328
2bf0de4c 329/*
330 * Enable the filtering of stack/register pointers. This could reduce
331 * the number of invalid pointers accepted. It will probably degrades
332 * interrupt safety during object initialisation.
333 */
0c41e522 334boolean enable_pointer_filter = TRUE;
0c41e522 335\f
9a8c1c2f 336
2bf0de4c 337/*
338 * The total bytes allocated. Seen by (dynamic-usage)
339 */
0c41e522 340unsigned long bytes_allocated = 0;
0715274e 341
342/*
65f0bdc0 343 * The total amount of bytes ever allocated. Not decreased by GC.
344 */
345
346volatile unsigned long long bytes_allocated_sum = 0;
347
348/*
0715274e 349 * GC trigger; a value of 0xffffffff represents disabled.
350 */
351unsigned long auto_gc_trigger = 0xffffffff;
0c41e522 352
2bf0de4c 353/*
3e309c44 354 * Number of pages to reserve for heap overflow. We want some space
355 * available on the heap when we are close to a heap overflow, so we
356 * can handle the overflow. But how much do we really need? I (rtoy)
357 * think 256 pages is probably a decent amount. (That's 1 MB for x86,
358 * 2 MB for sparc, which has 8K pages.)
359 */
360
361unsigned long reserved_heap_pages = 256;
362
363/*
2bf0de4c 364 * The src. and dest. generations. Set before a GC starts scavenging.
365 */
0c41e522 366static int from_space;
367static int new_space;
0c41e522 368\f
9a8c1c2f 369
2bf0de4c 370/*
371 * GC structures and variables.
372 */
0c41e522 373
2bf0de4c 374/*
a7070998 375 * Number of pages within the dynamic heap, setup from the size of the
376 * dynamic space.
377 */
378unsigned dynamic_space_pages;
379
380/*
2bf0de4c 381 * An array of page structures is statically allocated.
d54d3cbf 382 * This helps quickly map between an address and its page structure.
2bf0de4c 383 */
a7070998 384struct page *page_table;
0c41e522 385
2bf0de4c 386/*
387 * Heap base, needed for mapping addresses to page structures.
388 */
ae169a66 389static char *heap_base = NULL;
0c41e522 390
2bf0de4c 391/*
392 * Calculate the start address for the given page number.
393 */
97083c55 394static char *
9a8c1c2f 395page_address(int page_num)
0c41e522 396{
0b2b8885 397 return heap_base + GC_PAGE_SIZE * page_num;
0c41e522 398}
399
2bf0de4c 400/*
401 * Find the page index within the page_table for the given address.
402 * Returns -1 on failure.
403 */
97083c55 404int
9a8c1c2f 405find_page_index(void *addr)
0c41e522 406{
9a8c1c2f 407 int index = (char *) addr - heap_base;
0c41e522 408
9a8c1c2f 409 if (index >= 0) {
0b2b8885 410 index = (unsigned int) index / GC_PAGE_SIZE;
9a8c1c2f 411 if (index < dynamic_space_pages)
412 return index;
413 }
0c41e522 414
9a8c1c2f 415 return -1;
0c41e522 416}
417
97083c55 418/*
419 * This routine implements a write barrier used to record stores into
420 * to boxed regions outside of generation 0. When such a store occurs
421 * this routine will be automatically invoked by the page fault
422 * handler. If passed an address outside of the dynamic space, this
423 * routine will return immediately with a value of 0. Otherwise, the
424 * page belonging to the address is made writable, the protection
425 * change is recorded in the garbage collector page table, and a value
426 * of 1 is returned.
427 */
428int
429gc_write_barrier(void *addr)
430{
431 int page_index = find_page_index(addr);
432
433 /* Check if the fault is within the dynamic space. */
434 if (page_index == -1) {
435 return 0;
436 }
437
438 /* The page should have been marked write protected */
439 if (!PAGE_WRITE_PROTECTED(page_index))
440 fprintf(stderr,
441 "*** Page fault in page not marked as write protected\n");
442
443 /* Un-protect the page */
0b2b8885 444 os_protect((os_vm_address_t) page_address(page_index), GC_PAGE_SIZE, OS_VM_PROT_ALL);
97083c55 445 page_table[page_index].flags &= ~PAGE_WRITE_PROTECTED_MASK;
446 page_table[page_index].flags |= PAGE_WRITE_PROTECT_CLEARED_MASK;
447
448 return 1;
449}
0c41e522 450
2bf0de4c 451/*
452 * A structure to hold the state of a generation.
453 */
8a9d1d8d
RT
454#define MEM_AGE_SHIFT 16
455#define MEM_AGE_SCALE (1 << MEM_AGE_SHIFT)
456
0c41e522 457struct generation {
458
9a8c1c2f 459 /* The first page that gc_alloc checks on its next call. */
460 int alloc_start_page;
461
462 /* The first page that gc_alloc_unboxed checks on its next call. */
463 int alloc_unboxed_start_page;
464
465 /*
466 * The first page that gc_alloc_large (boxed) considers on its next call.
467 * Although it always allocates after the boxed_region.
468 */
469 int alloc_large_start_page;
470
471 /*
472 * The first page that gc_alloc_large (unboxed) considers on its next call.
473 * Although it always allocates after the current_unboxed_region.
474 */
475 int alloc_large_unboxed_start_page;
476
477 /* The bytes allocate to this generation. */
478 int bytes_allocated;
479
480 /* The number of bytes at which to trigger a GC */
481 int gc_trigger;
482
483 /* To calculate a new level for gc_trigger */
484 int bytes_consed_between_gc;
485
486 /* The number of GCs since the last raise. */
487 int num_gc;
488
489 /*
490 * The average age at after which a GC will raise objects to the
491 * next generation.
492 */
493 int trigger_age;
494
495 /*
496 * The cumulative sum of the bytes allocated to this generation. It
497 * is cleared after a GC on this generation, and update before new
498 * objects are added from a GC of a younger generation. Dividing by
499 * the bytes_allocated will give the average age of the memory in
500 * this generation since its last GC.
501 */
502 int cum_sum_bytes_allocated;
503
504 /*
505 * A minimum average memory age before a GC will occur helps prevent
506 * a GC when a large number of new live objects have been added, in
507 * which case a GC could be a waste of time.
8a9d1d8d
RT
508 *
509 * The age is represented as an integer between 0 and 32767
510 * corresponding to an age of 0 to (just less than) 1.
9a8c1c2f 511 */
8a9d1d8d 512 int min_av_mem_age;
0c41e522 513};
514
2bf0de4c 515/*
516 * An array of generation structures. There needs to be one more
517 * generation structure than actual generations as the oldest
518 * generations is temporarily raised then lowered.
519 */
2057879e 520static struct generation generations[NUM_GENERATIONS + 1];
0c41e522 521
bf84be07 522/* Statistics about a generation, extracted from the generations
523 array. This gets returned to Lisp.
524*/
525
526struct generation_stats {
9a8c1c2f 527 int bytes_allocated;
528 int gc_trigger;
529 int bytes_consed_between_gc;
530 int num_gc;
531 int trigger_age;
532 int cum_sum_bytes_allocated;
8a9d1d8d 533 int min_av_mem_age;
bf84be07 534};
9a8c1c2f 535
bf84be07 536
2bf0de4c 537/*
538 * The oldest generation that will currently be GCed by default.
539 * Valid values are: 0, 1, ... (NUM_GENERATIONS - 1)
540 *
541 * The default of (NUM_GENERATIONS - 1) enables GC on all generations.
542 *
543 * Setting this to 0 effectively disables the generational nature of
544 * the GC. In some applications generational GC may not be useful
545 * because there are no long-lived objects.
546 *
547 * An intermediate value could be handy after moving long-lived data
548 * into an older generation so an unnecessary GC of this long-lived
549 * data can be avoided.
550 */
9a8c1c2f 551unsigned int gencgc_oldest_gen_to_gc = NUM_GENERATIONS - 1;
0c41e522 552
553
2bf0de4c 554/*
555 * The maximum free page in the heap is maintained and used to update
556 * ALLOCATION_POINTER which is used by the room function to limit its
557 * search of the heap. XX Gencgc obviously needs to be better
558 * integrated with the lisp code.
05747b21 559 *
560 * Except on sparc and ppc, there's no ALLOCATION_POINTER, so it's
561 * never updated. So make this available (non-static).
2bf0de4c 562 */
05747b21 563int last_free_page;
9a8c1c2f 564\f
0c41e522 565
555746e0 566static void scan_weak_tables(void);
567static void scan_weak_objects(void);
0c41e522 568
2bf0de4c 569/*
570 * Misc. heap functions.
571 */
0c41e522 572
2bf0de4c 573/*
574 * Count the number of write protected pages within the given generation.
575 */
9a8c1c2f 576static int
577count_write_protect_generation_pages(int generation)
0c41e522 578{
9a8c1c2f 579 int i;
580 int cnt = 0;
581 int mmask, mflags;
e7e59d7d 582
9a8c1c2f 583 mmask = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK
584 | PAGE_GENERATION_MASK;
585 mflags = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK | generation;
2bf0de4c 586
9a8c1c2f 587 for (i = 0; i < last_free_page; i++)
588 if (PAGE_FLAGS(i, mmask) == mflags)
589 cnt++;
590 return cnt;
0c41e522 591}
592
2bf0de4c 593/*
594 * Count the number of pages within the given generation.
595 */
9a8c1c2f 596static int
597count_generation_pages(int generation)
0c41e522 598{
9a8c1c2f 599 int i;
600 int cnt = 0;
601 int mmask, mflags;
e7e59d7d 602
9a8c1c2f 603 mmask = PAGE_ALLOCATED_MASK | PAGE_GENERATION_MASK;
604 mflags = PAGE_ALLOCATED_MASK | generation;
2bf0de4c 605
9a8c1c2f 606 for (i = 0; i < last_free_page; i++)
607 if (PAGE_FLAGS(i, mmask) == mflags)
608 cnt++;
609 return cnt;
0c41e522 610}
611
2bf0de4c 612/*
613 * Count the number of dont_move pages.
614 */
9a8c1c2f 615static int
616count_dont_move_pages(void)
0c41e522 617{
9a8c1c2f 618 int i;
619 int cnt = 0;
620 int mmask;
e7e59d7d 621
9a8c1c2f 622 mmask = PAGE_ALLOCATED_MASK | PAGE_DONT_MOVE_MASK;
2bf0de4c 623
9a8c1c2f 624 for (i = 0; i < last_free_page; i++)
625 if (PAGE_FLAGS(i, mmask) == mmask)
626 cnt++;
627 return cnt;
0c41e522 628}
629
2bf0de4c 630/*
631 * Work through the pages and add up the number of bytes used for the
632 * given generation.
633 */
06354d92 634#ifdef GC_ASSERTIONS
9a8c1c2f 635static int
636generation_bytes_allocated(int generation)
0c41e522 637{
9a8c1c2f 638 int i;
639 int bytes_allocated = 0;
640 int mmask, mflags;
e7e59d7d 641
9a8c1c2f 642 mmask = PAGE_ALLOCATED_MASK | PAGE_GENERATION_MASK;
643 mflags = PAGE_ALLOCATED_MASK | generation;
2bf0de4c 644
9a8c1c2f 645 for (i = 0; i < last_free_page; i++) {
646 if (PAGE_FLAGS(i, mmask) == mflags)
647 bytes_allocated += page_table[i].bytes_used;
648 }
649 return bytes_allocated;
0c41e522 650}
06354d92 651#endif
0c41e522 652
2bf0de4c 653/*
654 * Return the average age of the memory in a generation.
655 */
8a9d1d8d 656static int
9a8c1c2f 657gen_av_mem_age(int gen)
0c41e522 658{
9a8c1c2f 659 if (generations[gen].bytes_allocated == 0)
8a9d1d8d 660 return 0;
2bf0de4c 661
7933ebf6 662 return (((long long) generations[gen].cum_sum_bytes_allocated) << MEM_AGE_SHIFT) /
8a9d1d8d 663 generations[gen].bytes_allocated;
0c41e522 664}
665
2daa0e7c
RT
666
667void
668save_fpu_state(void* state)
669{
670#if defined(i386) || defined(__x86_64)
671 if (fpu_mode == SSE2) {
672 sse_save(state);
673 } else {
674 fpu_save(state);
675 }
676#else
677 fpu_save(state);
678#endif
679}
680
681void
682restore_fpu_state(void* state)
683{
684#if defined(i386) || defined(__x86_64)
685 if (fpu_mode == SSE2) {
686 sse_restore(state);
687 } else {
688 fpu_restore(state);
689 }
690#else
691 fpu_restore(state);
9a8c1c2f 692#endif
2daa0e7c 693}
9a8c1c2f 694
2daa0e7c
RT
695
696/*
697 * The verbose argument controls how much to print out:
698 * 0 for normal level of detail; 1 for debugging.
699 */
700void
701print_generation_stats(int verbose)
702{
703 int i, gens;
704
705 FPU_STATE(fpu_state);
706
9a8c1c2f 707 /*
708 * This code uses the FP instructions which may be setup for Lisp so
709 * they need to the saved and reset for C.
710 */
46a4f482 711
2daa0e7c 712 save_fpu_state(fpu_state);
46a4f482 713
9a8c1c2f 714 /* Number of generations to print out. */
715 if (verbose)
716 gens = NUM_GENERATIONS + 1;
717 else
718 gens = NUM_GENERATIONS;
719
720 /* Print the heap stats */
0b2b8885 721 fprintf(stderr, " Page count (%d KB)\n", GC_PAGE_SIZE / 1024);
9a8c1c2f 722 fprintf(stderr,
723 " Gen Boxed Unboxed LB LUB Alloc Waste Trigger WP GCs Mem-age\n");
724
725 for (i = 0; i < gens; i++) {
726 int j;
727 int boxed_cnt = 0;
728 int unboxed_cnt = 0;
729 int large_boxed_cnt = 0;
730 int large_unboxed_cnt = 0;
731
732 for (j = 0; j < last_free_page; j++) {
733 int flags = page_table[j].flags;
734
735 if ((flags & PAGE_GENERATION_MASK) == i) {
736 if (flags & PAGE_ALLOCATED_MASK) {
737 /*
738 * Count the number of boxed and unboxed pages within the
739 * given generation.
740 */
741 if (flags & PAGE_UNBOXED_MASK)
742 if (flags & PAGE_LARGE_OBJECT_MASK)
743 large_unboxed_cnt++;
744 else
745 unboxed_cnt++;
746 else if (flags & PAGE_LARGE_OBJECT_MASK)
747 large_boxed_cnt++;
748 else
749 boxed_cnt++;
750 }
751 }
e7e59d7d 752 }
2bf0de4c 753
9a8c1c2f 754 gc_assert(generations[i].bytes_allocated ==
755 generation_bytes_allocated(i));
756 fprintf(stderr, " %5d: %5d %5d %5d %5d %10d %6d %10d %4d %3d %7.4f\n",
757 i, boxed_cnt, unboxed_cnt, large_boxed_cnt, large_unboxed_cnt,
758 generations[i].bytes_allocated,
0b2b8885 759 GC_PAGE_SIZE * count_generation_pages(i) -
9a8c1c2f 760 generations[i].bytes_allocated, generations[i].gc_trigger,
761 count_write_protect_generation_pages(i), generations[i].num_gc,
8a9d1d8d 762 (double)gen_av_mem_age(i) / MEM_AGE_SCALE);
9a8c1c2f 763 }
764 fprintf(stderr, " Total bytes alloc=%ld\n", bytes_allocated);
2d80b863 765
2daa0e7c 766 restore_fpu_state(fpu_state);
0c41e522 767}
768
bf84be07 769/* Get statistics that are kept "on the fly" out of the generation
770 array.
771*/
9a8c1c2f 772void
773get_generation_stats(int gen, struct generation_stats *stats)
774{
775 if (gen <= NUM_GENERATIONS) {
776 stats->bytes_allocated = generations[gen].bytes_allocated;
777 stats->gc_trigger = generations[gen].gc_trigger;
778 stats->bytes_consed_between_gc =
779 generations[gen].bytes_consed_between_gc;
780 stats->num_gc = generations[gen].num_gc;
781 stats->trigger_age = generations[gen].trigger_age;
782 stats->cum_sum_bytes_allocated =
783 generations[gen].cum_sum_bytes_allocated;
784 stats->min_av_mem_age = generations[gen].min_av_mem_age;
785 }
bf84be07 786}
787
9a8c1c2f 788void
789set_gc_trigger(int gen, int trigger)
bf84be07 790{
9a8c1c2f 791 if (gen <= NUM_GENERATIONS) {
792 generations[gen].gc_trigger = trigger;
793 }
bf84be07 794}
0c41e522 795
9a8c1c2f 796void
797set_trigger_age(int gen, int trigger_age)
bf84be07 798{
9a8c1c2f 799 if (gen <= NUM_GENERATIONS) {
800 generations[gen].trigger_age = trigger_age;
801 }
bf84be07 802}
803
9a8c1c2f 804void
805set_min_mem_age(int gen, double min_mem_age)
bf84be07 806{
9a8c1c2f 807 if (gen <= NUM_GENERATIONS) {
8a9d1d8d 808 generations[gen].min_av_mem_age = min_mem_age * MEM_AGE_SCALE;
9a8c1c2f 809 }
bf84be07 810}
0c41e522 811\f
2bf0de4c 812/*
813 * Allocation routines.
814 *
815 *
816 * To support quick and inline allocation, regions of memory can be
817 * allocated and then allocated from with just a free pointer and a
818 * check against an end address.
819 *
820 * Since objects can be allocated to spaces with different properties
821 * e.g. boxed/unboxed, generation, ages; there may need to be many
822 * allocation regions.
823 *
824 * Each allocation region may be start within a partly used page.
825 * Many features of memory use are noted on a page wise basis,
826 * E.g. the generation; so if a region starts within an existing
827 * allocated page it must be consistent with this page.
828 *
829 * During the scavenging of the newspace, objects will be transported
830 * into an allocation region, and pointers updated to point to this
831 * allocation region. It is possible that these pointers will be
832 * scavenged again before the allocation region is closed, E.g. due to
833 * trans_list which jumps all over the place to cleanup the list. It
834 * is important to be able to determine properties of all objects
835 * pointed to when scavenging, E.g to detect pointers to the
836 * oldspace. Thus it's important that the allocation regions have the
837 * correct properties set when allocated, and not just set when
838 * closed. The region allocation routines return regions with the
839 * specified properties, and grab all the pages, setting there
840 * properties appropriately, except that the amount used is not known.
841 *
842 * These regions are used to support quicker allocation using just a
843 * free pointer. The actual space used by the region is not reflected
844 * in the pages tables until it is closed. It can't be scavenged until
845 * closed.
846 *
847 * When finished with the region it should be closed, which will
848 * update the page tables for the actual space used returning unused
849 * space. Further it may be noted in the new regions which is
850 * necessary when scavenging the newspace.
851 *
852 * Large objects may be allocated directly without an allocation
853 * region, the page tables are updated immediately.
854 *
855 * Unboxed objects don't contain points to other objects so don't need
856 * scavenging. Further they can't contain pointers to younger
857 * generations so WP is not needed. By allocating pages to unboxed
858 * objects the whole page never needs scavenging or write protecting.
859 */
0c41e522 860
2bf0de4c 861/*
862 * Only using two regions at present, both are for the current
863 * newspace generation.
864 */
9a8c1c2f 865struct alloc_region boxed_region;
866struct alloc_region unboxed_region;
0c41e522 867
bf84be07 868#if 0
2bf0de4c 869/*
870 * X hack. current lisp code uses the following. Need coping in/out.
871 */
0c41e522 872void *current_region_free_pointer;
873void *current_region_end_addr;
bf84be07 874#endif
0c41e522 875
876/* The generation currently being allocated to. X */
25a69164 877static int gc_alloc_generation = 0;
0c41e522 878
5a1bf534 879extern void do_dynamic_space_overflow_warning(void);
880extern void do_dynamic_space_overflow_error(void);
881
3e309c44 882/* Handle heap overflow here, maybe. */
883static void
9a8c1c2f 884handle_heap_overflow(const char *msg, int size)
3e309c44 885{
9a8c1c2f 886 unsigned long heap_size_mb;
887
888 if (msg) {
889 fprintf(stderr, msg, size);
3e309c44 890 }
891#ifndef SPARSE_BLOCK_SIZE
892#define SPARSE_BLOCK_SIZE (0)
9a8c1c2f 893#endif
894
895 /* Figure out how many MB of heap we have */
896 heap_size_mb = (dynamic_space_size + SPARSE_BLOCK_SIZE) >> 20;
3e309c44 897
9a8c1c2f 898 fprintf(stderr, " CMUCL has run out of dynamic heap space (%lu MB).\n",
899 heap_size_mb);
900 /* Try to handle heap overflow somewhat gracefully if we can. */
3e309c44 901#if defined(trap_DynamicSpaceOverflow) || defined(FEATURE_HEAP_OVERFLOW_CHECK)
9a8c1c2f 902 if (reserved_heap_pages == 0) {
903 fprintf(stderr, "\n Returning to top-level.\n");
904 do_dynamic_space_overflow_error();
905 } else {
906 fprintf(stderr,
907 " You can control heap size with the -dynamic-space-size commandline option.\n");
908 do_dynamic_space_overflow_warning();
3e309c44 909 }
910#else
9a8c1c2f 911 print_generation_stats(1);
3e309c44 912
9a8c1c2f 913 exit(1);
3e309c44 914#endif
915}
916
2bf0de4c 917/*
918 * Find a new region with room for at least the given number of bytes.
919 *
920 * It starts looking at the current generations alloc_start_page. So
921 * may pick up from the previous region if there is enough space. This
922 * keeps the allocation contiguous when scavenging the newspace.
923 *
924 * The alloc_region should have been closed by a call to
925 * gc_alloc_update_page_tables, and will thus be in an empty state.
926 *
927 * To assist the scavenging functions, write protected pages are not
928 * used. Free pages should not be write protected.
929 *
930 * It is critical to the conservative GC that the start of regions be
931 * known. To help achieve this only small regions are allocated at a
932 * time.
933 *
934 * During scavenging, pointers may be found that point within the
935 * current region and the page generation must be set so pointers to
936 * the from space can be recognised. So the generation of pages in
937 * the region are set to gc_alloc_generation. To prevent another
938 * allocation call using the same pages, all the pages in the region
939 * are allocated, although they will initially be empty.
940 */
9a8c1c2f 941static void
942gc_alloc_new_region(int nbytes, int unboxed, struct alloc_region *alloc_region)
943{
944 int first_page;
945 int last_page;
946 int region_size;
947 int restart_page;
948 int bytes_found;
949 int num_pages;
950 int i;
951 int mmask, mflags;
952
953 /* Shut up some compiler warnings */
954 last_page = bytes_found = 0;
955
2bf0de4c 956#if 0
9a8c1c2f 957 fprintf(stderr, "alloc_new_region for %d bytes from gen %d\n",
958 nbytes, gc_alloc_generation);
2bf0de4c 959#endif
0c41e522 960
9a8c1c2f 961 /* Check that the region is in a reset state. */
962 gc_assert(alloc_region->first_page == 0
963 && alloc_region->last_page == -1
964 && alloc_region->free_pointer == alloc_region->end_addr);
965
966 if (unboxed)
967 restart_page =
968 generations[gc_alloc_generation].alloc_unboxed_start_page;
969 else
970 restart_page = generations[gc_alloc_generation].alloc_start_page;
0c41e522 971
9a8c1c2f 972 /*
973 * Search for a contiguous free region of at least nbytes with the
974 * given properties: boxed/unboxed, generation. First setting up the
975 * mask and matching flags.
976 */
0c41e522 977
9a8c1c2f 978 mmask = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK
979 | PAGE_LARGE_OBJECT_MASK | PAGE_DONT_MOVE_MASK
980 | PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK;
981 mflags = PAGE_ALLOCATED_MASK | (unboxed << PAGE_UNBOXED_SHIFT)
982 | gc_alloc_generation;
e7e59d7d 983
9a8c1c2f 984 do {
985 first_page = restart_page;
e7e59d7d 986
9a8c1c2f 987 /*
988 * First search for a page with at least 32 bytes free, that is
989 * not write protected, or marked dont_move.
990 */
2bf0de4c 991
9a8c1c2f 992 while (first_page < dynamic_space_pages) {
993 int flags = page_table[first_page].flags;
e7e59d7d 994
9a8c1c2f 995 if (!(flags & PAGE_ALLOCATED_MASK)
996 || ((flags & mmask) == mflags &&
0b2b8885 997 page_table[first_page].bytes_used < GC_PAGE_SIZE - 32))
9a8c1c2f 998 break;
999 first_page++;
1000 }
e7e59d7d 1001
9a8c1c2f 1002 /* Check for a failure */
1003 if (first_page >= dynamic_space_pages - reserved_heap_pages) {
723055bb 1004#if 0
9a8c1c2f 1005 handle_heap_overflow("*A2 gc_alloc_new_region failed, nbytes=%d.\n",
1006 nbytes);
723055bb 1007#else
9a8c1c2f 1008 break;
723055bb 1009#endif
9a8c1c2f 1010 }
2bf0de4c 1011
9a8c1c2f 1012 gc_assert(!PAGE_WRITE_PROTECTED(first_page));
2bf0de4c 1013
1014#if 0
9a8c1c2f 1015 fprintf(stderr, " first_page=%d bytes_used=%d\n",
1016 first_page, page_table[first_page].bytes_used);
2bf0de4c 1017#endif
1018
9a8c1c2f 1019 /*
1020 * Now search forward to calculate the available region size. It
1021 * tries to keeps going until nbytes are found and the number of
1022 * pages is greater than some level. This helps keep down the
1023 * number of pages in a region.
1024 */
1025 last_page = first_page;
0b2b8885 1026 bytes_found = GC_PAGE_SIZE - page_table[first_page].bytes_used;
9a8c1c2f 1027 num_pages = 1;
1028 while ((bytes_found < nbytes || num_pages < 2)
1029 && last_page < dynamic_space_pages - 1
1030 && !PAGE_ALLOCATED(last_page + 1)) {
1031 last_page++;
1032 num_pages++;
0b2b8885 1033 bytes_found += GC_PAGE_SIZE;
9a8c1c2f 1034 gc_assert(!PAGE_WRITE_PROTECTED(last_page));
1035 }
2bf0de4c 1036
0b2b8885 1037 region_size = (GC_PAGE_SIZE - page_table[first_page].bytes_used)
1038 + GC_PAGE_SIZE * (last_page - first_page);
2bf0de4c 1039
9a8c1c2f 1040 gc_assert(bytes_found == region_size);
2bf0de4c 1041
1042#if 0
9a8c1c2f 1043 fprintf(stderr, " last_page=%d bytes_found=%d num_pages=%d\n",
1044 last_page, bytes_found, num_pages);
2bf0de4c 1045#endif
1046
9a8c1c2f 1047 restart_page = last_page + 1;
1048 }
1049 while (restart_page < dynamic_space_pages && bytes_found < nbytes);
2bf0de4c 1050
9a8c1c2f 1051 if (first_page >= dynamic_space_pages - reserved_heap_pages) {
1052 handle_heap_overflow("*A2 gc_alloc_new_region failed, nbytes=%d.\n",
1053 nbytes);
1054 }
2bf0de4c 1055
9a8c1c2f 1056 /* Check for a failure */
1057 if (restart_page >= (dynamic_space_pages - reserved_heap_pages)
1058 && bytes_found < nbytes) {
1059 handle_heap_overflow("*A1 gc_alloc_new_region failed, nbytes=%d.\n",
1060 nbytes);
1061 }
2bf0de4c 1062#if 0
9a8c1c2f 1063 fprintf(stderr,
1064 "gc_alloc_new_region gen %d: %d bytes: from pages %d to %d: addr=%x\n",
1065 gc_alloc_generation, bytes_found, first_page, last_page,
1066 page_address(first_page));
1067#endif
1068
1069 /* Setup the alloc_region. */
1070 alloc_region->first_page = first_page;
1071 alloc_region->last_page = last_page;
1072 alloc_region->start_addr = page_table[first_page].bytes_used
1073 + page_address(first_page);
1074 alloc_region->free_pointer = alloc_region->start_addr;
1075 alloc_region->end_addr = alloc_region->start_addr + bytes_found;
1076
1077 if (gencgc_zero_check) {
1078 int *p;
1079
1080 for (p = (int *) alloc_region->start_addr;
1081 p < (int *) alloc_region->end_addr; p++)
1082 if (*p != 0)
1083 fprintf(stderr, "** new region not zero @ %lx\n",
1084 (unsigned long) p);
1085 }
0c41e522 1086
9a8c1c2f 1087 /* Setup the pages. */
1088
1089 /* The first page may have already been in use. */
1090 if (page_table[first_page].bytes_used == 0) {
1091 PAGE_FLAGS_UPDATE(first_page, mmask, mflags);
1092 page_table[first_page].first_object_offset = 0;
1093 }
1094
1095 gc_assert(PAGE_ALLOCATED(first_page));
1096 gc_assert(PAGE_UNBOXED_VAL(first_page) == unboxed);
1097 gc_assert(PAGE_GENERATION(first_page) == gc_alloc_generation);
1098 gc_assert(!PAGE_LARGE_OBJECT(first_page));
1099
1100 for (i = first_page + 1; i <= last_page; i++) {
1101 PAGE_FLAGS_UPDATE(i, PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK
1102 | PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK,
1103 PAGE_ALLOCATED_MASK | (unboxed << PAGE_UNBOXED_SHIFT)
1104 | gc_alloc_generation);
1105 /*
1106 * This may not be necessary for unboxed regions (think it was
1107 * broken before!)
1108 */
1109 page_table[i].first_object_offset =
1110 alloc_region->start_addr - page_address(i);
1111 }
1112
1113 /* Bump up the last_free_page */
1114 if (last_page + 1 > last_free_page) {
1115 last_free_page = last_page + 1;
1116 set_alloc_pointer((lispobj) ((char *) heap_base +
0b2b8885 1117 GC_PAGE_SIZE * last_free_page));
9a8c1c2f 1118
1119 }
0c41e522 1120}
1121
1122
1123
2bf0de4c 1124/*
1125 * If the record_new_objects flag is 2 then all new regions created
1126 * are recorded.
1127 *
d54d3cbf 1128 * If it's 1 then it is only recorded if the first page of the
2bf0de4c 1129 * current region is <= new_areas_ignore_page. This helps avoid
1130 * unnecessary recording when doing full scavenge pass.
1131 *
1132 * The new_object structure holds the page, byte offset, and size of
1133 * new regions of objects. Each new area is placed in the array of
1134 * these structures pointed to by new_areas; new_areas_index holds the
1135 * offset into new_areas.
1136 *
1137 * If new_area overflows NUM_NEW_AREAS then it stops adding them. The
1138 * later code must detect this an handle it, probably by doing a full
1139 * scavenge of a generation.
1140 */
0c41e522 1141
1142#define NUM_NEW_AREAS 512
1143static int record_new_objects = 0;
1144static int new_areas_ignore_page;
1145struct new_area {
9a8c1c2f 1146 int page;
1147 int offset;
1148 int size;
0c41e522 1149};
1150static struct new_area (*new_areas)[];
25a69164 1151static int new_areas_index = 0;
0c41e522 1152int max_new_areas;
1153
1154/* Add a new area to new_areas. */
9a8c1c2f 1155static void
1156add_new_area(int first_page, int offset, int size)
0c41e522 1157{
9a8c1c2f 1158 unsigned new_area_start, c;
1159 int i;
0c41e522 1160
9a8c1c2f 1161 /* Ignore if full */
1162 if (new_areas_index >= NUM_NEW_AREAS)
1163 return;
1164
1165 switch (record_new_objects) {
1166 case 0:
1167 return;
1168 case 1:
1169 if (first_page > new_areas_ignore_page)
1170 return;
1171 break;
1172 case 2:
1173 break;
1174 default:
1175 gc_abort();
1176 }
1177
0b2b8885 1178 new_area_start = GC_PAGE_SIZE * first_page + offset;
9a8c1c2f 1179
1180 /*
1181 * Search backwards for a prior area that this follows from. If
1182 * found this will save adding a new area.
1183 */
1184 for (i = new_areas_index - 1, c = 0; i >= 0 && c < 8; i--, c++) {
0b2b8885 1185 unsigned area_end = GC_PAGE_SIZE * (*new_areas)[i].page
9a8c1c2f 1186 + (*new_areas)[i].offset + (*new_areas)[i].size;
0c41e522 1187
2bf0de4c 1188#if 0
9a8c1c2f 1189 fprintf(stderr, "*S1 %d %d %d %d\n", i, c, new_area_start, area_end);
2bf0de4c 1190#endif
9a8c1c2f 1191 if (new_area_start == area_end) {
2bf0de4c 1192#if 0
9a8c1c2f 1193 fprintf(stderr, "-> Adding to [%d] %d %d %d with %d %d %d:\n",
1194 i, (*new_areas)[i].page, (*new_areas)[i].offset,
1195 (*new_areas)[i].size, first_page, offset, size);
2bf0de4c 1196#endif
9a8c1c2f 1197 (*new_areas)[i].size += size;
1198 return;
1199 }
0c41e522 1200 }
2bf0de4c 1201#if 0
9a8c1c2f 1202 fprintf(stderr, "*S1 %d %d %d\n", i, c, new_area_start);
2bf0de4c 1203#endif
0c41e522 1204
9a8c1c2f 1205 (*new_areas)[new_areas_index].page = first_page;
1206 (*new_areas)[new_areas_index].offset = offset;
1207 (*new_areas)[new_areas_index].size = size;
2bf0de4c 1208#if 0
9a8c1c2f 1209 fprintf(stderr, " new_area %d page %d offset %d size %d\n",
1210 new_areas_index, first_page, offset, size);
2bf0de4c 1211#endif
9a8c1c2f 1212 new_areas_index++;
2bf0de4c 1213
9a8c1c2f 1214 /* Note the max new_areas used. */
1215 if (new_areas_index > max_new_areas)
1216 max_new_areas = new_areas_index;
0c41e522 1217}
1218
1219
2bf0de4c 1220/*
1221 * Update the tables for the alloc_region. The region may be added to
1222 * the new_areas.
1223 *
1224 * When done the alloc_region its setup so that the next quick alloc
1225 * will fail safely and thus a new region will be allocated. Further
1226 * it is safe to try and re-update the page table of this reset
1227 * alloc_region.
1228 */
9a8c1c2f 1229void
1230gc_alloc_update_page_tables(int unboxed, struct alloc_region *alloc_region)
0c41e522 1231{
9a8c1c2f 1232 int more;
1233 int first_page;
1234 int next_page;
1235 int bytes_used;
1236 int orig_first_page_bytes_used;
1237 int region_size;
1238 int byte_cnt;
0c41e522 1239
2bf0de4c 1240#if 0
9a8c1c2f 1241 fprintf(stderr, "gc_alloc_update_page_tables to gen %d: ",
1242 gc_alloc_generation);
2bf0de4c 1243#endif
0c41e522 1244
9a8c1c2f 1245 first_page = alloc_region->first_page;
0c41e522 1246
9a8c1c2f 1247 /* Catch an unused alloc_region. */
1248 if (first_page == 0 && alloc_region->last_page == -1)
1249 return;
0c41e522 1250
9a8c1c2f 1251 next_page = first_page + 1;
0c41e522 1252
9a8c1c2f 1253 /* Skip if no bytes were allocated */
1254 if (alloc_region->free_pointer != alloc_region->start_addr) {
1255 orig_first_page_bytes_used = page_table[first_page].bytes_used;
2bf0de4c 1256
9a8c1c2f 1257 gc_assert(alloc_region->start_addr == page_address(first_page) +
1258 page_table[first_page].bytes_used);
2bf0de4c 1259
9a8c1c2f 1260 /* All the pages used need to be updated */
2bf0de4c 1261
9a8c1c2f 1262 /* Update the first page. */
2bf0de4c 1263
9a8c1c2f 1264#if 0
1265 fprintf(stderr, "0");
2bf0de4c 1266#endif
1267
9a8c1c2f 1268 /* If the page was free then setup the gen, and first_object_offset. */
1269 if (page_table[first_page].bytes_used == 0)
1270 gc_assert(page_table[first_page].first_object_offset == 0);
2bf0de4c 1271
9a8c1c2f 1272 gc_assert(PAGE_ALLOCATED(first_page));
1273 gc_assert(PAGE_UNBOXED_VAL(first_page) == unboxed);
1274 gc_assert(PAGE_GENERATION(first_page) == gc_alloc_generation);
1275 gc_assert(!PAGE_LARGE_OBJECT(first_page));
2bf0de4c 1276
9a8c1c2f 1277 byte_cnt = 0;
2bf0de4c 1278
9a8c1c2f 1279 /*
1280 * Calc. the number of bytes used in this page. This is not always
1281 * the number of new bytes, unless it was free.
1282 */
1283 more = 0;
1284 bytes_used = alloc_region->free_pointer - page_address(first_page);
0b2b8885 1285 if (bytes_used > GC_PAGE_SIZE) {
1286 bytes_used = GC_PAGE_SIZE;
9a8c1c2f 1287 more = 1;
1288 }
1289 page_table[first_page].bytes_used = bytes_used;
1290 byte_cnt += bytes_used;
2bf0de4c 1291
9a8c1c2f 1292 /*
1293 * All the rest of the pages should be free. Need to set their
1294 * first_object_offset pointer to the start of the region, and set
1295 * the bytes_used.
1296 */
1297 while (more) {
2bf0de4c 1298#if 0
9a8c1c2f 1299 fprintf(stderr, "+");
1300#endif
1301 gc_assert(PAGE_ALLOCATED(next_page));
1302 gc_assert(PAGE_UNBOXED_VAL(next_page) == unboxed);
1303 gc_assert(page_table[next_page].bytes_used == 0);
1304 gc_assert(PAGE_GENERATION(next_page) == gc_alloc_generation);
1305 gc_assert(!PAGE_LARGE_OBJECT(next_page));
1306
1307 gc_assert(page_table[next_page].first_object_offset ==
1308 alloc_region->start_addr - page_address(next_page));
1309
1310 /* Calc. the number of bytes used in this page. */
1311 more = 0;
1312 bytes_used = alloc_region->free_pointer - page_address(next_page);
0b2b8885 1313 if (bytes_used > GC_PAGE_SIZE) {
1314 bytes_used = GC_PAGE_SIZE;
9a8c1c2f 1315 more = 1;
1316 }
1317 page_table[next_page].bytes_used = bytes_used;
1318 byte_cnt += bytes_used;
2bf0de4c 1319
9a8c1c2f 1320 next_page++;
1321 }
2bf0de4c 1322
9a8c1c2f 1323 region_size = alloc_region->free_pointer - alloc_region->start_addr;
1324 bytes_allocated += region_size;
1325 generations[gc_alloc_generation].bytes_allocated += region_size;
2bf0de4c 1326
9a8c1c2f 1327 gc_assert(byte_cnt - orig_first_page_bytes_used == region_size);
2bf0de4c 1328
9a8c1c2f 1329 /*
1330 * Set the generations alloc restart page to the last page of
1331 * the region.
1332 */
1333 if (unboxed)
1334 generations[gc_alloc_generation].alloc_unboxed_start_page =
1335 next_page - 1;
1336 else
1337 generations[gc_alloc_generation].alloc_start_page = next_page - 1;
2bf0de4c 1338
9a8c1c2f 1339 /* Add the region to the new_areas if requested. */
1340 if (!unboxed)
1341 add_new_area(first_page, orig_first_page_bytes_used, region_size);
2bf0de4c 1342
1343#if 0
9a8c1c2f 1344 fprintf(stderr,
1345 " gc_alloc_update_page_tables update %d bytes to gen %d\n",
1346 region_size, gc_alloc_generation);
2bf0de4c 1347#endif
9a8c1c2f 1348 } else
1349 /*
1350 * No bytes allocated. Unallocate the first_page if there are 0 bytes_used.
1351 */
0c41e522 1352 if (page_table[first_page].bytes_used == 0)
9a8c1c2f 1353 page_table[first_page].flags &= ~PAGE_ALLOCATED_MASK;
2bf0de4c 1354
9a8c1c2f 1355 /* Unallocate any unused pages. */
1356 while (next_page <= alloc_region->last_page) {
1357 gc_assert(page_table[next_page].bytes_used == 0);
1358 page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK;
1359 next_page++;
1360 }
0c41e522 1361
9a8c1c2f 1362 /* Reset the alloc_region. */
1363 alloc_region->first_page = 0;
1364 alloc_region->last_page = -1;
1365 alloc_region->start_addr = page_address(0);
1366 alloc_region->free_pointer = page_address(0);
1367 alloc_region->end_addr = page_address(0);
0c41e522 1368
2bf0de4c 1369#if 0
9a8c1c2f 1370 fprintf(stderr, "\n");
2bf0de4c 1371#endif
0c41e522 1372}
1373
1374
1375
1376static inline void *gc_quick_alloc(int nbytes);
1377
2bf0de4c 1378/*
1379 * Allocate a possibly large object.
1380 */
9a8c1c2f 1381static void *
1382gc_alloc_large(int nbytes, int unboxed, struct alloc_region *alloc_region)
1383{
1384 int first_page;
1385 int last_page;
1386 int region_size;
1387 int restart_page;
1388 int bytes_found;
1389 int num_pages;
1390 int orig_first_page_bytes_used;
1391 int byte_cnt;
1392 int more;
1393 int bytes_used;
1394 int next_page;
1395 int large = (nbytes >= large_object_size);
1396 int mmask, mflags;
0c41e522 1397
2bf0de4c 1398
9a8c1c2f 1399 /* Shut up some compiler warnings */
1400 last_page = bytes_found = 0;
2bf0de4c 1401
723055bb 1402#if 0
9a8c1c2f 1403 if (nbytes > 200000)
1404 fprintf(stderr, "*** alloc_large %d\n", nbytes);
723055bb 1405#endif
2bf0de4c 1406
1407#if 0
9a8c1c2f 1408 fprintf(stderr, "gc_alloc_large for %d bytes from gen %d\n",
1409 nbytes, gc_alloc_generation);
2bf0de4c 1410#endif
1411
9a8c1c2f 1412 /*
1413 * If the object is small, and there is room in the current region
1414 * then allocation it in the current region.
1415 */
1416 if (!large && alloc_region->end_addr - alloc_region->free_pointer >= nbytes)
1417 return gc_quick_alloc(nbytes);
1418
1419 /*
1420 * Search for a contiguous free region of at least nbytes. If it's a
1421 * large object then align it on a page boundary by searching for a
1422 * free page.
1423 */
2bf0de4c 1424
9a8c1c2f 1425 /*
1426 * To allow the allocation of small objects without the danger of
1427 * using a page in the current boxed region, the search starts after
1428 * the current boxed free region. XX could probably keep a page
1429 * index ahead of the current region and bumped up here to save a
1430 * lot of re-scanning.
1431 */
1432 if (unboxed)
1433 restart_page =
1434 generations[gc_alloc_generation].alloc_large_unboxed_start_page;
1435 else
1436 restart_page = generations[gc_alloc_generation].alloc_large_start_page;
1437 if (restart_page <= alloc_region->last_page)
1438 restart_page = alloc_region->last_page + 1;
2bf0de4c 1439
9a8c1c2f 1440 /* Setup the mask and matching flags. */
2bf0de4c 1441
9a8c1c2f 1442 mmask = PAGE_ALLOCATED_MASK | PAGE_WRITE_PROTECTED_MASK
1443 | PAGE_LARGE_OBJECT_MASK | PAGE_DONT_MOVE_MASK
1444 | PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK;
1445 mflags = PAGE_ALLOCATED_MASK | (unboxed << PAGE_UNBOXED_SHIFT)
1446 | gc_alloc_generation;
2bf0de4c 1447
9a8c1c2f 1448 do {
1449 first_page = restart_page;
0c41e522 1450
9a8c1c2f 1451 if (large)
1452 while (first_page < dynamic_space_pages
1453 && PAGE_ALLOCATED(first_page)) first_page++;
1454 else
1455 while (first_page < dynamic_space_pages) {
1456 int flags = page_table[first_page].flags;
1457
1458 if (!(flags & PAGE_ALLOCATED_MASK)
1459 || ((flags & mmask) == mflags &&
0b2b8885 1460 page_table[first_page].bytes_used < GC_PAGE_SIZE - 32))
9a8c1c2f 1461 break;
1462 first_page++;
1463 }
0c41e522 1464
9a8c1c2f 1465 /* Check for a failure */
1466 if (first_page >= dynamic_space_pages - reserved_heap_pages) {
1467#if 0
1468 handle_heap_overflow("*A2 gc_alloc_large failed, nbytes=%d.\n",
1469 nbytes);
1470#else
1471 break;
1472#endif
1473 }
1474 gc_assert(!PAGE_WRITE_PROTECTED(first_page));
2bf0de4c 1475
9a8c1c2f 1476#if 0
1477 fprintf(stderr, " first_page=%d bytes_used=%d\n",
1478 first_page, page_table[first_page].bytes_used);
1479#endif
1480
1481 last_page = first_page;
0b2b8885 1482 bytes_found = GC_PAGE_SIZE - page_table[first_page].bytes_used;
9a8c1c2f 1483 num_pages = 1;
1484 while (bytes_found < nbytes
1485 && last_page < dynamic_space_pages - 1
1486 && !PAGE_ALLOCATED(last_page + 1)) {
1487 last_page++;
1488 num_pages++;
0b2b8885 1489 bytes_found += GC_PAGE_SIZE;
9a8c1c2f 1490 gc_assert(!PAGE_WRITE_PROTECTED(last_page));
1491 }
2bf0de4c 1492
0b2b8885 1493 region_size = (GC_PAGE_SIZE - page_table[first_page].bytes_used)
1494 + GC_PAGE_SIZE * (last_page - first_page);
0c41e522 1495
9a8c1c2f 1496 gc_assert(bytes_found == region_size);
0c41e522 1497
2bf0de4c 1498#if 0
9a8c1c2f 1499 fprintf(stderr, " last_page=%d bytes_found=%d num_pages=%d\n",
1500 last_page, bytes_found, num_pages);
2bf0de4c 1501#endif
0c41e522 1502
9a8c1c2f 1503 restart_page = last_page + 1;
1504 }
1505 while ((restart_page < dynamic_space_pages) && (bytes_found < nbytes));
2bf0de4c 1506
9a8c1c2f 1507 if (first_page >= dynamic_space_pages - reserved_heap_pages) {
1508 handle_heap_overflow("*A2 gc_alloc_large failed, nbytes=%d.\n", nbytes);
1509 }
1510
1511 /* Check for a failure */
1512 if (restart_page >= (dynamic_space_pages - reserved_heap_pages)
1513 && bytes_found < nbytes) {
1514 handle_heap_overflow("*A1 gc_alloc_large failed, nbytes=%d.\n", nbytes);
1515 }
1516#if 0
1517 if (large)
1518 fprintf(stderr,
1519 "gc_alloc_large gen %d: %d of %d bytes: from pages %d to %d: addr=%x\n",
1520 gc_alloc_generation, nbytes, bytes_found, first_page, last_page,
1521 page_address(first_page));
1522#endif
1523
1524 gc_assert(first_page > alloc_region->last_page);
1525 if (unboxed)
1526 generations[gc_alloc_generation].alloc_large_unboxed_start_page =
1527 last_page;
1528 else
1529 generations[gc_alloc_generation].alloc_large_start_page = last_page;
1530
1531 /* Setup the pages. */
1532 orig_first_page_bytes_used = page_table[first_page].bytes_used;
1533
1534 /*
1535 * If the first page was free then setup the gen, and
1536 * first_object_offset.
1537 */
2bf0de4c 1538
9a8c1c2f 1539 if (large)
1540 mflags |= PAGE_LARGE_OBJECT_MASK;
1541 if (page_table[first_page].bytes_used == 0) {
1542 PAGE_FLAGS_UPDATE(first_page, mmask, mflags);
1543 page_table[first_page].first_object_offset = 0;
0c41e522 1544 }
2bf0de4c 1545
9a8c1c2f 1546 gc_assert(PAGE_ALLOCATED(first_page));
1547 gc_assert(PAGE_UNBOXED_VAL(first_page) == unboxed);
1548 gc_assert(PAGE_GENERATION(first_page) == gc_alloc_generation);
1549 gc_assert(PAGE_LARGE_OBJECT_VAL(first_page) == large);
0c41e522 1550
9a8c1c2f 1551 byte_cnt = 0;
0c41e522 1552
9a8c1c2f 1553 /*
1554 * Calc. the number of bytes used in this page. This is not
1555 * always the number of new bytes, unless it was free.
1556 */
1557 more = 0;
1558 bytes_used = nbytes + orig_first_page_bytes_used;
0b2b8885 1559 if (bytes_used > GC_PAGE_SIZE) {
1560 bytes_used = GC_PAGE_SIZE;
9a8c1c2f 1561 more = 1;
1562 }
1563 page_table[first_page].bytes_used = bytes_used;
1564 byte_cnt += bytes_used;
0c41e522 1565
9a8c1c2f 1566 next_page = first_page + 1;
2bf0de4c 1567
9a8c1c2f 1568 /*
1569 * All the rest of the pages should be free. Need to set their
1570 * first_object_offset pointer to the start of the region, and set
1571 * the bytes_used.
1572 */
1573 while (more) {
1574#if 0
1575 fprintf(stderr, "+");
1576#endif
1577
1578 gc_assert(!PAGE_ALLOCATED(next_page));
1579 gc_assert(page_table[next_page].bytes_used == 0);
1580 PAGE_FLAGS_UPDATE(next_page, mmask, mflags);
1581
1582 page_table[next_page].first_object_offset =
0b2b8885 1583 orig_first_page_bytes_used - GC_PAGE_SIZE * (next_page - first_page);
9a8c1c2f 1584
1585 /* Calc. the number of bytes used in this page. */
1586 more = 0;
1587 bytes_used = nbytes + orig_first_page_bytes_used - byte_cnt;
0b2b8885 1588 if (bytes_used > GC_PAGE_SIZE) {
1589 bytes_used = GC_PAGE_SIZE;
9a8c1c2f 1590 more = 1;
1591 }
1592 page_table[next_page].bytes_used = bytes_used;
1593 byte_cnt += bytes_used;
1594
1595 next_page++;
1596 }
1597
1598 gc_assert(byte_cnt - orig_first_page_bytes_used == nbytes);
1599
1600 bytes_allocated += nbytes;
1601 generations[gc_alloc_generation].bytes_allocated += nbytes;
1602
1603 /* Add the region to the new_areas if requested. */
1604 if (!unboxed)
1605 add_new_area(first_page, orig_first_page_bytes_used, nbytes);
1606
1607 /* Bump up the last_free_page */
1608 if (last_page + 1 > last_free_page) {
1609 last_free_page = last_page + 1;
1610 set_alloc_pointer((lispobj) ((char *) heap_base +
0b2b8885 1611 GC_PAGE_SIZE * last_free_page));
9a8c1c2f 1612 }
1613
1614 return (void *) (page_address(first_page) + orig_first_page_bytes_used);
1615}
1616
1617/*
68ac9a3e 1618 * If the current region has more than this much space left, we don't
1619 * want to abandon the region (wasting space), but do a "large" alloc
1620 * to a new region.
9a8c1c2f 1621 */
68ac9a3e 1622
1623int region_empty_threshold = 32;
1624
1625
1626/*
1627 * How many consecutive large alloc we can do before we abandon the
c5b3b076 1628 * current region.
68ac9a3e 1629 */
1630int consecutive_large_alloc_limit = 10;
1631
1632
1633/*
c5b3b076 1634 * Statistics for the current region
68ac9a3e 1635 */
1636struct alloc_stats
9a8c1c2f 1637{
c5b3b076 1638 /*
1639 * How many consecutive allocations we have tried with the current
1640 * region (in saved_region)
1641 */
68ac9a3e 1642 int consecutive_alloc;
c5b3b076 1643 /*
1644 * How many times we tried to allocate to this region but didn't
1645 * because we didn't have enough room and did a large alloc in a
1646 * different region.
1647 */
68ac9a3e 1648 int abandon_region_count;
c5b3b076 1649
1650 /*
1651 * A copy of the current allocation region which we use to compare
1652 * against.
1653 */
68ac9a3e 1654 struct alloc_region saved_region;
1655};
2bf0de4c 1656
c5b3b076 1657/* Statistics for boxed and unboxed regions */
68ac9a3e 1658struct alloc_stats boxed_stats =
c5b3b076 1659{0, 0,
68ac9a3e 1660 {NULL, NULL, -1, -1, NULL}};
1661
1662struct alloc_stats unboxed_stats =
c5b3b076 1663{0, 0,
68ac9a3e 1664 {NULL, NULL, -1, -1, NULL}};
1665
1666/*
1667 * Try to allocate from the current region. If it's possible, do the
1668 * allocation and return the object. If it's not possible, return
1669 * (void*) -1.
1670 */
1671static inline void *
1672gc_alloc_try_current_region(int nbytes, struct alloc_region *region, int unboxed,
1673 struct alloc_stats *stats)
1674{
1675 char *new_free_pointer;
2bf0de4c 1676
9a8c1c2f 1677 /* Check if there is room in the current alloc region. */
68ac9a3e 1678 new_free_pointer = region->free_pointer + nbytes;
2bf0de4c 1679
68ac9a3e 1680 if (new_free_pointer <= region->end_addr) {
9a8c1c2f 1681 /* If so then allocate from the current alloc region. */
68ac9a3e 1682 char *new_obj = region->free_pointer;
0c41e522 1683
68ac9a3e 1684 region->free_pointer = new_free_pointer;
2bf0de4c 1685
9a8c1c2f 1686 /* Check if the alloc region is almost empty. */
c5b3b076 1687 if (region->end_addr - region->free_pointer <= region_empty_threshold) {
9a8c1c2f 1688 /* If so finished with the current region. */
68ac9a3e 1689 gc_alloc_update_page_tables(unboxed, region);
9a8c1c2f 1690 /* Setup a new region. */
c5b3b076 1691 gc_alloc_new_region(region_empty_threshold, unboxed, region);
9a8c1c2f 1692 }
68ac9a3e 1693
1694 stats->consecutive_alloc = 0;
c5b3b076 1695 stats->abandon_region_count = 0;
68ac9a3e 1696 memcpy(&stats->saved_region, region, sizeof(stats->saved_region));
1697
9a8c1c2f 1698 return (void *) new_obj;
68ac9a3e 1699 } else {
1700 return (void *) -1;
1701 }
1702}
1703
1704/*
1705 * Allocate bytes from a boxed or unboxed region. It first checks if
1706 * there is room, if not then it calls gc_alloc_new_region to find a
1707 * new region with enough space. A pointer to the start of the region
1708 * is returned. The parameter "unboxed" should be 0 (boxed) or 1
1709 * (unboxed).
1710 */
1711static void *
1712gc_alloc_region(int nbytes, struct alloc_region *region, int unboxed, struct alloc_stats *stats)
1713{
1714 void *new_obj;
1715
1716#if 0
1717 fprintf(stderr, "gc_alloc %d\n", nbytes);
1718#endif
1719
1720 /* Check if there is room in the current alloc region. */
1721
1722 new_obj = gc_alloc_try_current_region(nbytes, region, unboxed, stats);
1723 if (new_obj != (void *) -1) {
1724 return new_obj;
0c41e522 1725 }
2bf0de4c 1726
9a8c1c2f 1727 /* Else not enough free space in the current region. */
1728
1729 /*
68ac9a3e 1730 * If the allocation is large enough, always do a large alloc This
1731 * helps GC so we don't have to copy this object again.
1732 */
1733
1734 if (nbytes >= large_object_size) {
1735 return gc_alloc_large(nbytes, unboxed, region);
1736 }
1737
1738 /*
9a8c1c2f 1739 * If there is a bit of room left in the current region then
1740 * allocate a large object.
1741 */
68ac9a3e 1742
1743 /*
1744 * This has potentially very bad behavior on sparc if the current
1745 * boxed region is too small for the allocation, but the free
1746 * space is greater than 32 (region_empty_threshold). The
1747 * scenario is where we're always allocating something that won't
1748 * fit in the boxed region, and we keep calling gc_alloc_large.
1749 * Since gc_alloc_large doesn't change the region, the next
1750 * allocation will again be out-of-line and we hit a kernel trap
1751 * again. And so on, so we waste all of our time doing kernel
1752 * traps to allocate small things. This also affects ppc.
1753 *
1754 * X86 has the same issue, but the affect is less because the
1755 * out-of-line allocation is a just a function call, not a kernel
1756 * trap.
1757 *
1758 * Heuristic: If we do too many consecutive large allocations
1759 * because the current region has some space left, we give up and
1760 * abandon the region. This will prevent the bad scenario above
1761 * from killing allocation performance.
1762 *
1763 */
1764
1765 if ((region->end_addr - region->free_pointer > region_empty_threshold)
1766 && (stats->consecutive_alloc < consecutive_large_alloc_limit)) {
1767 /*
1768 * Is the saved region the same as the current region? If so,
1769 * update the counter. If not, that means we did some other
c5b3b076 1770 * (inline) allocation, so reset the counters and region to
1771 * the current region.
68ac9a3e 1772 */
1773 if (memcmp(&stats->saved_region, region, sizeof(stats->saved_region)) == 0) {
1774 ++stats->consecutive_alloc;
1775 } else {
1776 stats->consecutive_alloc = 0;
c5b3b076 1777 stats->abandon_region_count = 0;
68ac9a3e 1778 memcpy(&stats->saved_region, region, sizeof(stats->saved_region));
1779 }
1780
1781 return gc_alloc_large(nbytes, unboxed, region);
1782 }
1783
c5b3b076 1784 /*
1785 * We given up on the current region because the
1786 * consecutive_large_alloc_limit has been reached.
1787 */
68ac9a3e 1788 stats->consecutive_alloc = 0;
1789 ++stats->abandon_region_count;
9a8c1c2f 1790
9a8c1c2f 1791 /* Finished with the current region. */
68ac9a3e 1792 gc_alloc_update_page_tables(unboxed, region);
9a8c1c2f 1793
1794 /* Setup a new region. */
68ac9a3e 1795 gc_alloc_new_region(nbytes, unboxed, region);
9a8c1c2f 1796
1797 /* Should now be enough room. */
1798
68ac9a3e 1799 new_obj = gc_alloc_try_current_region(nbytes, region, unboxed, stats);
1800 if (new_obj != (void *) -1) {
1801 return new_obj;
9a8c1c2f 1802 }
1803
1804 /* Shouldn't happen? */
1805 gc_assert(0);
1806 return 0;
0c41e522 1807}
1808
2bf0de4c 1809/*
68ac9a3e 1810 * Allocate bytes from the boxed_region. It first checks if there is
1811 * room, if not then it calls gc_alloc_new_region to find a new region
1812 * with enough space. A pointer to the start of the region is returned.
1813 */
1814static inline void *
1815gc_alloc(int nbytes)
1816{
1817 void* obj;
1818
1819 obj = gc_alloc_region(nbytes, &boxed_region, 0, &boxed_stats);
1820
1821 return obj;
1822}
1823
1824/*
2bf0de4c 1825 * Allocate space from the boxed_region. If there is not enough free
1826 * space then call gc_alloc to do the job. A pointer to the start of
1827 * the region is returned.
1828 */
9a8c1c2f 1829static inline void *
1830gc_quick_alloc(int nbytes)
0c41e522 1831{
9a8c1c2f 1832 char *new_free_pointer;
0c41e522 1833
9a8c1c2f 1834 /* Check if there is room in the current region. */
1835 new_free_pointer = boxed_region.free_pointer + nbytes;
2bf0de4c 1836
9a8c1c2f 1837 if (new_free_pointer <= boxed_region.end_addr) {
1838 /* If so then allocate from the current region. */
1839 void *new_obj = boxed_region.free_pointer;
1840
1841 boxed_region.free_pointer = new_free_pointer;
1842 return (void *) new_obj;
1843 }
2bf0de4c 1844
9a8c1c2f 1845 /* Else call gc_alloc */
1846 return gc_alloc(nbytes);
0c41e522 1847}
1848
2bf0de4c 1849/*
1850 * Allocate space for the boxed object. If it is a large object then
1851 * do a large alloc else allocate from the current region. If there is
1852 * not enough free space then call gc_alloc to do the job. A pointer
1853 * to the start of the region is returned.
1854 */
9a8c1c2f 1855static inline void *
1856gc_quick_alloc_large(int nbytes)
0c41e522 1857{
9a8c1c2f 1858 char *new_free_pointer;
0c41e522 1859
9a8c1c2f 1860 if (nbytes >= large_object_size)
1861 return gc_alloc_large(nbytes, 0, &boxed_region);
0c41e522 1862
9a8c1c2f 1863 /* Check if there is room in the current region. */
1864 new_free_pointer = boxed_region.free_pointer + nbytes;
2bf0de4c 1865
9a8c1c2f 1866 if (new_free_pointer <= boxed_region.end_addr) {
1867 /* If so then allocate from the current region. */
1868 void *new_obj = boxed_region.free_pointer;
2bf0de4c 1869
9a8c1c2f 1870 boxed_region.free_pointer = new_free_pointer;
1871 return (void *) new_obj;
1872 }
1873
1874 /* Else call gc_alloc */
1875 return gc_alloc(nbytes);
0c41e522 1876}
1877
68ac9a3e 1878static inline void *
9a8c1c2f 1879gc_alloc_unboxed(int nbytes)
0c41e522 1880{
68ac9a3e 1881 void *obj;
0c41e522 1882
68ac9a3e 1883 obj = gc_alloc_region(nbytes, &unboxed_region, 1, &unboxed_stats);
2bf0de4c 1884
68ac9a3e 1885 return obj;
0c41e522 1886}
1887
9a8c1c2f 1888static inline void *
1889gc_quick_alloc_unboxed(int nbytes)
0c41e522 1890{
9a8c1c2f 1891 char *new_free_pointer;
1892
1893 /* Check if there is room in the current region. */
1894 new_free_pointer = unboxed_region.free_pointer + nbytes;
0c41e522 1895
9a8c1c2f 1896 if (new_free_pointer <= unboxed_region.end_addr) {
1897 /* If so then allocate from the current region. */
1898 void *new_obj = unboxed_region.free_pointer;
2bf0de4c 1899
9a8c1c2f 1900 unboxed_region.free_pointer = new_free_pointer;
2bf0de4c 1901
9a8c1c2f 1902 return (void *) new_obj;
0c41e522 1903 }
2bf0de4c 1904
9a8c1c2f 1905 /* Else call gc_alloc */
1906 return gc_alloc_unboxed(nbytes);
0c41e522 1907}
1908
2bf0de4c 1909/*
1910 * Allocate space for the object. If it is a large object then do a
1911 * large alloc else allocate from the current region. If there is not
1912 * enough free space then call gc_alloc to do the job.
1913 *
1914 * A pointer to the start of the region is returned.
1915 */
9a8c1c2f 1916static inline void *
1917gc_quick_alloc_large_unboxed(int nbytes)
0c41e522 1918{
9a8c1c2f 1919 char *new_free_pointer;
0c41e522 1920
9a8c1c2f 1921 if (nbytes >= large_object_size)
1922 return gc_alloc_large(nbytes, 1, &unboxed_region);
0c41e522 1923
9a8c1c2f 1924 /* Check if there is room in the current region. */
1925 new_free_pointer = unboxed_region.free_pointer + nbytes;
2bf0de4c 1926
9a8c1c2f 1927 if (new_free_pointer <= unboxed_region.end_addr) {
1928 /* If so then allocate from the current region. */
1929 void *new_obj = unboxed_region.free_pointer;
2bf0de4c 1930
9a8c1c2f 1931 unboxed_region.free_pointer = new_free_pointer;
1932
1933 return (void *) new_obj;
1934 }
2bf0de4c 1935
9a8c1c2f 1936 /* Else call gc_alloc */
1937 return gc_alloc_unboxed(nbytes);
0c41e522 1938}
1939
1940/***************************************************************************/
0c41e522 1941\f
9a8c1c2f 1942
0c41e522 1943/* Scavenging/transporting routines derived from gc.c */
1944
9a8c1c2f 1945static int (*scavtab[256]) (lispobj * where, lispobj object);
1946static lispobj(*transother[256]) (lispobj object);
1947static int (*sizetab[256]) (lispobj * where);
0c41e522 1948
1949static struct weak_pointer *weak_pointers;
2bf0de4c 1950static struct scavenger_hook *scavenger_hooks = (struct scavenger_hook *) NIL;
0c41e522 1951
68ac9a3e 1952/* Like (ceiling x y), but y is constrained to be a power of two */
0c41e522 1953#define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))
0c41e522 1954\f
9a8c1c2f 1955
0c41e522 1956/* Predicates */
1957
9a8c1c2f 1958static inline boolean
1959from_space_p(lispobj obj)
0c41e522 1960{
9a8c1c2f 1961 int page_index = (char *) obj - heap_base;
1962
1963 return page_index >= 0
1964 && (page_index =
0b2b8885 1965 (unsigned int) page_index / GC_PAGE_SIZE) < dynamic_space_pages
9a8c1c2f 1966 && PAGE_GENERATION(page_index) == from_space;
0c41e522 1967}
1968
9a8c1c2f 1969static inline boolean
1970new_space_p(lispobj obj)
0c41e522 1971{
9a8c1c2f 1972 int page_index = (char *) obj - heap_base;
0c41e522 1973
9a8c1c2f 1974 return page_index >= 0
1975 && (page_index =
0b2b8885 1976 (unsigned int) page_index / GC_PAGE_SIZE) < dynamic_space_pages
9a8c1c2f 1977 && PAGE_GENERATION(page_index) == new_space;
1978}
45380dbb 1979
1980static inline boolean
1981dynamic_space_p(lispobj obj)
1982{
1983 lispobj end = DYNAMIC_0_SPACE_START + DYNAMIC_SPACE_SIZE;
1984
1985 return (obj >= DYNAMIC_0_SPACE_START) && (obj < end);
1986}
1987
1988static inline boolean
1989static_space_p(lispobj obj)
1990{
1991 lispobj end = SymbolValue(STATIC_SPACE_FREE_POINTER);
1992
1993 return (obj >= STATIC_SPACE_START) && (obj < end);
1994}
1995
1996static inline boolean
1997read_only_space_p(lispobj obj)
1998{
1999 lispobj end = SymbolValue(READ_ONLY_SPACE_FREE_POINTER);
2000
2001 return (obj >= READ_ONLY_SPACE_START) && (obj < end);
2002}
2003
2004static inline boolean
2005control_stack_space_p(lispobj obj)
2006{
e7997cb6 2007 lispobj end = CONTROL_STACK_START + control_stack_size;
45380dbb 2008
2009 return (obj >= CONTROL_STACK_START) && (obj < end);
2010}
2011
2012static inline boolean
2013binding_stack_space_p(lispobj obj)
2014{
e7997cb6 2015 lispobj end = BINDING_STACK_START + binding_stack_size;
45380dbb 2016
2017 return (obj >= BINDING_STACK_START) && (obj < end);
2018}
2019
2020static inline boolean
2021signal_space_p(lispobj obj)
2022{
2023#ifdef SIGNAL_STACK_START
2024 lispobj end = SIGNAL_STACK_START + SIGSTKSZ;
2025
2026 return (obj >= SIGNAL_STACK_START) && (obj < end);
2027#else
2028 return FALSE;
2029#endif
2030}
b7271901 2031
30102669 2032#if (defined(DARWIN) && defined(__ppc__))
b7271901 2033/*
2034 * The assembly code defines these as functions, so we make them
2035 * functions. We only care about their addresses anyway.
2036 */
2037extern char closure_tramp();
2038extern char undefined_tramp();
30102669 2039#elif defined(sparc)
2040/* closure tramp and undefined tramp are Lisp assembly routines */
2041#elif (defined(i386) || defined(__x86_64))
2042/* undefined tramp are Lisp assembly routines */
b7271901 2043#else
2044extern int undefined_tramp;
2045#endif
2046
2047/*
2048 * Other random places that can't be in malloc space. Return TRUE if
2049 * obj is in some other known space
2050 */
2051static inline boolean
2052other_space_p(lispobj obj)
2053{
2054 boolean in_space = FALSE;
2055
2056#if defined(sparc)
2057 extern char _end;
2058
2059 /*
2060 * Skip over any objects in the C runtime which includes the
2061 * closure_tramp and undefined_tramp objects. There appears to be
2062 * one other object that points to somewhere in call_into_c, but I
2063 * don't know what that is. I think that's probably all for
2064 * sparc.
2065 */
2066 if ((char*) obj <= &_end) {
2067 in_space = TRUE;
2068 }
f0626999 2069#elif defined(i386)
865ee266 2070#if defined(DARWIN) || defined(__linux__) || defined(__FreeBSD__) || defined(__NetBSD__)
b7271901 2071 /*
f0626999 2072 * For x86, we see some object at 0xffffffe9. I (rtoy) am not
2073 * sure that is, but it clearly can't be in malloc space so we
2074 * want to skip that (by returning TRUE).
b7271901 2075 *
2076 * Is there anything else?
2077 */
2078 if (obj == (lispobj) 0xffffffe9) {
2079 in_space = TRUE;
2080 }
9dcff02e 2081#elif defined(__ppc__)
e7997cb6
RT
2082 /*
2083 * For ppc, just ignore anything below fpu_restore, which is
2084 * currently at the end of ppc-assem.S.
2085 */
9dcff02e
RT
2086 if (obj <= (lispobj) &fpu_restore) {
2087 in_space = TRUE;
2088 }
f0626999 2089#endif
b7271901 2090#endif
2091
2092 return in_space;
2093}
2094
0c41e522 2095\f
9a8c1c2f 2096
0c41e522 2097/* Copying Objects */
2098
2099
2100/* Copying Boxed Objects */
9a8c1c2f 2101static inline lispobj
2102copy_object(lispobj object, int nwords)
0c41e522 2103{
9a8c1c2f 2104 int tag;
2105 lispobj *new;
2106 lispobj *source, *dest;
2bf0de4c 2107
9a8c1c2f 2108 gc_assert(Pointerp(object));
2109 gc_assert(from_space_p(object));
2110 gc_assert((nwords & 0x01) == 0);
2bf0de4c 2111
9a8c1c2f 2112 /* get tag of object */
2113 tag = LowtagOf(object);
0c41e522 2114
9a8c1c2f 2115 /* allocate space */
2116 new = gc_quick_alloc(nwords * sizeof(lispobj));
2bf0de4c 2117
9a8c1c2f 2118 dest = new;
2119 source = (lispobj *) PTR(object);
2bf0de4c 2120
9a8c1c2f 2121 /* copy the object */
2122 while (nwords > 0) {
2123 dest[0] = source[0];
2124 dest[1] = source[1];
2125 dest += 2;
2126 source += 2;
2127 nwords -= 2;
2128 }
2bf0de4c 2129
9a8c1c2f 2130 /* return lisp pointer of new object */
2131 return (lispobj) new | tag;
0c41e522 2132}
2133
2bf0de4c 2134/*
2135 * Copying Large Boxed Objects. If the object is in a large object
2136 * region then it is simply promoted, else it is copied. If it's large
2137 * enough then it's copied to a large object region.
2138 *
2139 * Vectors may have shrunk. If the object is not copied the space
2140 * needs to be reclaimed, and the page_tables corrected.
2141 */
9a8c1c2f 2142static lispobj
2143copy_large_object(lispobj object, int nwords)
0c41e522 2144{
9a8c1c2f 2145 int tag;
2146 lispobj *new;
2147 lispobj *source, *dest;
2148 int first_page;
2bf0de4c 2149
9a8c1c2f 2150 gc_assert(Pointerp(object));
2151 gc_assert(from_space_p(object));
2152 gc_assert((nwords & 0x01) == 0);
0c41e522 2153
9a8c1c2f 2154 if (gencgc_verbose && nwords > 1024 * 1024)
44e0351e 2155 fprintf(stderr, "** copy_large_object: %lu\n",
2156 (unsigned long) (nwords * sizeof(lispobj)));
0c41e522 2157
9a8c1c2f 2158 /* Check if it's a large object. */
2159 first_page = find_page_index((void *) object);
2160 gc_assert(first_page >= 0);
0c41e522 2161
9a8c1c2f 2162 if (PAGE_LARGE_OBJECT(first_page)) {
2163 /* Promote the object. */
2164 int remaining_bytes;
2165 int next_page;
2166 int bytes_freed;
2167 int old_bytes_used;
2168 int mmask, mflags;
2bf0de4c 2169
9a8c1c2f 2170 /*
2171 * Note: Any page write protection must be removed, else a later
2172 * scavenge_newspace may incorrectly not scavenge these pages.
2173 * This would not be necessary if they are added to the new areas,
2174 * but lets do it for them all (they'll probably be written
2175 * anyway?).
2176 */
0c41e522 2177
9a8c1c2f 2178 gc_assert(page_table[first_page].first_object_offset == 0);
0c41e522 2179
9a8c1c2f 2180 next_page = first_page;
2181 remaining_bytes = nwords * sizeof(lispobj);
0b2b8885 2182 while (remaining_bytes > GC_PAGE_SIZE) {
9a8c1c2f 2183 gc_assert(PAGE_GENERATION(next_page) == from_space);
2184 gc_assert(PAGE_ALLOCATED(next_page));
2185 gc_assert(!PAGE_UNBOXED(next_page));
2186 gc_assert(PAGE_LARGE_OBJECT(next_page));
2187 gc_assert(page_table[next_page].first_object_offset ==
0b2b8885 2188 GC_PAGE_SIZE * (first_page - next_page));
2189 gc_assert(page_table[next_page].bytes_used == GC_PAGE_SIZE);
0c41e522 2190
9a8c1c2f 2191 PAGE_FLAGS_UPDATE(next_page, PAGE_GENERATION_MASK, new_space);
2bf0de4c 2192
9a8c1c2f 2193 /*
2194 * Remove any write protection. Should be able to religh on the
2195 * WP flag to avoid redundant calls.
2196 */
2197 if (PAGE_WRITE_PROTECTED(next_page)) {
0b2b8885 2198 os_protect((os_vm_address_t) page_address(next_page), GC_PAGE_SIZE,
9a8c1c2f 2199 OS_VM_PROT_ALL);
2200 page_table[next_page].flags &= ~PAGE_WRITE_PROTECTED_MASK;
2201 }
0b2b8885 2202 remaining_bytes -= GC_PAGE_SIZE;
9a8c1c2f 2203 next_page++;
2204 }
2bf0de4c 2205
9a8c1c2f 2206 /*
2207 * Now only one page remains, but the object may have shrunk so
2208 * there may be more unused pages which will be freed.
2209 */
2bf0de4c 2210
9a8c1c2f 2211 /* Object may have shrunk but shouldn't have grown - check. */
2212 gc_assert(page_table[next_page].bytes_used >= remaining_bytes);
2bf0de4c 2213
9a8c1c2f 2214 PAGE_FLAGS_UPDATE(next_page, PAGE_GENERATION_MASK, new_space);
2215 gc_assert(PAGE_ALLOCATED(next_page));
2216 gc_assert(!PAGE_UNBOXED(next_page));
2bf0de4c 2217
9a8c1c2f 2218 /* Adjust the bytes_used. */
2219 old_bytes_used = page_table[next_page].bytes_used;
2220 page_table[next_page].bytes_used = remaining_bytes;
e7e59d7d 2221
9a8c1c2f 2222 bytes_freed = old_bytes_used - remaining_bytes;
2bf0de4c 2223
9a8c1c2f 2224 mmask = PAGE_ALLOCATED_MASK | PAGE_UNBOXED_MASK | PAGE_LARGE_OBJECT_MASK
2225 | PAGE_GENERATION_MASK;
2226 mflags = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK | from_space;
2bf0de4c 2227
9a8c1c2f 2228 /* Free any remaining pages; needs care. */
2229 next_page++;
0b2b8885 2230 while (old_bytes_used == GC_PAGE_SIZE &&
9a8c1c2f 2231 PAGE_FLAGS(next_page, mmask) == mflags &&
2232 page_table[next_page].first_object_offset ==
0b2b8885 2233 GC_PAGE_SIZE * (first_page - next_page)) {
9a8c1c2f 2234 /*
2235 * Checks out OK, free the page. Don't need to both zeroing
2236 * pages as this should have been done before shrinking the
2237 * object. These pages shouldn't be write protected as they
2238 * should be zero filled.
2239 */
2240 gc_assert(!PAGE_WRITE_PROTECTED(next_page));
2bf0de4c 2241
9a8c1c2f 2242 old_bytes_used = page_table[next_page].bytes_used;
2243 page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK;
2244 page_table[next_page].bytes_used = 0;
2245 bytes_freed += old_bytes_used;
2246 next_page++;
2247 }
0c41e522 2248
9a8c1c2f 2249 if (gencgc_verbose && bytes_freed > 0)
2250 fprintf(stderr, "* copy_large_boxed bytes_freed %d\n", bytes_freed);
2bf0de4c 2251
9a8c1c2f 2252 generations[from_space].bytes_allocated -=
2253 sizeof(lispobj) * nwords + bytes_freed;
2254 generations[new_space].bytes_allocated += sizeof(lispobj) * nwords;
2255 bytes_allocated -= bytes_freed;
2bf0de4c 2256
9a8c1c2f 2257 /* Add the region to the new_areas if requested. */
2258 add_new_area(first_page, 0, nwords * sizeof(lispobj));
2bf0de4c 2259
9a8c1c2f 2260 return object;
2261 } else {
2262 /* get tag of object */
2263 tag = LowtagOf(object);
2264
2265 /* allocate space */
2266 new = gc_quick_alloc_large(nwords * sizeof(lispobj));
2267
2268 dest = new;
2269 source = (lispobj *) PTR(object);
2270
2271 /* copy the object */
2272 while (nwords > 0) {
2273 dest[0] = source[0];
2274 dest[1] = source[1];
2275 dest += 2;
2276 source += 2;
2277 nwords -= 2;
2278 }
2bf0de4c 2279
9a8c1c2f 2280 /* return lisp pointer of new object */
2281 return (lispobj) new | tag;
2282 }
0c41e522 2283}
2284
2285/* Copying UnBoxed Objects. */
9a8c1c2f 2286static inline lispobj
2287copy_unboxed_object(lispobj object, int nwords)
0c41e522 2288{
9a8c1c2f 2289 int tag;
2290 lispobj *new;
2291 lispobj *source, *dest;
2bf0de4c 2292
9a8c1c2f 2293 gc_assert(Pointerp(object));
2294 gc_assert(from_space_p(object));
2295 gc_assert((nwords & 0x01) == 0);
2bf0de4c 2296
9a8c1c2f 2297 /* get tag of object */
2298 tag = LowtagOf(object);
0c41e522 2299
9a8c1c2f 2300 /* allocate space */
2301 new = gc_quick_alloc_unboxed(nwords * sizeof(lispobj));
2bf0de4c 2302
9a8c1c2f 2303 dest = new;
2304 source = (lispobj *) PTR(object);
2bf0de4c 2305
9a8c1c2f 2306 /* Copy the object */
2307 while (nwords > 0) {
2308 dest[0] = source[0];
2309 dest[1] = source[1];
2310 dest += 2;
2311 source += 2;
2312 nwords -= 2;
2313 }
2bf0de4c 2314
9a8c1c2f 2315 /* Return lisp pointer of new object. */
2316 return (lispobj) new | tag;
0c41e522 2317}
2318
2319
2bf0de4c 2320/*
2321 * Copying Large Unboxed Objects. If the object is in a large object
2322 * region then it is simply promoted, else it is copied. If it's large
2323 * enough then it's copied to a large object region.
2324 *
2325 * Bignums and vectors may have shrunk. If the object is not copied
2326 * the space needs to be reclaimed, and the page_tables corrected.
2327 */
9a8c1c2f 2328static lispobj
2329copy_large_unboxed_object(lispobj object, int nwords)
0c41e522 2330{
9a8c1c2f 2331 int tag;
2332 lispobj *new;
2333 lispobj *source, *dest;
2334 int first_page;
0c41e522 2335
9a8c1c2f 2336 gc_assert(Pointerp(object));
2337 gc_assert(from_space_p(object));
2338 gc_assert((nwords & 0x01) == 0);
0c41e522 2339
9a8c1c2f 2340 if (gencgc_verbose && nwords > 1024 * 1024)
555746e0 2341 fprintf(stderr, "** copy_large_unboxed_object: %lu\n",
44e0351e 2342 (unsigned long) (nwords * sizeof(lispobj)));
0c41e522 2343
9a8c1c2f 2344 /* Check if it's a large object. */
2345 first_page = find_page_index((void *) object);
2346 gc_assert(first_page >= 0);
2bf0de4c 2347
9a8c1c2f 2348 if (PAGE_LARGE_OBJECT(first_page)) {
2349 /*
2350 * Promote the object. Note: Unboxed objects may have been
2351 * allocated to a BOXED region so it may be necessary to change
2352 * the region to UNBOXED.
2353 */
2354 int remaining_bytes;
2355 int next_page;
2356 int bytes_freed;
2357 int old_bytes_used;
2358 int mmask, mflags;
2359
2360 gc_assert(page_table[first_page].first_object_offset == 0);
2361
2362 next_page = first_page;
2363 remaining_bytes = nwords * sizeof(lispobj);
0b2b8885 2364 while (remaining_bytes > GC_PAGE_SIZE) {
9a8c1c2f 2365 gc_assert(PAGE_GENERATION(next_page) == from_space);
2366 gc_assert(PAGE_ALLOCATED(next_page));
2367 gc_assert(PAGE_LARGE_OBJECT(next_page));
2368 gc_assert(page_table[next_page].first_object_offset ==
0b2b8885 2369 GC_PAGE_SIZE * (first_page - next_page));
2370 gc_assert(page_table[next_page].bytes_used == GC_PAGE_SIZE);
9a8c1c2f 2371
2372 PAGE_FLAGS_UPDATE(next_page,
2373 PAGE_UNBOXED_MASK | PAGE_GENERATION_MASK,
2374 PAGE_UNBOXED_MASK | new_space);
0b2b8885 2375 remaining_bytes -= GC_PAGE_SIZE;
9a8c1c2f 2376 next_page++;
2377 }
2bf0de4c 2378
9a8c1c2f 2379 /*
2380 * Now only one page remains, but the object may have shrunk so
2381 * there may be more unused pages which will be freed.
2382 */
2bf0de4c 2383
9a8c1c2f 2384 /* Object may have shrunk but shouldn't have grown - check. */
2385 gc_assert(page_table[next_page].bytes_used >= remaining_bytes);
2bf0de4c 2386
9a8c1c2f 2387 PAGE_FLAGS_UPDATE(next_page, PAGE_ALLOCATED_MASK | PAGE_UNBOXED_MASK
2388 | PAGE_GENERATION_MASK,
2389 PAGE_ALLOCATED_MASK | PAGE_UNBOXED_MASK | new_space);
2bf0de4c 2390
9a8c1c2f 2391 /* Adjust the bytes_used. */
2392 old_bytes_used = page_table[next_page].bytes_used;
2393 page_table[next_page].bytes_used = remaining_bytes;
2bf0de4c 2394
9a8c1c2f 2395 bytes_freed = old_bytes_used - remaining_bytes;
e7e59d7d 2396
9a8c1c2f 2397 mmask = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK
2398 | PAGE_GENERATION_MASK;
2399 mflags = PAGE_ALLOCATED_MASK | PAGE_LARGE_OBJECT_MASK | from_space;
2bf0de4c 2400
9a8c1c2f 2401 /* Free any remaining pages; needs care. */
2402 next_page++;
0b2b8885 2403 while (old_bytes_used == GC_PAGE_SIZE &&
9a8c1c2f 2404 PAGE_FLAGS(next_page, mmask) == mflags &&
2405 page_table[next_page].first_object_offset ==
0b2b8885 2406 GC_PAGE_SIZE * (first_page - next_page)) {
9a8c1c2f 2407 /*
2408 * Checks out OK, free the page. Don't need to both zeroing
2409 * pages as this should have been done before shrinking the
2410 * object. These pages shouldn't be write protected, even if
2411 * boxed they should be zero filled.
2412 */
2413 gc_assert(!PAGE_WRITE_PROTECTED(next_page));
2bf0de4c 2414
9a8c1c2f 2415 old_bytes_used = page_table[next_page].bytes_used;
2416 page_table[next_page].flags &= ~PAGE_ALLOCATED_MASK;
2417 page_table[next_page].bytes_used = 0;
2418 bytes_freed += old_bytes_used;
2419 next_page++;
2420 }
2bf0de4c 2421
9a8c1c2f 2422 if (gencgc_verbose && bytes_freed > 0)
2423 fprintf(stderr, "* copy_large_unboxed bytes_freed %d\n",
2424 bytes_freed);
2bf0de4c 2425
9a8c1c2f 2426 generations[from_space].bytes_allocated -=
2427 sizeof(lispobj) * nwords + bytes_freed;
2428 generations[new_space].bytes_allocated += sizeof(lispobj) * nwords;
2429 bytes_allocated -= bytes_freed;
2bf0de4c 2430
9a8c1c2f 2431 return object;
2432 } else {
2433 /* get tag of object */
2434 tag = LowtagOf(object);
2435
2436 /* allocate space */
2437 new = gc_quick_alloc_large_unboxed(nwords * sizeof(lispobj));
2438
2439 dest = new;
2440 source = (lispobj *) PTR(object);
2441
2442 /* copy the object */
2443 while (nwords > 0) {
2444 dest[0] = source[0];
2445 dest[1] = source[1];
2446 dest += 2;
2447 source += 2;
2448 nwords -= 2;
2449 }
2bf0de4c 2450
9a8c1c2f 2451 /* return lisp pointer of new object */
2452 return (lispobj) new | tag;
0c41e522 2453 }
0c41e522 2454}
b7271901 2455
2456static inline boolean
2457maybe_static_array_p(lispobj header)
2458{
2459 boolean result;
2460
2461 switch (TypeOf(header)) {
2462 /*
2463 * This needs to be coordinated to the set of allowed
2464 * static vectors in make-array.
2465 */
2466 case type_SimpleString:
2467 case type_SimpleArrayUnsignedByte8:
2468 case type_SimpleArrayUnsignedByte16:
2469 case type_SimpleArrayUnsignedByte32:
2470#ifdef type_SimpleArraySignedByte8
2471 case type_SimpleArraySignedByte8:
2472#endif
2473#ifdef type_SimpleArraySignedByte16
2474 case type_SimpleArraySignedByte16:
2475#endif
2476#ifdef type_SimpleArraySignedByte32
2477 case type_SimpleArraySignedByte32:
2478#endif
2479 case type_SimpleArraySingleFloat:
2480 case type_SimpleArrayDoubleFloat:
2481#ifdef type_SimpleArrayLongFloat
2482 case type_SimpleArrayLongFloat:
2483#endif
2484#ifdef type_SimpleArrayComplexSingleFloat
2485 case type_SimpleArrayComplexSingleFloat:
2486#endif
2487#ifdef type_SimpleArrayComplexDoubleFloat
2488 case type_SimpleArrayComplexDoubleFloat:
2489#endif
2490#ifdef type_SimpleArrayComplexLongFloat
2491 case type_SimpleArrayComplexLongFloat:
2492#endif
2493 result = TRUE;
83376964 2494 break;
b7271901 2495 default:
2496 result = FALSE;
2497 }
2498 return result;
2499}
2500
0c41e522 2501\f
9a8c1c2f 2502
0c41e522 2503/* Scavenging */
2504
0b4f3884 2505/*
2506 * Douglas Crosher says:
2507 *
2508 * There were two different ways in which the scavenger dispatched,
2509 * and DIRECT_SCAV was one option. This code did work at one stage
2510 * but testing showed it to be slower. When DIRECT_SCAV is enabled
2511 * the scavenger dispatches via the scavtab for all objects, and when
2512 * disabled the scavenger firstly detects and handles some common
2513 * cases itself before dispatching.
2514 */
2515
0c41e522 2516#define DIRECT_SCAV 0
2517
c197af2f 2518static void
9a8c1c2f 2519scavenge(void *start_obj, long nwords)
0c41e522 2520{
9a8c1c2f 2521 lispobj *start;
ae169a66 2522
9a8c1c2f 2523 start = (lispobj *) start_obj;
2bf0de4c 2524
9a8c1c2f 2525 while (nwords > 0) {
2526 lispobj object;
2527 int words_scavenged;
2528
2529 object = *start;
2530 /* Not a forwarding pointer. */
2531 gc_assert(object != 0x01);
2bf0de4c 2532
0c41e522 2533#if DIRECT_SCAV
9a8c1c2f 2534 words_scavenged = scavtab[TypeOf(object)] (start, object);
2535#else /* not DIRECT_SCAV */
2536 if (Pointerp(object)) {
c197af2f 2537#ifdef GC_ASSERTIONS
9a8c1c2f 2538 check_escaped_stack_object(start, object);
c197af2f 2539#endif
c197af2f 2540
9a8c1c2f 2541 if (from_space_p(object)) {
2542 lispobj *ptr = (lispobj *) PTR(object);
2543 lispobj first_word = *ptr;
2544
2545 if (first_word == 0x01) {
2546 *start = ptr[1];
2547 words_scavenged = 1;
45380dbb 2548 } else {
9a8c1c2f 2549 words_scavenged = scavtab[TypeOf(object)] (start, object);
45380dbb 2550 }
2551 } else if (dynamic_space_p(object) || new_space_p(object) || static_space_p(object)
2552 || read_only_space_p(object) || control_stack_space_p(object)
b7271901 2553 || binding_stack_space_p(object) || signal_space_p(object)
2554 || other_space_p(object)) {
45380dbb 2555 words_scavenged = 1;
2556 } else {
2557 lispobj *ptr = (lispobj *) PTR(object);
2558 words_scavenged = 1;
83376964 2559 if (debug_static_array_p) {
2560 fprintf(stderr, "Not in Lisp spaces: object = %p, ptr = %p\n",
2561 (void*)object, ptr);
2562 }
2563
f0626999 2564 if (1) {
45380dbb 2565 lispobj header = *ptr;
83376964 2566 if (debug_static_array_p) {
2567 fprintf(stderr, " Header value = 0x%lx\n", (unsigned long) header);
2568 }
2569
b7271901 2570 if (maybe_static_array_p(header)) {
2571 int static_p;
45380dbb 2572
83376964 2573 if (debug_static_array_p) {
2574 fprintf(stderr, "Possible static vector at %p. header = 0x%lx\n",
2575 ptr, (unsigned long) header);
2576 }
45380dbb 2577
b7271901 2578 static_p = (HeaderValue(header) & 1) == 1;
2579 if (static_p) {
2580 /*
2581 * We have a static vector. Mark it as
2582 * reachable by setting the MSB of the header.
2583 */
2584 *ptr = header | 0x80000000;
83376964 2585 if (debug_static_array_p) {
2586 fprintf(stderr, "Scavenged static vector @%p, header = 0x%lx\n",
2587 ptr, (unsigned long) header);
2588 }
b7271901 2589 }
45380dbb 2590 }
2591 }
2592 }
9a8c1c2f 2593 } else if ((object & 3) == 0)
c197af2f 2594 words_scavenged = 1;
9a8c1c2f 2595 else
2596 words_scavenged = scavtab[TypeOf(object)] (start, object);
c197af2f 2597#endif /* not DIRECT_SCAV */
2bf0de4c 2598
9a8c1c2f 2599 start += words_scavenged;
2600 nwords -= words_scavenged;
c197af2f 2601 }
0c41e522 2602
9a8c1c2f 2603 gc_assert(nwords == 0);
2604}
0c41e522 2605\f
9a8c1c2f 2606
3f2ead72 2607#if !(defined(i386) || defined(__x86_64))
af867264 2608/* Scavenging Interrupt Contexts */
2609
2610static int boxed_registers[] = BOXED_REGISTERS;
2611
30102669 2612/* The GC has a notion of an "interior pointer" register, an unboxed
2613 * register that typically contains a pointer to inside an object
2614 * referenced by another pointer. The most obvious of these is the
2615 * program counter, although many compiler backends define a "Lisp
2616 * Interior Pointer" register known as reg_LIP, and various CPU
2617 * architectures have other registers that also partake of the
2618 * interior-pointer nature. As the code for pairing an interior
2619 * pointer value up with its "base" register, and fixing it up after
2620 * scavenging is complete is horribly repetitive, a few macros paper
2621 * over the monotony. --AB, 2010-Jul-14 */
2622
2623#define INTERIOR_POINTER_VARS(name) \
2624 unsigned long name; \
2625 unsigned long name##_offset; \
2626 int name##_register_pair
2627
2628#define PAIR_INTERIOR_POINTER(name, accessor) \
2629 name = accessor; \
2630 pair_interior_pointer(context, name, \
2631 &name##_offset, \
2632 &name##_register_pair)
2633
2634/*
2635 * Do we need to check if the register we're fixing up is in the
2636 * from-space?
2637 */
2638#define FIXUP_INTERIOR_POINTER(name, accessor) \
2639 do { \
2640 if (name##_register_pair >= 0) { \
2641 accessor = \
3adc2c31 2642 PTR(SC_REG(context, name##_register_pair)) \
30102669 2643 + name##_offset; \
2644 } \
2645 } while (0)
2646
2647
2648static void
2649pair_interior_pointer(os_context_t *context, unsigned long pointer,
2650 unsigned long *saved_offset, int *register_pair)
2651{
2652 int i;
2653
2654 /*
2655 * I (RLT) think this is trying to find the boxed register that is
2656 * closest to the LIP address, without going past it. Usually, it's
2657 * reg_CODE or reg_LRA. But sometimes, nothing can be found.
2658 */
2659 *saved_offset = 0x7FFFFFFF;
2660 *register_pair = -1;
2661 for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
2662 unsigned long reg;
2663 long offset;
2664 int index;
2665
2666 index = boxed_registers[i];
2667 reg = SC_REG(context, index);
2668
2669 /* An interior pointer is never relative to a non-pointer
2670 * register (an oversight in the original implementation).
2671 * The simplest argument for why this is true is to consider
2672 * the fixnum that happens by coincide to be the word-index in
2673 * memory of the header for some object plus two. This is
2674 * happenstance would cause the register containing the fixnum
2675 * to be selected as the register_pair if the interior pointer
2676 * is to anywhere after the first two words of the object.
2677 * The fixnum won't be changed during GC, but the object might
2678 * move, thus destroying the interior pointer. --AB,
2679 * 2010-Jul-14 */
2680
2681 if (Pointerp(reg) && (PTR(reg) <= pointer)) {
3adc2c31 2682 offset = pointer - PTR(reg);
30102669 2683 if (offset < *saved_offset) {
2684 *saved_offset = offset;
2685 *register_pair = index;
2686 }
2687 }
2688 }
2689}
2690
2691
9a8c1c2f 2692static void
2693scavenge_interrupt_context(os_context_t * context)
af867264 2694{
9a8c1c2f 2695 int i;
2696
30102669 2697 INTERIOR_POINTER_VARS(pc);
af867264 2698#ifdef reg_LIP
30102669 2699 INTERIOR_POINTER_VARS(lip);
af867264 2700#endif
87e1c793 2701#ifdef reg_LR
30102669 2702 INTERIOR_POINTER_VARS(lr);
87e1c793 2703#endif
2704#ifdef reg_CTR
30102669 2705 INTERIOR_POINTER_VARS(ctr);
87e1c793 2706#endif
af867264 2707#ifdef SC_NPC
30102669 2708 INTERIOR_POINTER_VARS(npc);
af867264 2709#endif
2710
2711#ifdef reg_LIP
30102669 2712 PAIR_INTERIOR_POINTER(lip, SC_REG(context, reg_LIP));
af867264 2713#endif /* reg_LIP */
2714
30102669 2715 PAIR_INTERIOR_POINTER(pc, SC_PC(context));
2716
af867264 2717#ifdef SC_NPC
30102669 2718 PAIR_INTERIOR_POINTER(npc, SC_NPC(context));
2719#endif
9a8c1c2f 2720
87e1c793 2721#ifdef reg_LR
9dcff02e 2722 PAIR_INTERIOR_POINTER(lr, SC_REG(context, reg_LR));
30102669 2723#endif
2724
87e1c793 2725#ifdef reg_CTR
9dcff02e 2726 PAIR_INTERIOR_POINTER(ctr, SC_REG(context, reg_CTR));
87e1c793 2727#endif
30102669 2728
9a8c1c2f 2729 /* Scanvenge all boxed registers in the context. */
2730 for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
2731 int index;
2732 lispobj foo;
2733
2734 index = boxed_registers[i];
2735 foo = SC_REG(context, index);
2736 scavenge(&foo, 1);
2737 SC_REG(context, index) = foo;
2738
2739 scavenge(&(SC_REG(context, index)), 1);
af867264 2740 }
2741
9a8c1c2f 2742 /*
30102669 2743 * Now that the scavenging is done, repair the various interior
2744 * pointers.
9a8c1c2f 2745 */
30102669 2746#ifdef reg_LIP
2747 FIXUP_INTERIOR_POINTER(lip, SC_REG(context, reg_LIP));
2748#endif
2749
2750 FIXUP_INTERIOR_POINTER(pc, SC_PC(context));
9a8c1c2f 2751
af867264 2752#ifdef SC_NPC
30102669 2753 FIXUP_INTERIOR_POINTER(npc, SC_NPC(context));
2754#endif
87e1c793 2755
2756#ifdef reg_LR
30102669 2757 FIXUP_INTERIOR_POINTER(lr, SC_REG(context, reg_LR));
2758#endif
2759
87e1c793 2760#ifdef reg_CTR
30102669 2761 FIXUP_INTERIOR_POINTER(ctr, SC_REG(context, reg_CTR));
2762#endif
af867264 2763}
2764
9a8c1c2f 2765void
2766scavenge_interrupt_contexts(void)
af867264 2767{
9a8c1c2f 2768 int i, index;
2769 os_context_t *context;
af867264 2770
45de6763 2771#ifdef PRINTNOISE
9a8c1c2f 2772 printf("Scavenging interrupt contexts ...\n");
45de6763 2773#endif
2774
9a8c1c2f 2775 index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX));
af867264 2776
2777#if defined(DEBUG_PRINT_CONTEXT_INDEX)
9a8c1c2f 2778 printf("Number of active contexts: %d\n", index);
af867264 2779#endif
2780
9a8c1c2f 2781 for (i = 0; i < index; i++) {
2782 context = lisp_interrupt_contexts[i];
2783 scavenge_interrupt_context(context);
af867264 2784 }
2785}
2786#endif
2787\f
0c41e522 2788/* Code and Code-Related Objects */
2789
af867264 2790/*
2791 * Aargh! Why is SPARC so different here? What is the advantage of
2792 * making it different from all the other ports?
2793 */
555746e0 2794#if defined(sparc) || (defined(DARWIN) && defined(__ppc__))
af867264 2795#define RAW_ADDR_OFFSET 0
2796#else
2bf0de4c 2797#define RAW_ADDR_OFFSET (6 * sizeof(lispobj) - type_FunctionPointer)
af867264 2798#endif
0c41e522 2799
2800static lispobj trans_function_header(lispobj object);
2801static lispobj trans_boxed(lispobj object);
2802
2803#if DIRECT_SCAV
9a8c1c2f 2804static int
2805scav_function_pointer(lispobj * where, lispobj object)
0c41e522 2806{
9a8c1c2f 2807 gc_assert(Pointerp(object));
0c41e522 2808
9a8c1c2f 2809 if (from_space_p(object)) {
2810 lispobj first, *first_pointer;
2bf0de4c 2811
9a8c1c2f 2812 /*
2813 * Object is a pointer into from space - check to see if it has
2814 * been forwarded.
2815 */
2816 first_pointer = (lispobj *) PTR(object);
2817 first = *first_pointer;
2bf0de4c 2818
9a8c1c2f 2819 if (first == 0x01) {
2820 /* Forwarded */
2821 *where = first_pointer[1];
2822 return 1;
2823 } else {
2824 int type;
2825 lispobj copy;
2bf0de4c 2826
9a8c1c2f 2827 /*
2828 * Must transport object -- object may point to either a
2829 * function header, a closure function header, or to a closure
2830 * header.
2831 */
2bf0de4c 2832
9a8c1c2f 2833 type = TypeOf(first);
2834 switch (type) {
2835 case type_FunctionHeader:
2836 case type_ClosureFunctionHeader:
2837 copy = trans_function_header(object);
2838 break;
2839 default:
2840 copy = trans_boxed(object);
2841 break;
2842 }
2bf0de4c 2843
9a8c1c2f 2844 if (copy != object) {
2845 /* Set forwarding pointer. */
2846 first_pointer[0] = 0x01;
2847 first_pointer[1] = copy;
2848 }
2bf0de4c 2849
9a8c1c2f 2850 first = copy;
2851 }
2bf0de4c 2852
9a8c1c2f 2853 gc_assert(Pointerp(first));
2854 gc_assert(!from_space_p(first));
2bf0de4c 2855
9a8c1c2f 2856 *where = first;
2857 }
2858 return 1;
0c41e522 2859}
2860#else
9a8c1c2f 2861static int
2862scav_function_pointer(lispobj * where, lispobj object)
0c41e522 2863{
9a8c1c2f 2864 lispobj *first_pointer;
2865 lispobj copy;
0c41e522 2866
9a8c1c2f 2867 gc_assert(Pointerp(object));
2bf0de4c 2868
9a8c1c2f 2869 /* Object is a pointer into from space - no a FP. */
2870 first_pointer = (lispobj *) PTR(object);
2bf0de4c 2871
9a8c1c2f 2872 /*
2873 * Must transport object -- object may point to either a function
2874 * header, a closure function header, or to a closure header.
2875 */
2bf0de4c 2876
9a8c1c2f 2877 switch (TypeOf(*first_pointer)) {
2878 case type_FunctionHeader:
2879 case type_ClosureFunctionHeader:
2880 copy = trans_function_header(object);
2881 break;
2882 default:
2883 copy = trans_boxed(object);
2884 break;
2885 }
2bf0de4c 2886
9a8c1c2f 2887 if (copy != object) {
2888 /* Set forwarding pointer */
2889 first_pointer[0] = 0x01;
2890 first_pointer[1] = copy;
2891 }
2bf0de4c 2892
9a8c1c2f 2893 gc_assert(Pointerp(copy));
2894 gc_assert(!from_space_p(copy));
0c41e522 2895
9a8c1c2f 2896 *where = copy;
2bf0de4c 2897
9a8c1c2f 2898 return 1;
0c41e522 2899}
2900#endif
2901
3f2ead72 2902#if defined(i386) || defined(__x86_64)
2bf0de4c 2903/*
d54d3cbf 2904 * Scan an x86 compiled code object, looking for possible fixups that
2bf0de4c 2905 * have been missed after a move.
2906 *
2907 * Two types of fixups are needed:
2908 * 1. Absolution fixups to within the code object.
2909 * 2. Relative fixups to outside the code object.
2910 *
2911 * Currently only absolution fixups to the constant vector, or to the
2912 * code area are checked.
2913 */
9a8c1c2f 2914void
2915sniff_code_object(struct code *code, unsigned displacement)
0c41e522 2916{
9a8c1c2f 2917 int nheader_words, ncode_words, nwords;
6438e048 2918 char *p;
2919 char *constants_start_addr, *constants_end_addr;
2920 char *code_start_addr, *code_end_addr;
9a8c1c2f 2921 int fixup_found = 0;
2bf0de4c 2922
9a8c1c2f 2923 if (!check_code_fixups)
2924 return;
bd46c00c 2925
9a8c1c2f 2926 /*
2927 * It's ok if it's byte compiled code. The trace table offset will
2928 * be a fixnum if it's x86 compiled code - check.
2929 */
2930 if (code->trace_table_offset & 0x3) {
2bf0de4c 2931#if 0
9a8c1c2f 2932 fprintf(stderr, "*** Sniffing byte compiled code object at %x.\n",
2933 code);
2bf0de4c 2934#endif
9a8c1c2f 2935 return;
2936 }
0c41e522 2937
9a8c1c2f 2938 /* Else it's x86 machine code. */
0c41e522 2939
9a8c1c2f 2940 ncode_words = fixnum_value(code->code_size);
2941 nheader_words = HeaderValue(*(lispobj *) code);
2942 nwords = ncode_words + nheader_words;
0c41e522 2943
6438e048 2944 constants_start_addr = (char *) code + 5 * sizeof(lispobj);
2945 constants_end_addr = (char *) code + nheader_words * sizeof(lispobj);
2946 code_start_addr = (char *) code + nheader_words * sizeof(lispobj);
2947 code_end_addr = (char *) code + nwords * sizeof(lispobj);
0c41e522 2948
9a8c1c2f 2949 /* Work through the unboxed code. */
2950 for (p = code_start_addr; p < code_end_addr; p++) {
6438e048 2951 char *data = *(char **) p;
9a8c1c2f 2952 unsigned d1 = *((unsigned char *) p - 1);
2953 unsigned d2 = *((unsigned char *) p - 2);
2954 unsigned d3 = *((unsigned char *) p - 3);
2955 unsigned d4 = *((unsigned char *) p - 4);
2956 unsigned d5 = *((unsigned char *) p - 5);
2957 unsigned d6 = *((unsigned char *) p - 6);
2bf0de4c 2958
9a8c1c2f 2959 /*
2960 * Check for code references.
2961 *
2962 * Check for a 32 bit word that looks like an absolute reference
2963 * to within the code adea of the code object.
2964 */
2965 if (data >= code_start_addr - displacement
2966 && data < code_end_addr - displacement) {
2967 /* Function header */
2968 if (d4 == 0x5e
2969 && ((unsigned long) p - 4 -
2970 4 * HeaderValue(*((unsigned long *) p - 1))) ==
2971 (unsigned long) code) {
2972 /* Skip the function header */
2973 p += 6 * 4 - 4 - 1;
2974 continue;
2975 }
2976 /* Push imm32 */
2977 if (d1 == 0x68) {
2978 fixup_found = 1;
2979 fprintf(stderr,
2980 "Code ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
2981 (unsigned long) p, d6, d5, d4, d3, d2, d1,
2982 (unsigned long) data);
2983 fprintf(stderr, "*** Push $0x%.8lx\n", (unsigned long) data);
2984 }
2985 /* Mov [reg-8],imm32 */
2986 if (d3 == 0xc7
2987 && (d2 == 0x40 || d2 == 0x41 || d2 == 0x42 || d2 == 0x43
2988 || d2 == 0x45 || d2 == 0x46 || d2 == 0x47)
2989 && d1 == 0xf8) {
2990 fixup_found = 1;
2991 fprintf(stderr,
2992 "Code ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
2993 (unsigned long) p, d6, d5, d4, d3, d2, d1,
2994 (unsigned long) data);
2995 fprintf(stderr, "*** Mov [reg-8],$0x%.8lx\n",
2996 (unsigned long) data);
2997 }
2998 /* Lea reg, [disp32] */
2999 if (d2 == 0x8d && (d1 & 0xc7) == 5) {
3000 fixup_found = 1;
3001 fprintf(stderr,
3002 "Code ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3003 (unsigned long) p, d6, d5, d4, d3, d2, d1,
3004 (unsigned long) data);
3005 fprintf(stderr, "*** Lea reg,[$0x%.8lx]\n",
3006 (unsigned long) data);
3007 }
3008 }
3009
3010 /*
3011 * Check for constant references.
3012 *
3013 * Check for a 32 bit word that looks like an absolution reference
3014 * to within the constant vector. Constant references will be
3015 * aligned.
3016 */
3017 if (data >= constants_start_addr - displacement
3018 && data < constants_end_addr - displacement
3019 && ((unsigned long) data & 0x3) == 0) {
3020 /* Mov eax,m32 */
3021 if (d1 == 0xa1) {
3022 fixup_found = 1;
3023 fprintf(stderr,
3024 "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3025 (unsigned long) p, d6, d5, d4, d3, d2, d1,
3026 (unsigned long) data);
3027 fprintf(stderr, "*** Mov eax,0x%.8lx\n", (unsigned long) data);
3028 }
3029
3030 /* Mov m32,eax */
3031 if (d1 == 0xa3) {
3032 fixup_found = 1;
3033 fprintf(stderr,
3034 "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3035 (unsigned long) p, d6, d5, d4, d3, d2, d1,
3036 (unsigned long) data);
3037 fprintf(stderr, "*** Mov 0x%.8lx,eax\n", (unsigned long) data);
3038 }
3039
3040 /* Cmp m32,imm32 */
3041 if (d1 == 0x3d && d2 == 0x81) {
3042 fixup_found = 1;
3043 fprintf(stderr,
3044 "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3045 (unsigned long) p, d6, d5, d4, d3, d2, d1,
3046 (unsigned long) data);
3047 /* XX Check this */
3048 fprintf(stderr, "*** Cmp 0x%.8lx,immed32\n",
3049 (unsigned long) data);
3050 }
3051
3052 /* Check for a mod=00, r/m=101 byte. */
3053 if ((d1 & 0xc7) == 5) {
3054 /* Cmp m32,reg */
3055 if (d2 == 0x39) {
3056 fixup_found = 1;
3057 fprintf(stderr,
3058 "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3059 (unsigned long) p, d6, d5, d4, d3, d2, d1,
3060 (unsigned long) data);
3061 fprintf(stderr, "*** Cmp 0x%.8lx,reg\n",
3062 (unsigned long) data);
3063 }
3064 /* Cmp reg32,m32 */
3065 if (d2 == 0x3b) {
3066 fixup_found = 1;
3067 fprintf(stderr,
3068 "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3069 (unsigned long) p, d6, d5, d4, d3, d2, d1,
3070 (unsigned long) data);
3071 fprintf(stderr, "*** Cmp reg32,0x%.8lx\n",
3072 (unsigned long) data);
3073 }
3074 /* Mov m32,reg32 */
3075 if (d2 == 0x89) {
3076 fixup_found = 1;
3077 fprintf(stderr,
3078 "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3079 (unsigned long) p, d6, d5, d4, d3, d2, d1,
3080 (unsigned long) data);
3081 fprintf(stderr, "*** Mov 0x%.8lx,reg32\n",
3082 (unsigned long) data);
3083 }
3084 /* Mov reg32,m32 */
3085 if (d2 == 0x8b) {
3086 fixup_found = 1;
3087 fprintf(stderr,
3088 "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3089 (unsigned long) p, d6, d5, d4, d3, d2, d1,
3090 (unsigned long) data);
3091 fprintf(stderr, "*** Mov reg32,0x%.8lx\n",
3092 (unsigned long) data);
3093 }
3094 /* Lea reg32,m32 */
3095 if (d2 == 0x8d) {
3096 fixup_found = 1;
3097 fprintf(stderr,
3098 "Abs. const. ref. @ %lx: %.2x %.2x %.2x %.2x %.2x %.2x (%.8lx)\n",
3099 (unsigned long) p, d6, d5, d4, d3, d2, d1,
3100 (unsigned long) data);
3101 fprintf(stderr, "*** Lea reg32,0x%.8lx\n",
3102 (unsigned long) data);
3103 }
3104 }
3105 }
0c41e522 3106 }
3107
9a8c1c2f 3108 /* If anything was found print out some info. on the code object. */
3109 if (fixup_found) {
3110 fprintf(stderr,
3111 "*** Compiled code object at %lx: header_words=%d code_words=%d .\n",
3112 (unsigned long) code, nheader_words, ncode_words);
3113 fprintf(stderr,
3114 "*** Const. start = %lx; end= %lx; Code start = %lx; end = %lx\n",
3115 (unsigned long) constants_start_addr,
3116 (unsigned long) constants_end_addr,
3117 (unsigned long) code_start_addr, (unsigned long) code_end_addr);
3118 }
3119}
3120
3121static void
3122apply_code_fixups(struct code *old_code, struct code *new_code)
3123{
3124 int nheader_words, ncode_words, nwords;
6438e048 3125 char *constants_start_addr, *constants_end_addr;
3126 char *code_start_addr, *code_end_addr;
9a8c1c2f 3127 lispobj fixups = NIL;
3128 unsigned long displacement =
3129
3130 (unsigned long) new_code - (unsigned long) old_code;
3131 struct vector *fixups_vector;
3132
2bf0de4c 3133 /*
9a8c1c2f 3134 * It's ok if it's byte compiled code. The trace table offset will
3135 * be a fixnum if it's x86 compiled code - check.
2bf0de4c 3136 */
9a8c1c2f 3137 if (new_code->trace_table_offset & 0x3) {
2bf0de4c 3138#if 0
9a8c1c2f 3139 fprintf(stderr, "*** Byte compiled code object at %x.\n", new_code);
2bf0de4c 3140#endif
9a8c1c2f 3141 return;
3142 }
0c41e522 3143
9a8c1c2f 3144 /* Else it's x86 machine code. */
3145 ncode_words = fixnum_value(new_code->code_size);
3146 nheader_words = HeaderValue(*(lispobj *) new_code);
3147 nwords = ncode_words + nheader_words;
2bf0de4c 3148#if 0
9a8c1c2f 3149 fprintf(stderr,
3150 "*** Compiled code object at %x: header_words=%d code_words=%d .\n",
3151 new_code, nheader_words, ncode_words);
2bf0de4c 3152#endif
6438e048 3153 constants_start_addr = (char *) new_code + 5 * sizeof(lispobj);
3154 constants_end_addr = (char *) new_code + nheader_words * sizeof(lispobj);
3155 code_start_addr = (char *) new_code + nheader_words * sizeof(lispobj);
3156 code_end_addr = (char *) new_code + nwords * sizeof(lispobj);
2bf0de4c 3157#if 0
9a8c1c2f 3158 fprintf(stderr,
3159 "*** Const. start = %x; end= %x; Code start = %x; end = %x\n",
3160 constants_start_addr, constants_end_addr, code_start_addr,
3161 code_end_addr);
3162#endif
3163
3164 /*
3165 * The first constant should be a pointer to the fixups for this
3166 * code objects - Check.
3167 */
3168 fixups = new_code->constants[0];
3169
3170 /*
3171 * It will be 0 or the unbound-marker if there are no fixups, and
3172 * will be an other pointer if it is valid.
3173 */
3174 if (fixups == 0 || fixups == type_UnboundMarker || !Pointerp(fixups)) {
3175 /* Check for possible errors. */
3176 if (check_code_fixups)
3177 sniff_code_object(new_code, displacement);
2bf0de4c 3178
3179#if 0
9a8c1c2f 3180 fprintf(stderr, "Fixups for code object not found!?\n");
3181 fprintf(stderr,
3182 "*** Compiled code object at %x: header_words=%d code_words=%d .\n",
3183 new_code, nheader_words, ncode_words);
3184 fprintf(stderr,
3185 "*** Const. start = %x; end= %x; Code start = %x; end = %x\n",
3186 constants_start_addr, constants_end_addr, code_start_addr,
3187 code_end_addr);
3188#endif
3189 return;
3190 }
0c41e522 3191
9a8c1c2f 3192 fixups_vector = (struct vector *) PTR(fixups);
0c41e522 3193
9a8c1c2f 3194 /* Could be pointing to a forwarding pointer. */
3195 if (Pointerp(fixups) && find_page_index((void *) fixups_vector) != -1
3196 && fixups_vector->header == 0x01) {
2d23e048 3197#if 0
9a8c1c2f 3198 fprintf(stderr, "* FF\n");
2d23e048 3199#endif
9a8c1c2f 3200 /* If so then follow it. */
3201 fixups_vector = (struct vector *) PTR((lispobj) fixups_vector->length);
3202 }
2bf0de4c 3203#if 0
9a8c1c2f 3204 fprintf(stderr, "Got the fixups\n");
2bf0de4c 3205#endif
0c41e522 3206
9a8c1c2f 3207 if (TypeOf(fixups_vector->header) == type_SimpleArrayUnsignedByte32) {
2bf0de4c 3208 /*
9a8c1c2f 3209 * Got the fixups for the code block. Now work through the
3210 * vector, and apply a fixup at each address.
2bf0de4c 3211 */
9a8c1c2f 3212 int length = fixnum_value(fixups_vector->length);
3213 int i;
3214
3215 for (i = 0; i < length; i++) {
3216 unsigned offset = fixups_vector->data[i];
3217
3218 /* Now check the current value of offset. */
3219 unsigned long old_value =
3220 *(unsigned long *) ((unsigned long) code_start_addr + offset);
3221
3222 /*
3223 * If it's within the old_code object then it must be an
3224 * absolute fixup (relative ones are not saved).
3225 */
3226 if (old_value >= (unsigned long) old_code
3227 && old_value <
3228 (unsigned long) old_code + nwords * sizeof(lispobj))
3229 /* So add the dispacement. */
3230 *(unsigned long *) ((unsigned long) code_start_addr + offset) =
3231 old_value + displacement;
3232 else
3233 /*
3234 * It is outside the old code object so it must be a relative
3235 * fixup (absolute fixups are not saved). So subtract the
3236 * displacement.
3237 */
3238 *(unsigned long *) ((unsigned long) code_start_addr + offset) =
3239 old_value - displacement;
3240 }
0c41e522 3241 }
2bf0de4c 3242
9a8c1c2f 3243 /* Check for possible errors. */
3244 if (check_code_fixups)
3245 sniff_code_object(new_code, displacement);
0c41e522 3246}
af867264 3247#endif
0c41e522 3248
9a8c1c2f 3249static struct code *
3250trans_code(struct code *code)
0c41e522 3251{
9a8c1c2f 3252 struct code *new_code;
3253 lispobj l_code, l_new_code;
3254 int nheader_words, ncode_words, nwords;
3255 unsigned long displacement;
3256 lispobj fheaderl, *prev_pointer;
2bf0de4c 3257
3258#if 0
9a8c1c2f 3259 fprintf(stderr, "\nTransporting code object located at 0x%08x.\n",
3260 (unsigned long) code);
2bf0de4c 3261#endif
3262