Skip to content
This repository
  • 8 commits
  • 41 files changed
  • 0 comments
  • 1 contributor
Jul 31, 2002
Daniel Barlow telent 0.7.6.gc-cleanup-branch.1:
	Note that this is all on a branch.  It is not expected to be stable
	or even necessarily to build on all ports

	First iteration towards Once And Only Once in garbage collection,

	(1) collects together most of the scavenging/translating/sizing
	routines into the new gc-common.c file

	(2) delete lots of the duplicated code in gencgc gc_*_alloc()
	routines

	The old Cheney stop & copy gc (henceforth known as CHENEYGC)
	probably does not build in this checkin.  GENCGC builds and
	works at least superficially (passes tests etc)
4398111
Daniel Barlow telent new 436a172
Daniel Barlow telent 0.7.6.gc-cleanup-branch.2
	compilation fixes for cheneygc:

	... some objects lost their `inline' and/or `static'
	 qualifiers, so we can see tham from both gc-common.o and gc.o

	... some variable names fixed up

	... gc_general_alloc becomes the supported
         allocation-during-gc interface, so the flags for
         boxed/unboxed, fast/slow are now needed in gc-internal.h to
         be shared by both collectors.  (All we do in cheneygc is
         ignore them, but that's not the point)

	... copy_foo_object defns created as wrappers for copy_object.
         these will go away again later in favour of ignorable flags
         to copy_object
7431345
Daniel Barlow telent 0.7.6.gc-cleanup-branch.3:
	rename gc.c to cheneygc.c
	twiddle Config.* to cope
	no changes were made to actual file contents: this is just a rename
1f73254
Daniel Barlow telent 0.7.6.gc-cleanup-branch.4
	Mostly-mechanical preprocessor symbol cleanup
	GENCGC->LISP_FEATURE_GENCGC
cdb44eb
Aug 02, 2002
Daniel Barlow telent 0.7.6.gc-cleanup-branch.5:
	Oodles of gcc warning cleanups for machines with different-sized
	lispobj and void * (e.g. alpha)
	cheneygc runs again
e959592
Daniel Barlow telent 0.7.6.gc-cleanup-branch.6
	Found some missing #ifdef GENCGC -> LISP_FEATURE_GENCGC replacements:
	purify now works again in gencgc
1a823f1
Aug 03, 2002
Daniel Barlow telent 0.7.6.gc-cleanup-branch.7
	Remove mailing list address from "please report this as a bug"
	message in gc-common.c.  Minor edit to manual page
78042f2

Showing 41 changed files with 1,715 additions and 3,107 deletions. Show diff stats Hide diff stats

  1. +1 1  doc/sbcl.1
  2. +1 1  src/runtime/Config.alpha-linux
  3. +1 1  src/runtime/Config.alpha-osf1
  4. +1 1  src/runtime/Config.ppc-linux
  5. +1 1  src/runtime/Config.sparc-linux
  6. +1 1  src/runtime/Config.sparc-sunos
  7. +0 1  src/runtime/Config.x86-bsd
  8. +1 1  src/runtime/Config.x86-linux
  9. +1 1  src/runtime/GNUmakefile
  10. +5 5 src/runtime/alloc.c
  11. +0 4 src/runtime/alpha-linux-os.c
  12. +0 4 src/runtime/alpha-osf1-os.c
  13. +10 13 src/runtime/bsd-os.c
  14. +50 0 src/runtime/cheneygc-internal.h
  15. +653 0 src/runtime/cheneygc.c
  16. +2 2 src/runtime/coreparse.c
  17. +417 956 src/runtime/{gc.c → gc-common.c}
  18. +66 0 src/runtime/gc-internal.h
  19. +1 6 src/runtime/gc.h
  20. +132 0 src/runtime/gencgc-internal.h
  21. +296 2,011 src/runtime/gencgc.c
  22. +7 1 src/runtime/gencgc.h
  23. +3 3 src/runtime/globals.c
  24. +11 7 src/runtime/interrupt.c
  25. +2 4 src/runtime/linux-os.c
  26. +0 3  src/runtime/osf1-os.c
  27. +2 2 src/runtime/parse.c
  28. +0 5 src/runtime/ppc-linux-os.c
  29. +2 2 src/runtime/print.c
  30. +29 31 src/runtime/purify.c
  31. +1 7 src/runtime/runtime.c
  32. +9 4 src/runtime/runtime.h
  33. +2 5 src/runtime/save.c
  34. +0 3  src/runtime/sparc-linux-os.c
  35. +0 3  src/runtime/sparc-sunos-os.c
  36. +0 7 src/runtime/sunos-os.c
  37. +1 4 src/runtime/validate.c
  38. +1 0  src/runtime/validate.h
  39. +4 2 src/runtime/x86-assem.S
  40. +0 3  src/runtime/x86-linux-os.c
  41. +1 1  version.lisp-expr
2  doc/sbcl.1
@@ -169,7 +169,7 @@ SAVE-LISP does.
169 169
170 170 (Why doesn't SBCL support more extensions? Why drop all those nice
171 171 extensions from CMU CL when the code already exists? This is a
172   -frequently asked question on the mailing list. In other cases, it's a
  172 +frequently asked question on the mailing list. In some cases, it's a
173 173 design philosophy issue: arguably SBCL has done its job by supplying a
174 174 stable FFI, and the right design decision is to move functionality
175 175 derived from that, like socket support, into separate libraries,
2  src/runtime/Config.alpha-linux
@@ -21,4 +21,4 @@ OS_SRC = linux-os.c alpha-linux-os.c os-common.c
21 21 LINKFLAGS+=-rdynamic # -static
22 22 OS_LIBS= -ldl
23 23
24   -GC_SRC= gc.c
  24 +GC_SRC= cheneygc.c
2  src/runtime/Config.alpha-osf1
@@ -27,4 +27,4 @@ ARCH_SRC = alpha-arch.c undefineds.c
27 27 OS_SRC = osf1-os.c alpha-osf1-os.c os-common.c
28 28 OS_LIBS= #-ldl
29 29
30   -GC_SRC= gc.c
  30 +GC_SRC= cheneygc.c
2  src/runtime/Config.ppc-linux
@@ -19,4 +19,4 @@ OS_SRC = linux-os.c ppc-linux-os.c os-common.c
19 19 LINKFLAGS+=-rdynamic
20 20 OS_LIBS= -ldl
21 21
22   -GC_SRC= gc.c
  22 +GC_SRC= cheneygc.c
2  src/runtime/Config.sparc-linux
@@ -22,4 +22,4 @@ OS_SRC = linux-os.c sparc-linux-os.c os-common.c
22 22 LINKFLAGS+=-rdynamic
23 23 OS_LIBS= -ldl
24 24
25   -GC_SRC= gc.c
  25 +GC_SRC= cheneygc.c
2  src/runtime/Config.sparc-sunos
@@ -24,4 +24,4 @@ OS_SRC = sunos-os.c sparc-sunos-os.c os-common.c
24 24 LINKFLAGS+=
25 25 OS_LIBS= -ldl -lsocket -lnsl
26 26
27   -GC_SRC= gc.c
  27 +GC_SRC= cheneygc.c
1  src/runtime/Config.x86-bsd
@@ -16,4 +16,3 @@ OS_SRC = bsd-os.c os-common.c undefineds.c
16 16 OS_LIBS = -lm # -ldl
17 17
18 18 GC_SRC = gencgc.c
19   -CFLAGS += -DGENCGC
2  src/runtime/Config.x86-linux
@@ -27,4 +27,4 @@ OS_LINK_FLAGS = -Wl,--export-dynamic
27 27 OS_LIBS = -ldl
28 28
29 29 GC_SRC = gencgc.c
30   -CFLAGS += -DGENCGC
  30 +
2  src/runtime/GNUmakefile
@@ -36,7 +36,7 @@ include Config
36 36
37 37
38 38 C_SRCS =alloc.c backtrace.c breakpoint.c coreparse.c \
39   - dynbind.c globals.c interr.c interrupt.c \
  39 + dynbind.c gc-common.c globals.c interr.c interrupt.c \
40 40 monitor.c parse.c print.c purify.c \
41 41 regnames.c run-program.c runtime.c save.c search.c \
42 42 time.c util.c validate.c vars.c wrap.c
10 src/runtime/alloc.c
@@ -30,7 +30,7 @@
30 30
31 31 #define ALIGNED_SIZE(n) (n+LOWTAG_MASK) & ~LOWTAG_MASK
32 32
33   -#if defined GENCGC
  33 +#if defined LISP_FEATURE_GENCGC
34 34 extern lispobj *alloc(int bytes);
35 35 #else
36 36 static lispobj *
@@ -74,7 +74,7 @@ alloc_vector(int type, int length, int size)
74 74 result->header = type;
75 75 result->length = make_fixnum(length);
76 76
77   - return ((lispobj)result)|OTHER_POINTER_LOWTAG;
  77 + return make_lispobj(result,OTHER_POINTER_LOWTAG);
78 78 }
79 79
80 80 lispobj
@@ -85,7 +85,7 @@ alloc_cons(lispobj car, lispobj cdr)
85 85 ptr->car = car;
86 86 ptr->cdr = cdr;
87 87
88   - return (lispobj)ptr | LIST_POINTER_LOWTAG;
  88 + return make_lispobj(ptr, LIST_POINTER_LOWTAG);
89 89 }
90 90
91 91 lispobj
@@ -100,7 +100,7 @@ alloc_number(long n)
100 100
101 101 ptr->digits[0] = n;
102 102
103   - return (lispobj) ptr | OTHER_POINTER_LOWTAG;
  103 + return make_lispobj(ptr, OTHER_POINTER_LOWTAG);
104 104 }
105 105 }
106 106
@@ -124,5 +124,5 @@ alloc_sap(void *ptr)
124 124 sap=(struct sap *)
125 125 alloc_unboxed((int)SAP_WIDETAG, sizeof(struct sap)/sizeof(lispobj) -1);
126 126 sap->pointer = ptr;
127   - return (lispobj) sap | OTHER_POINTER_LOWTAG;
  127 + return make_lispobj(sap,OTHER_POINTER_LOWTAG);
128 128 }
4 src/runtime/alpha-linux-os.c
@@ -39,10 +39,6 @@
39 39 #include "validate.h"
40 40 size_t os_vm_page_size;
41 41
42   -#if defined GENCGC /* unlikely ... */
43   -#error SBCL Alpha does not work with the GENCGC
44   -#include "gencgc.h"
45   -#endif
46 42
47 43 os_context_register_t *
48 44 os_context_register_addr(os_context_t *context, int offset)
4 src/runtime/alpha-osf1-os.c
@@ -41,10 +41,6 @@
41 41 #include "validate.h"
42 42 size_t os_vm_page_size;
43 43
44   -#if defined GENCGC /* unlikely ... */
45   -#error SBCL Alpha does not work with the GENCGC
46   -#include "gencgc.h"
47   -#endif
48 44
49 45 os_context_register_t *
50 46 os_context_register_addr(os_context_t *context, int offset)
23 src/runtime/bsd-os.c
@@ -37,9 +37,6 @@
37 37 #include "validate.h"
38 38 vm_size_t os_vm_page_size;
39 39
40   -#if defined GENCGC
41   -#include "gencgc.h"
42   -#endif
43 40
44 41 /* The different BSD variants have diverged in exactly where they
45 42 * store signal context information, but at least they tend to use the
@@ -204,15 +201,7 @@ is_valid_lisp_addr(os_vm_address_t addr)
204 201 * any OS-dependent special low-level handling for signals
205 202 */
206 203
207   -#if !defined GENCGC
208   -
209   -void
210   -os_install_interrupt_handlers(void)
211   -{
212   - SHOW("os_install_interrupt_handlers()/bsd-os/!defined(GENCGC)");
213   -}
214   -
215   -#else
  204 +#if defined LISP_FEATURE_GENCGC
216 205
217 206 /*
218 207 * The GENCGC needs to be hooked into whatever signal is raised for
@@ -246,4 +235,12 @@ os_install_interrupt_handlers(void)
246 235 SHOW("leaving os_install_interrupt_handlers()");
247 236 }
248 237
249   -#endif /* !defined GENCGC */
  238 +#else
  239 +/* As of 2002.07.31, this configuration has never been tested */
  240 +void
  241 +os_install_interrupt_handlers(void)
  242 +{
  243 + SHOW("os_install_interrupt_handlers()/bsd-os/!defined(GENCGC)");
  244 +}
  245 +
  246 +#endif /* defined GENCGC */
50 src/runtime/cheneygc-internal.h
... ... @@ -0,0 +1,50 @@
  1 +extern lispobj *from_space;
  2 +extern lispobj *from_space_free_pointer;
  3 +
  4 +extern lispobj *new_space;
  5 +extern lispobj *new_space_free_pointer;
  6 +
  7 +
  8 +/* predicates */
  9 +/* #if defined(DEBUG_SPACE_PREDICATES) */
  10 +#if 0
  11 +boolean
  12 +from_space_p(lispobj object)
  13 +{
  14 + lispobj *ptr;
  15 +
  16 + /* this can be called for untagged pointers as well as for
  17 + descriptors, so this assertion's not applicable
  18 + gc_assert(is_lisp_pointer(object));
  19 + */
  20 + ptr = (lispobj *) native_pointer(object);
  21 +
  22 + return ((from_space <= ptr) &&
  23 + (ptr < from_space_free_pointer));
  24 +}
  25 +
  26 +boolean
  27 +new_space_p(lispobj object)
  28 +{
  29 + lispobj *ptr;
  30 +
  31 + /* gc_assert(is_lisp_pointer(object)); */
  32 +
  33 + ptr = (lispobj *) native_pointer(object);
  34 +
  35 + return ((new_space <= ptr) &&
  36 + (ptr < new_space_free_pointer));
  37 +}
  38 +
  39 +#else
  40 +
  41 +#define from_space_p(ptr) \
  42 + ((from_space <= ((lispobj *) ((pointer_sized_uint_t) ptr))) && \
  43 + (((lispobj *) ((pointer_sized_uint_t) ptr))< from_space_free_pointer))
  44 +
  45 +#define new_space_p(ptr) \
  46 + ((new_space <= ((lispobj *) ((pointer_sized_uint_t) ptr))) && \
  47 + (((lispobj *) ((pointer_sized_uint_t) ptr)) < new_space_free_pointer))
  48 +
  49 +#endif
  50 +
653 src/runtime/cheneygc.c
... ... @@ -0,0 +1,653 @@
  1 +/*
  2 + * stop and copy GC based on Cheney's algorithm
  3 + */
  4 +
  5 +/*
  6 + * This software is part of the SBCL system. See the README file for
  7 + * more information.
  8 + *
  9 + * This software is derived from the CMU CL system, which was
  10 + * written at Carnegie Mellon University and released into the
  11 + * public domain. The software is in the public domain and is
  12 + * provided with absolutely no warranty. See the COPYING and CREDITS
  13 + * files for more information.
  14 + */
  15 +
  16 +#include <stdio.h>
  17 +#include <sys/time.h>
  18 +#include <sys/resource.h>
  19 +#include <signal.h>
  20 +#include "runtime.h"
  21 +#include "sbcl.h"
  22 +#include "os.h"
  23 +#include "gc.h"
  24 +#include "gc-internal.h"
  25 +#include "globals.h"
  26 +#include "interrupt.h"
  27 +#include "validate.h"
  28 +#include "lispregs.h"
  29 +#include "interr.h"
  30 +
  31 +/* So you need to debug? */
  32 +#if 0
  33 +#define PRINTNOISE
  34 +#define DEBUG_SPACE_PREDICATES
  35 +#define DEBUG_SCAVENGE_VERBOSE
  36 +#define DEBUG_COPY_VERBOSE
  37 +#define DEBUG_CODE_GC
  38 +#endif
  39 +
  40 +lispobj *from_space;
  41 +lispobj *from_space_free_pointer;
  42 +
  43 +lispobj *new_space;
  44 +lispobj *new_space_free_pointer;
  45 +
  46 +static void scavenge_newspace(void);
  47 +static void scavenge_interrupt_contexts(void);
  48 +
  49 +
  50 +/* collecting garbage */
  51 +
  52 +#ifdef PRINTNOISE
  53 +static double
  54 +tv_diff(struct timeval *x, struct timeval *y)
  55 +{
  56 + return (((double) x->tv_sec + (double) x->tv_usec * 1.0e-6) -
  57 + ((double) y->tv_sec + (double) y->tv_usec * 1.0e-6));
  58 +}
  59 +#endif
  60 +
  61 +#define BYTES_ZERO_BEFORE_END (1<<12)
  62 +
  63 +#ifdef alpha
  64 +#define U32 u32
  65 +#else
  66 +#define U32 unsigned long
  67 +#endif
  68 +static void
  69 +zero_stack(void)
  70 +{
  71 + U32 *ptr = (U32 *)current_control_stack_pointer;
  72 + search:
  73 + do {
  74 + if (*ptr)
  75 + goto fill;
  76 + ptr++;
  77 + } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
  78 + return;
  79 + fill:
  80 + do {
  81 + *ptr++ = 0;
  82 + } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
  83 +
  84 + goto search;
  85 +}
  86 +#undef U32
  87 +
  88 +
  89 +void *
  90 +gc_general_alloc(int bytes, int unboxed_p, int quick_p) {
  91 + lispobj *new=new_space_free_pointer;
  92 + new_space_free_pointer+=(bytes/4);
  93 + return new;
  94 +}
  95 +
  96 +lispobj copy_large_unboxed_object(lispobj object, int nwords) {
  97 + return copy_object(object,nwords);
  98 +}
  99 +lispobj copy_unboxed_object(lispobj object, int nwords) {
  100 + return copy_object(object,nwords);
  101 +}
  102 +lispobj copy_large_object(lispobj object, int nwords) {
  103 + return copy_object(object,nwords);
  104 +}
  105 +
  106 +/* Note: The generic GC interface we're implementing passes us a
  107 + * last_generation argument. That's meaningless for us, since we're
  108 + * not a generational GC. So we ignore it. */
  109 +void
  110 +collect_garbage(unsigned ignore)
  111 +{
  112 +#ifdef PRINTNOISE
  113 + struct timeval start_tv, stop_tv;
  114 + struct rusage start_rusage, stop_rusage;
  115 + double real_time, system_time, user_time;
  116 + double percent_retained, gc_rate;
  117 + unsigned long size_discarded;
  118 + unsigned long size_retained;
  119 +#endif
  120 + lispobj *current_static_space_free_pointer;
  121 + unsigned long static_space_size;
  122 + unsigned long control_stack_size, binding_stack_size;
  123 + sigset_t tmp, old;
  124 +
  125 +#ifdef PRINTNOISE
  126 + printf("[Collecting garbage ... \n");
  127 +
  128 + getrusage(RUSAGE_SELF, &start_rusage);
  129 + gettimeofday(&start_tv, (struct timezone *) 0);
  130 +#endif
  131 +
  132 + sigemptyset(&tmp);
  133 + sigaddset_blockable(&tmp);
  134 + sigprocmask(SIG_BLOCK, &tmp, &old);
  135 +
  136 + current_static_space_free_pointer =
  137 + (lispobj *) ((unsigned long)
  138 + SymbolValue(STATIC_SPACE_FREE_POINTER));
  139 +
  140 +
  141 + /* Set up from space and new space pointers. */
  142 +
  143 + from_space = current_dynamic_space;
  144 + from_space_free_pointer = dynamic_space_free_pointer;
  145 +
  146 +#ifdef PRINTNOISE
  147 + fprintf(stderr,"from_space = %lx\n",
  148 + (unsigned long) current_dynamic_space);
  149 +#endif
  150 + if (current_dynamic_space == (lispobj *) DYNAMIC_0_SPACE_START)
  151 + new_space = (lispobj *)DYNAMIC_1_SPACE_START;
  152 + else if (current_dynamic_space == (lispobj *) DYNAMIC_1_SPACE_START)
  153 + new_space = (lispobj *) DYNAMIC_0_SPACE_START;
  154 + else {
  155 + lose("GC lossage. Current dynamic space is bogus!\n");
  156 + }
  157 + new_space_free_pointer = new_space;
  158 +#if 0
  159 + /* at one time we had the bright idea of using mprotect() to
  160 + * hide the semispace that we're not using at the moment, so
  161 + * we'd see immediately if anyone had a pointer to it.
  162 + * Unfortunately, if we gc during a call to an assembler
  163 + * routine with a "raw" return style, at least on PPC we are
  164 + * expected to return into oldspace because we can't easily
  165 + * update the link register - it's not tagged, and we can't do
  166 + * it as an offset of reg_CODE because the calling routine
  167 + * might be nowhere near our code vector. We hope that we
  168 + * don't run very far in oldspace before it catapults us into
  169 + * newspace by either calling something else or returning
  170 + */
  171 +
  172 + /* write-enable */
  173 + os_protect(new_space,DYNAMIC_SPACE_SIZE,OS_VM_PROT_ALL);
  174 +#endif
  175 +
  176 + /* Initialize the weak pointer list. */
  177 + weak_pointers = (struct weak_pointer *) NULL;
  178 +
  179 +
  180 + /* Scavenge all of the roots. */
  181 +#ifdef PRINTNOISE
  182 + printf("Scavenging interrupt contexts ...\n");
  183 +#endif
  184 + scavenge_interrupt_contexts();
  185 +
  186 +#ifdef PRINTNOISE
  187 + printf("Scavenging interrupt handlers (%d bytes) ...\n",
  188 + (int)sizeof(interrupt_handlers));
  189 +#endif
  190 + scavenge((lispobj *) interrupt_handlers,
  191 + sizeof(interrupt_handlers) / sizeof(lispobj));
  192 +
  193 + /* _size quantities are in units of sizeof(lispobj) - i.e. 4 */
  194 + control_stack_size =
  195 + current_control_stack_pointer-
  196 + (lispobj *)CONTROL_STACK_START;
  197 +#ifdef PRINTNOISE
  198 + printf("Scavenging the control stack at %p (%ld words) ...\n",
  199 + ((lispobj *)CONTROL_STACK_START),
  200 + control_stack_size);
  201 +#endif
  202 + scavenge(((lispobj *)CONTROL_STACK_START), control_stack_size);
  203 +
  204 +
  205 + binding_stack_size =
  206 + current_binding_stack_pointer -
  207 + (lispobj *)BINDING_STACK_START;
  208 +#ifdef PRINTNOISE
  209 + printf("Scavenging the binding stack %x - %x (%d words) ...\n",
  210 + BINDING_STACK_START,current_binding_stack_pointer,
  211 + (int)(binding_stack_size));
  212 +#endif
  213 + scavenge(((lispobj *)BINDING_STACK_START), binding_stack_size);
  214 +
  215 + static_space_size =
  216 + current_static_space_free_pointer - (lispobj *) STATIC_SPACE_START;
  217 +#ifdef PRINTNOISE
  218 + printf("Scavenging static space %x - %x (%d words) ...\n",
  219 + STATIC_SPACE_START,current_static_space_free_pointer,
  220 + (int)(static_space_size));
  221 +#endif
  222 + scavenge(((lispobj *)STATIC_SPACE_START), static_space_size);
  223 +
  224 + /* Scavenge newspace. */
  225 +#ifdef PRINTNOISE
  226 + printf("Scavenging new space (%d bytes) ...\n",
  227 + (int)((new_space_free_pointer - new_space) * sizeof(lispobj)));
  228 +#endif
  229 + scavenge_newspace();
  230 +
  231 +
  232 +#if defined(DEBUG_PRINT_GARBAGE)
  233 + print_garbage(from_space, from_space_free_pointer);
  234 +#endif
  235 +
  236 + /* Scan the weak pointers. */
  237 +#ifdef PRINTNOISE
  238 + printf("Scanning weak pointers ...\n");
  239 +#endif
  240 + scan_weak_pointers();
  241 +
  242 +
  243 + /* Flip spaces. */
  244 +#ifdef PRINTNOISE
  245 + printf("Flipping spaces ...\n");
  246 +#endif
  247 +
  248 + os_zero((os_vm_address_t) current_dynamic_space,
  249 + (os_vm_size_t) DYNAMIC_SPACE_SIZE);
  250 +
  251 + current_dynamic_space = new_space;
  252 + dynamic_space_free_pointer = new_space_free_pointer;
  253 +
  254 +#ifdef PRINTNOISE
  255 + size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj);
  256 + size_retained = (new_space_free_pointer - new_space) * sizeof(lispobj);
  257 +#endif
  258 +
  259 + /* Zero stack. */
  260 +#ifdef PRINTNOISE
  261 + printf("Zeroing empty part of control stack ...\n");
  262 +#endif
  263 + zero_stack();
  264 +
  265 + sigprocmask(SIG_SETMASK, &old, 0);
  266 +
  267 +
  268 +#ifdef PRINTNOISE
  269 + gettimeofday(&stop_tv, (struct timezone *) 0);
  270 + getrusage(RUSAGE_SELF, &stop_rusage);
  271 +
  272 + printf("done.]\n");
  273 +
  274 + percent_retained = (((float) size_retained) /
  275 + ((float) size_discarded)) * 100.0;
  276 +
  277 + printf("Total of %ld bytes out of %ld bytes retained (%3.2f%%).\n",
  278 + size_retained, size_discarded, percent_retained);
  279 +
  280 + real_time = tv_diff(&stop_tv, &start_tv);
  281 + user_time = tv_diff(&stop_rusage.ru_utime, &start_rusage.ru_utime);
  282 + system_time = tv_diff(&stop_rusage.ru_stime, &start_rusage.ru_stime);
  283 +
  284 +#if 0
  285 + printf("Statistics:\n");
  286 + printf("%10.2f sec of real time\n", real_time);
  287 + printf("%10.2f sec of user time,\n", user_time);
  288 + printf("%10.2f sec of system time.\n", system_time);
  289 +#else
  290 + printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n",
  291 + real_time, user_time, system_time);
  292 +#endif
  293 +
  294 + gc_rate = ((float) size_retained / (float) (1<<20)) / real_time;
  295 +
  296 + printf("%10.2f M bytes/sec collected.\n", gc_rate);
  297 +#endif
  298 + /* os_flush_icache((os_vm_address_t) 0, sizeof(unsigned long)); */
  299 +
  300 +#if 0
  301 + /* see comment above about mprotecting oldspace */
  302 +
  303 + /* zero the from space now, to make it easier to find stale
  304 + pointers to it */
  305 +
  306 + /* pray that both dynamic spaces are the same size ... */
  307 + memset(from_space,(DYNAMIC_0_SPACE_END-DYNAMIC_0_SPACE_START-1),0);
  308 + os_protect(from_space,DYNAMIC_SPACE_SIZE,0); /* write-protect */
  309 +#endif
  310 +}
  311 +
  312 +
  313 +/* scavenging */
  314 +
  315 +static void
  316 +scavenge_newspace(void)
  317 +{
  318 + lispobj *here, *next;
  319 +
  320 + here = new_space;
  321 + while (here < new_space_free_pointer) {
  322 + /* printf("here=%lx, new_space_free_pointer=%lx\n",
  323 + here,new_space_free_pointer); */
  324 + next = new_space_free_pointer;
  325 + scavenge(here, next - here);
  326 + here = next;
  327 + }
  328 + /* printf("done with newspace\n"); */
  329 +}
  330 +
  331 +/* scavenging interrupt contexts */
  332 +
  333 +static int boxed_registers[] = BOXED_REGISTERS;
  334 +
  335 +static void
  336 +scavenge_interrupt_context(os_context_t *context)
  337 +{
  338 + int i;
  339 +#ifdef reg_LIP
  340 + unsigned long lip;
  341 + unsigned long lip_offset;
  342 + int lip_register_pair;
  343 +#endif
  344 + unsigned long pc_code_offset;
  345 +#ifdef ARCH_HAS_LINK_REGISTER
  346 + unsigned long lr_code_offset;
  347 +#endif
  348 +#ifdef ARCH_HAS_NPC_REGISTER
  349 + unsigned long npc_code_offset;
  350 +#endif
  351 +#ifdef DEBUG_SCAVENGE_VERBOSE
  352 + fprintf(stderr, "Scavenging interrupt context at 0x%x\n",context);
  353 +#endif
  354 + /* Find the LIP's register pair and calculate its offset */
  355 + /* before we scavenge the context. */
  356 +#ifdef reg_LIP
  357 + lip = *os_context_register_addr(context, reg_LIP);
  358 + /* 0x7FFFFFFF or 0x7FFFFFFFFFFFFFFF ? */
  359 + lip_offset = 0x7FFFFFFF;
  360 + lip_register_pair = -1;
  361 + for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
  362 + unsigned long reg;
  363 + long offset;
  364 + int index;
  365 +
  366 + index = boxed_registers[i];
  367 + reg = *os_context_register_addr(context, index);
  368 + /* would be using PTR if not for integer length issues */
  369 + if ((reg & ~((1L<<N_LOWTAG_BITS)-1)) <= lip) {
  370 + offset = lip - reg;
  371 + if (offset < lip_offset) {
  372 + lip_offset = offset;
  373 + lip_register_pair = index;
  374 + }
  375 + }
  376 + }
  377 +#endif /* reg_LIP */
  378 +
  379 + /* Compute the PC's offset from the start of the CODE */
  380 + /* register. */
  381 + pc_code_offset =
  382 + *os_context_pc_addr(context) -
  383 + *os_context_register_addr(context, reg_CODE);
  384 +#ifdef ARCH_HAS_NPC_REGISTER
  385 + npc_code_offset =
  386 + *os_context_npc_addr(context) -
  387 + *os_context_register_addr(context, reg_CODE);
  388 +#endif
  389 +#ifdef ARCH_HAS_LINK_REGISTER
  390 + lr_code_offset =
  391 + *os_context_lr_addr(context) -
  392 + *os_context_register_addr(context, reg_CODE);
  393 +#endif
  394 +
  395 + /* Scavenge all boxed registers in the context. */
  396 + for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
  397 + int index;
  398 + lispobj foo;
  399 +
  400 + index = boxed_registers[i];
  401 + foo = *os_context_register_addr(context,index);
  402 + scavenge((lispobj *) &foo, 1);
  403 + *os_context_register_addr(context,index) = foo;
  404 +
  405 + /* this is unlikely to work as intended on bigendian
  406 + * 64 bit platforms */
  407 +
  408 + scavenge((lispobj *)
  409 + os_context_register_addr(context, index), 1);
  410 + }
  411 +
  412 +#ifdef reg_LIP
  413 + /* Fix the LIP */
  414 + *os_context_register_addr(context, reg_LIP) =
  415 + *os_context_register_addr(context, lip_register_pair) + lip_offset;
  416 +#endif /* reg_LIP */
  417 +
  418 + /* Fix the PC if it was in from space */
  419 + if (from_space_p(*os_context_pc_addr(context)))
  420 + *os_context_pc_addr(context) =
  421 + *os_context_register_addr(context, reg_CODE) + pc_code_offset;
  422 +#ifdef ARCH_HAS_LINK_REGISTER
  423 + /* Fix the LR ditto; important if we're being called from
  424 + * an assembly routine that expects to return using blr, otherwise
  425 + * harmless */
  426 + if (from_space_p(*os_context_lr_addr(context)))
  427 + *os_context_lr_addr(context) =
  428 + *os_context_register_addr(context, reg_CODE) + lr_code_offset;
  429 +#endif
  430 +
  431 +#ifdef ARCH_HAS_NPC_REGISTER
  432 + if (from_space_p(*os_context_npc_addr(context)))
  433 + *os_context_npc_addr(context) =
  434 + *os_context_register_addr(context, reg_CODE) + npc_code_offset;
  435 +#endif
  436 +}
  437 +
  438 +void scavenge_interrupt_contexts(void)
  439 +{
  440 + int i, index;
  441 + os_context_t *context;
  442 +
  443 + index = fixnum_value(SymbolValue(FREE_INTERRUPT_CONTEXT_INDEX));
  444 +
  445 +#ifdef DEBUG_SCAVENGE_VERBOSE
  446 + fprintf(stderr, "%d interrupt contexts to scan\n",index);
  447 +#endif
  448 + for (i = 0; i < index; i++) {
  449 + context = lisp_interrupt_contexts[i];
  450 + scavenge_interrupt_context(context);
  451 + }
  452 +}
  453 +
  454 +
  455 +/* debugging code */
  456 +
  457 +void
  458 +print_garbage(lispobj *from_space, lispobj *from_space_free_pointer)
  459 +{
  460 + lispobj *start;
  461 + int total_words_not_copied;
  462 +
  463 + printf("Scanning from space ...\n");
  464 +
  465 + total_words_not_copied = 0;
  466 + start = from_space;
  467 + while (start < from_space_free_pointer) {
  468 + lispobj object;
  469 + int forwardp, type, nwords;
  470 + lispobj header;
  471 +
  472 + object = *start;
  473 + forwardp = is_lisp_pointer(object) && new_space_p(object);
  474 +
  475 + if (forwardp) {
  476 + int tag;
  477 + lispobj *pointer;
  478 +
  479 + tag = lowtag_of(object);
  480 +
  481 + switch (tag) {
  482 + case LIST_POINTER_LOWTAG:
  483 + nwords = 2;
  484 + break;
  485 + case INSTANCE_POINTER_LOWTAG:
  486 + printf("Don't know about instances yet!\n");
  487 + nwords = 1;
  488 + break;
  489 + case FUN_POINTER_LOWTAG:
  490 + nwords = 1;
  491 + break;
  492 + case OTHER_POINTER_LOWTAG:
  493 + pointer = (lispobj *) native_pointer(object);
  494 + header = *pointer;
  495 + type = widetag_of(header);
  496 + nwords = (sizetab[type])(pointer);
  497 + break;
  498 + default: nwords=1; /* shut yer whinging, gcc */
  499 + }
  500 + } else {
  501 + type = widetag_of(object);
  502 + nwords = (sizetab[type])(start);
  503 + total_words_not_copied += nwords;
  504 + printf("%4d words not copied at 0x%16lx; ",
  505 + nwords, (unsigned long) start);
  506 + printf("Header word is 0x%08x\n",
  507 + (unsigned int) object);
  508 + }
  509 + start += nwords;
  510 + }
  511 + printf("%d total words not copied.\n", total_words_not_copied);
  512 +}
  513 +
  514 +
  515 +/* code and code-related objects */
  516 +
  517 +/* FIXME: Shouldn't this be defined in sbcl.h? */
  518 +
  519 +
  520 +/* static lispobj trans_fun_header(lispobj object); */
  521 +/* static lispobj trans_boxed(lispobj object); */
  522 +#define FUN_RAW_ADDR_OFFSET (6*sizeof(lispobj) - FUN_POINTER_LOWTAG)
  523 +
  524 +/* Note: on the sparc we don't have to do anything special for fdefns, */
  525 +/* 'cause the raw-addr has a function lowtag. */
  526 +#ifndef LISP_FEATURE_SPARC
  527 +static int
  528 +scav_fdefn(lispobj *where, lispobj object)
  529 +{
  530 + struct fdefn *fdefn;
  531 +
  532 + fdefn = (struct fdefn *)where;
  533 +
  534 + if ((char *)(fdefn->fun + FUN_RAW_ADDR_OFFSET)
  535 + == (char *)((unsigned long)(fdefn->raw_addr))) {
  536 + scavenge(where + 1, sizeof(struct fdefn)/sizeof(lispobj) - 1);
  537 + fdefn->raw_addr =
  538 + (u32) ((char *) LOW_WORD(fdefn->fun)) + FUN_RAW_ADDR_OFFSET;
  539 + return sizeof(struct fdefn) / sizeof(lispobj);
  540 + }
  541 + else
  542 + return 1;
  543 +}
  544 +#endif
  545 +
  546 +
  547 +
  548 +/* vector-like objects */
  549 +
  550 +/* #define NWORDS(x,y) (CEILING((x),(y)) / (y)) */
  551 +
  552 +static int
  553 +scav_vector(lispobj *where, lispobj object)
  554 +{
  555 + if (HeaderValue(object) == subtype_VectorValidHashing) {
  556 + *where =
  557 + (subtype_VectorMustRehash<<N_WIDETAG_BITS) | SIMPLE_VECTOR_WIDETAG;
  558 + }
  559 +
  560 + return 1;
  561 +}
  562 +
  563 +
  564 +/* weak pointers */
  565 +
  566 +#define WEAK_POINTER_NWORDS \
  567 + CEILING((sizeof(struct weak_pointer) / sizeof(lispobj)), 2)
  568 +
  569 +static int
  570 +scav_weak_pointer(lispobj *where, lispobj object)
  571 +{
  572 + /* Do not let GC scavenge the value slot of the weak pointer */
  573 + /* (that is why it is a weak pointer). Note: we could use */
  574 + /* the scav_unboxed method here. */
  575 +
  576 + return WEAK_POINTER_NWORDS;
  577 +}
  578 +
  579 +
  580 +/* initialization. if gc_init can be moved to after core load, we could
  581 + * combine these two functions */
  582 +
  583 +void
  584 +gc_init(void)
  585 +{
  586 + gc_init_tables();
  587 + scavtab[SIMPLE_VECTOR_WIDETAG] = scav_vector;
  588 + scavtab[WEAK_POINTER_WIDETAG] = scav_weak_pointer;
  589 +}
  590 +
  591 +void
  592 +gc_initialize_pointers(void)
  593 +{
  594 + current_dynamic_space = DYNAMIC_0_SPACE_START;
  595 +}
  596 +
  597 +
  598 +
  599 +
  600 +/* noise to manipulate the gc trigger stuff */
  601 +
  602 +void set_auto_gc_trigger(os_vm_size_t dynamic_usage)
  603 +{
  604 + os_vm_address_t addr=(os_vm_address_t)current_dynamic_space
  605 + + dynamic_usage;
  606 +
  607 + long length = DYNAMIC_SPACE_SIZE - dynamic_usage;
  608 +
  609 + if (addr < (os_vm_address_t)dynamic_space_free_pointer) {
  610 + fprintf(stderr,
  611 + "set_auto_gc_trigger: tried to set gc trigger too low! (%d < %p)\n",
  612 + (unsigned int)dynamic_usage,
  613 + (os_vm_address_t)dynamic_space_free_pointer
  614 + - (os_vm_address_t)current_dynamic_space);
  615 + lose("lost");
  616 + }
  617 + else if (length < 0) {
  618 + fprintf(stderr,
  619 + "set_auto_gc_trigger: tried to set gc trigger too high! (%p)\n",
  620 + dynamic_usage);
  621 + lose("lost");
  622 + }
  623 +
  624 + addr=os_round_up_to_page(addr);
  625 + length=os_trunc_size_to_page(length);
  626 +
  627 +#if defined(SUNOS) || defined(SOLARIS)
  628 + os_invalidate(addr,length);
  629 +#else
  630 + os_protect(addr, length, 0);
  631 +#endif
  632 +
  633 + current_auto_gc_trigger = (lispobj *)addr;
  634 +}
  635 +
  636 +void clear_auto_gc_trigger(void)
  637 +{
  638 + if (current_auto_gc_trigger!=NULL){
  639 +#if defined(SUNOS) || defined(SOLARIS)/* don't want to force whole space into swapping mode... */
  640 + os_vm_address_t addr=(os_vm_address_t)current_auto_gc_trigger;
  641 + os_vm_size_t length=
  642 + DYNAMIC_SPACE_SIZE + (os_vm_address_t)current_dynamic_space - addr;
  643 +
  644 + os_validate(addr,length);
  645 +#else
  646 + os_protect((os_vm_address_t)current_dynamic_space,
  647 + DYNAMIC_SPACE_SIZE,
  648 + OS_VM_PROT_ALL);
  649 +#endif
  650 +
  651 + current_auto_gc_trigger = NULL;
  652 + }
  653 +}
4 src/runtime/coreparse.c
@@ -68,7 +68,7 @@ process_directory(int fd, u32 *ptr, int count)
68 68
69 69 switch (id) {
70 70 case DYNAMIC_CORE_SPACE_ID:
71   -#ifdef GENCGC
  71 +#ifdef LISP_FEATURE_GENCGC
72 72 if (addr != (os_vm_address_t)DYNAMIC_SPACE_START) {
73 73 fprintf(stderr, "in core: 0x%lx; in runtime: 0x%lx \n",
74 74 (long)addr, (long)DYNAMIC_SPACE_START);
@@ -87,7 +87,7 @@ process_directory(int fd, u32 *ptr, int count)
87 87 /* FIXME: Should the conditional here be reg_ALLOC instead of
88 88 * defined(__i386__)
89 89 * ? */
90   -#if defined(__i386__)
  90 +#if defined(LISP_FEATURE_X86)
91 91 SetSymbolValue(ALLOCATION_POINTER, (lispobj)free_pointer);
92 92 #else
93 93 dynamic_space_free_pointer = free_pointer;
1,373 src/runtime/gc.c → src/runtime/gc-common.c
... ... @@ -1,5 +1,6 @@
1 1 /*
2   - * stop and copy GC based on Cheney's algorithm
  2 + * Garbage Collection common functions for scavenging, moving and sizing
  3 + * objects. These are for use with both GC (stop & copy GC) and GENCGC
3 4 */
4 5
5 6 /*
@@ -13,109 +14,95 @@
13 14 * files for more information.
14 15 */
15 16
  17 +/*
  18 + * GENerational Conservative Garbage Collector for SBCL x86
  19 + */
  20 +
  21 +/*
  22 + * This software is part of the SBCL system. See the README file for
  23 + * more information.
  24 + *
  25 + * This software is derived from the CMU CL system, which was
  26 + * written at Carnegie Mellon University and released into the
  27 + * public domain. The software is in the public domain and is
  28 + * provided with absolutely no warranty. See the COPYING and CREDITS
  29 + * files for more information.
  30 + */
  31 +
  32 +/*
  33 + * For a review of garbage collection techniques (e.g. generational
  34 + * GC) and terminology (e.g. "scavenging") see Paul R. Wilson,
  35 + * "Uniprocessor Garbage Collection Techniques". As of 20000618, this
  36 + * had been accepted for _ACM Computing Surveys_ and was available
  37 + * as a PostScript preprint through
  38 + * <http://www.cs.utexas.edu/users/oops/papers.html>
  39 + * as
  40 + * <ftp://ftp.cs.utexas.edu/pub/garbage/bigsurv.ps>.
  41 + */
  42 +
16 43 #include <stdio.h>
17   -#include <sys/time.h>
18   -#include <sys/resource.h>
19 44 #include <signal.h>
20 45 #include "runtime.h"
21 46 #include "sbcl.h"
22 47 #include "os.h"
23   -#include "gc.h"
  48 +#include "interr.h"
24 49 #include "globals.h"
25 50 #include "interrupt.h"
26 51 #include "validate.h"
27 52 #include "lispregs.h"
28   -#include "interr.h"
  53 +#include "arch.h"
  54 +#include "gc.h"
  55 +#include "gc-internal.h"
29 56
30   -/* So you need to debug? */
31   -#if 0
32   -#define PRINTNOISE
33   -#define DEBUG_SPACE_PREDICATES
34   -#define DEBUG_SCAVENGE_VERBOSE
35   -#define DEBUG_COPY_VERBOSE
36   -#define DEBUG_CODE_GC
  57 +#ifdef LISP_FEATURE_SPARC
  58 +#define LONG_FLOAT_SIZE 4
  59 +#else
  60 +#ifdef LISP_FEATURE_X86
  61 +#define LONG_FLOAT_SIZE 3
  62 +#endif
37 63 #endif
38 64
39   -static lispobj *from_space;
40   -static lispobj *from_space_free_pointer;
41   -
42   -static lispobj *new_space;
43   -static lispobj *new_space_free_pointer;
44   -
45   -static int (*scavtab[256])(lispobj *where, lispobj object);
46   -static lispobj (*transother[256])(lispobj object);
47   -static int (*sizetab[256])(lispobj *where);
48   -
49   -static struct weak_pointer *weak_pointers;
50   -
51   -static void scavenge(lispobj *start, u32 nwords);
52   -static void scavenge_newspace(void);
53   -static void scavenge_interrupt_contexts(void);
54   -static void scan_weak_pointers(void);
55   -static int scav_lose(lispobj *where, lispobj object);
56   -
57   -#define gc_abort() lose("GC invariant lost! File \"%s\", line %d\n", \
58   - __FILE__, __LINE__)
59   -
60   -#if 1
61   -#define gc_assert(ex) do { \
62   - if (!(ex)) gc_abort(); \
63   -} while (0)
  65 +inline static boolean
  66 +forwarding_pointer_p(lispobj *pointer) {
  67 + lispobj first_word=*pointer;
  68 +#ifdef LISP_FEATURE_GENCGC
  69 + return (first_word == 0x01);
64 70 #else
65   -#define gc_assert(ex)
  71 + return (is_lisp_pointer(first_word)
  72 + && new_space_p(first_word));
66 73 #endif
  74 +}
67 75
68   -#define CEILING(x,y) (((x) + ((y) - 1)) & (~((y) - 1)))
69   -
70   -
71   -/* predicates */
72   -
73   -#if defined(DEBUG_SPACE_PREDICATES)
74   -
75   -boolean
76   -from_space_p(lispobj object)
77   -{
78   - lispobj *ptr;
79   -
80   - /* this can be called for untagged pointers as well as for
81   - descriptors, so this assertion's not applicable
82   - gc_assert(is_lisp_pointer(object));
83   - */
84   - ptr = (lispobj *) native_pointer(object);
85   -
86   - return ((from_space <= ptr) &&
87   - (ptr < from_space_free_pointer));
88   -}
89   -
90   -boolean
91   -new_space_p(lispobj object)
92   -{
93   - lispobj *ptr;
94   -
95   - gc_assert(is_lisp_pointer(object));
96   -
97   - ptr = (lispobj *) native_pointer(object);
98   -
99   - return ((new_space <= ptr) &&
100   - (ptr < new_space_free_pointer));
101   -}
102   -
  76 +static inline lispobj *
  77 +forwarding_pointer_value(lispobj *pointer) {
  78 +#ifdef LISP_FEATURE_GENCGC
  79 + return (lispobj *) ((pointer_sized_uint_t) pointer[1]);
103 80 #else
104   -
105   -#define from_space_p(ptr) \
106   - ((from_space <= ((lispobj *) ptr)) && \
107   - (((lispobj *) ptr) < from_space_free_pointer))
108   -
109   -#define new_space_p(ptr) \
110   - ((new_space <= ((lispobj *) ptr)) && \
111   - (((lispobj *) ptr) < new_space_free_pointer))
112   -
  81 + return (lispobj *) ((pointer_sized_uint_t) pointer[0]);
113 82 #endif
  83 +}
  84 +static inline lispobj
  85 +set_forwarding_pointer(lispobj * pointer, lispobj newspace_copy) {
  86 +#ifdef LISP_FEATURE_GENCGC
  87 + pointer[0]=0x01;
  88 + pointer[1]=newspace_copy;
  89 +#else
  90 + pointer[0]=newspace_copy;
  91 +#endif
  92 + return newspace_copy;
  93 +}
114 94
115   -
116   -/* copying objects */
  95 +int (*scavtab[256])(lispobj *where, lispobj object);
  96 +lispobj (*transother[256])(lispobj object);
  97 +int (*sizetab[256])(lispobj *where);
  98 +struct weak_pointer *weak_pointers;
117 99
118   -static lispobj
  100 +/*
  101 + * copying objects
  102 + */
  103 +
  104 +/* to copy a boxed object */
  105 +lispobj
119 106 copy_object(lispobj object, int nwords)
120 107 {
121 108 int tag;
@@ -126,21 +113,16 @@ copy_object(lispobj object, int nwords)
126 113 gc_assert(from_space_p(object));
127 114 gc_assert((nwords & 0x01) == 0);
128 115
129   - /* get tag of object */
  116 + /* Get tag of object. */
130 117 tag = lowtag_of(object);
131 118
132   - /* allocate space */
133   - new = new_space_free_pointer;
134   - new_space_free_pointer += nwords;
  119 + /* Allocate space. */
  120 + new = gc_general_alloc(nwords*4,ALLOC_BOXED,ALLOC_QUICK);
135 121
136 122 dest = new;
137 123 source = (lispobj *) native_pointer(object);
138 124
139   -#ifdef DEBUG_COPY_VERBOSE
140   - fprintf(stderr,"Copying %d words from %p to %p\n", nwords,source,new);
141   -#endif
142   -
143   - /* copy the object */
  125 + /* Copy the object. */
144 126 while (nwords > 0) {
145 127 dest[0] = source[0];
146 128 dest[1] = source[1];
@@ -148,300 +130,55 @@ copy_object(lispobj object, int nwords)
148 130 source += 2;
149 131 nwords -= 2;
150 132 }
151   - /* return lisp pointer of new object */
152   - return (lispobj)(LOW_WORD(new) | tag);
153   -}
154   -
155   -
156   -/* collecting garbage */
157 133
158   -#ifdef PRINTNOISE
159   -static double
160   -tv_diff(struct timeval *x, struct timeval *y)
161   -{
162   - return (((double) x->tv_sec + (double) x->tv_usec * 1.0e-6) -
163   - ((double) y->tv_sec + (double) y->tv_usec * 1.0e-6));
  134 + return make_lispobj(new,tag);
164 135 }
165   -#endif
166   -
167   -#define BYTES_ZERO_BEFORE_END (1<<12)
168   -
169   -#ifdef alpha
170   -#define U32 u32
171   -#else
172   -#define U32 unsigned long
173   -#endif
174   -static void
175   -zero_stack(void)
176   -{
177   - U32 *ptr = (U32 *)current_control_stack_pointer;
178   - search:
179   - do {
180   - if (*ptr)
181   - goto fill;
182   - ptr++;
183   - } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
184   - return;
185   - fill:
186   - do {
187   - *ptr++ = 0;
188   - } while (((unsigned long)ptr) & (BYTES_ZERO_BEFORE_END-1));
189 136
190   - goto search;
191   -}
192   -#undef U32
  137 +static int scav_lose(lispobj *where, lispobj object); /* forward decl */
193 138
  139 +/* FIXME: Most calls end up going to some trouble to compute an
  140 + * 'n_words' value for this function. The system might be a little
  141 + * simpler if this function used an 'end' parameter instead. */
194 142
195   -/* Note: The generic GC interface we're implementing passes us a
196   - * last_generation argument. That's meaningless for us, since we're
197   - * not a generational GC. So we ignore it. */
198 143 void
199   -collect_garbage(unsigned ignore)
200   -{
201   -#ifdef PRINTNOISE
202   - struct timeval start_tv, stop_tv;
203   - struct rusage start_rusage, stop_rusage;
204   - double real_time, system_time, user_time;
205   - double percent_retained, gc_rate;
206   - unsigned long size_discarded;
207   - unsigned long size_retained;
208   -#endif
209   - lispobj *current_static_space_free_pointer;
210   - unsigned long static_space_size;
211   - unsigned long control_stack_size, binding_stack_size;
212   - sigset_t tmp, old;
213   -
214   -#ifdef PRINTNOISE
215   - printf("[Collecting garbage ... \n");
216   -
217   - getrusage(RUSAGE_SELF, &start_rusage);
218   - gettimeofday(&start_tv, (struct timezone *) 0);
219   -#endif
220   -
221   - sigemptyset(&tmp);
222   - sigaddset_blockable(&tmp);
223   - sigprocmask(SIG_BLOCK, &tmp, &old);
224   -
225   - current_static_space_free_pointer =
226   - (lispobj *) ((unsigned long)
227   - SymbolValue(STATIC_SPACE_FREE_POINTER));
228   -
229   -
230   - /* Set up from space and new space pointers. */
231   -
232   - from_space = current_dynamic_space;
233   - from_space_free_pointer = dynamic_space_free_pointer;
234   -
235   -#ifdef PRINTNOISE
236   - fprintf(stderr,"from_space = %lx\n",
237   - (unsigned long) current_dynamic_space);
238   -#endif
239   - if (current_dynamic_space == (lispobj *) DYNAMIC_0_SPACE_START)
240   - new_space = (lispobj *)DYNAMIC_1_SPACE_START;
241   - else if (current_dynamic_space == (lispobj *) DYNAMIC_1_SPACE_START)
242   - new_space = (lispobj *) DYNAMIC_0_SPACE_START;
243   - else {
244   - lose("GC lossage. Current dynamic space is bogus!\n");
245   - }
246   - new_space_free_pointer = new_space;
247   -#if 0
248   - /* at one time we had the bright idea of using mprotect() to
249   - * hide the semispace that we're not using at the moment, so
250   - * we'd see immediately if anyone had a pointer to it.
251   - * Unfortunately, if we gc during a call to an assembler
252   - * routine with a "raw" return style, at least on PPC we are
253   - * expected to return into oldspace because we can't easily
254   - * update the link register - it's not tagged, and we can't do
255   - * it as an offset of reg_CODE because the calling routine
256   - * might be nowhere near our code vector. We hope that we
257   - * don't run very far in oldspace before it catapults us into
258   - * newspace by either calling something else or returning
259   - */
260   -
261   - /* write-enable */
262   - os_protect(new_space,DYNAMIC_SPACE_SIZE,OS_VM_PROT_ALL);
263   -#endif
264   -
265   - /* Initialize the weak pointer list. */
266   - weak_pointers = (struct weak_pointer *) NULL;
267   -
268   -
269   - /* Scavenge all of the roots. */
270   -#ifdef PRINTNOISE
271   - printf("Scavenging interrupt contexts ...\n");
272   -#endif
273   - scavenge_interrupt_contexts();
274   -
275   -#ifdef PRINTNOISE
276   - printf("Scavenging interrupt handlers (%d bytes) ...\n",
277   - (int)sizeof(interrupt_handlers));
278   -#endif
279   - scavenge((lispobj *) interrupt_handlers,
280   - sizeof(interrupt_handlers) / sizeof(lispobj));
281   -
282   - /* _size quantities are in units of sizeof(lispobj) - i.e. 4 */
283   - control_stack_size =
284   - current_control_stack_pointer-
285   - (lispobj *)CONTROL_STACK_START;
286   -#ifdef PRINTNOISE
287   - printf("Scavenging the control stack at %p (%ld words) ...\n",
288   - ((lispobj *)CONTROL_STACK_START),
289   - control_stack_size);
290   -#endif
291   - scavenge(((lispobj *)CONTROL_STACK_START), control_stack_size);
292   -
293   -
294   - binding_stack_size =
295   - current_binding_stack_pointer -
296   - (lispobj *)BINDING_STACK_START;
297   -#ifdef PRINTNOISE
298   - printf("Scavenging the binding stack %x - %x (%d words) ...\n",
299   - BINDING_STACK_START,current_binding_stack_pointer,
300   - (int)(binding_stack_size));
301   -#endif
302   - scavenge(((lispobj *)BINDING_STACK_START), binding_stack_size);
303   -
304   - static_space_size =
305   - current_static_space_free_pointer - (lispobj *) STATIC_SPACE_START;
306   -#ifdef PRINTNOISE
307   - printf("Scavenging static space %x - %x (%d words) ...\n",
308   - STATIC_SPACE_START,current_static_space_free_pointer,
309   - (int)(static_space_size));
310   -#endif
311   - scavenge(((lispobj *)STATIC_SPACE_START), static_space_size);
312   -
313   - /* Scavenge newspace. */
314   -#ifdef PRINTNOISE
315   - printf("Scavenging new space (%d bytes) ...\n",
316   - (int)((new_space_free_pointer - new_space) * sizeof(lispobj)));
317   -#endif
318   - scavenge_newspace();
319   -
320   -
321   -#if defined(DEBUG_PRINT_GARBAGE)
322   - print_garbage(from_space, from_space_free_pointer);
323   -#endif
324   -
325   - /* Scan the weak pointers. */
326   -#ifdef PRINTNOISE
327   - printf("Scanning weak pointers ...\n");
328   -#endif
329   - scan_weak_pointers();
330   -
331   -
332   - /* Flip spaces. */
333   -#ifdef PRINTNOISE
334   - printf("Flipping spaces ...\n");
335   -#endif
336   -
337   - os_zero((os_vm_address_t) current_dynamic_space,
338   - (os_vm_size_t) DYNAMIC_SPACE_SIZE);
339   -
340   - current_dynamic_space = new_space;
341   - dynamic_space_free_pointer = new_space_free_pointer;
342   -
343   -#ifdef PRINTNOISE
344   - size_discarded = (from_space_free_pointer - from_space) * sizeof(lispobj);
345   - size_retained = (new_space_free_pointer - new_space) * sizeof(lispobj);
346   -#endif
347   -
348   - /* Zero stack. */
349   -#ifdef PRINTNOISE
350   - printf("Zeroing empty part of control stack ...\n");
351   -#endif
352   - zero_stack();
353   -
354   - sigprocmask(SIG_SETMASK, &old, 0);
355   -
356   -
357   -#ifdef PRINTNOISE
358   - gettimeofday(&stop_tv, (struct timezone *) 0);
359   - getrusage(RUSAGE_SELF, &stop_rusage);
360   -
361   - printf("done.]\n");
362   -
363   - percent_retained = (((float) size_retained) /
364   - ((float) size_discarded)) * 100.0;
365   -
366   - printf("Total of %ld bytes out of %ld bytes retained (%3.2f%%).\n",
367   - size_retained, size_discarded, percent_retained);
368   -
369   - real_time = tv_diff(&stop_tv, &start_tv);
370   - user_time = tv_diff(&stop_rusage.ru_utime, &start_rusage.ru_utime);
371   - system_time = tv_diff(&stop_rusage.ru_stime, &start_rusage.ru_stime);
372   -
373   -#if 0
374   - printf("Statistics:\n");
375   - printf("%10.2f sec of real time\n", real_time);
376   - printf("%10.2f sec of user time,\n", user_time);
377   - printf("%10.2f sec of system time.\n", system_time);
378   -#else
379   - printf("Statistics: %10.2fs real, %10.2fs user, %10.2fs system.\n",
380   - real_time, user_time, system_time);
381   -#endif
382   -
383   - gc_rate = ((float) size_retained / (float) (1<<20)) / real_time;
384   -
385   - printf("%10.2f M bytes/sec collected.\n", gc_rate);
386   -#endif
387   - /* os_flush_icache((os_vm_address_t) 0, sizeof(unsigned long)); */
388   -
389   -#if 0
390   - /* see comment above about mprotecting oldspace */
391   -
392   - /* zero the from space now, to make it easier to find stale
393   - pointers to it */
394   -
395   - /* pray that both dynamic spaces are the same size ... */
396   - memset(from_space,(DYNAMIC_0_SPACE_END-DYNAMIC_0_SPACE_START-1),0);
397   - os_protect(from_space,DYNAMIC_SPACE_SIZE,0); /* write-protect */
398   -#endif
399   -}
400   -
401   -
402   -/* scavenging */
403   -
404   -static void
405   -scavenge(lispobj *start, u32 nwords)
  144 +scavenge(lispobj *start, long n_words)
406 145 {
407   - while (nwords > 0) {
408   - lispobj object;
409   - int type, words_scavenged;
410   -
411   - object = *start;
412   - type = widetag_of(object);
  146 + lispobj *end = start + n_words;
  147 + lispobj *object_ptr;
  148 + int n_words_scavenged;
  149 +
  150 + for (object_ptr = start;
  151 + object_ptr < end;
  152 + object_ptr += n_words_scavenged) {
413 153
414   -#if defined(DEBUG_SCAVENGE_VERBOSE)
415   - fprintf(stderr,"Scavenging object at 0x%08x, object = 0x%08x, type = %d\n",
416   - (unsigned long) start, (unsigned long) object, type);
  154 + lispobj object = *object_ptr;
  155 +#ifdef LISP_FEATURE_GENCGC
  156 + gc_assert(!forwarding_pointer_p(object_ptr));
417 157 #endif
418   -
419 158 if (is_lisp_pointer(object)) {
420   - /* It be a pointer. */
421 159 if (from_space_p(object)) {
422   - /* It currently points to old space. Check for a */
423   - /* forwarding pointer. */
424   - lispobj first_word;
425   -
426   - first_word = *((lispobj *)native_pointer(object));
427   - if (is_lisp_pointer(first_word) &&
428   - new_space_p(first_word)) {
429   - /* Yep, there be a forwarding pointer. */
430   - *start = first_word;
431   - words_scavenged = 1;
432   - }
433   - else {
  160 + /* It currently points to old space. Check for a
  161 + * forwarding pointer. */
  162 + lispobj *ptr = native_pointer(object);
  163 + if (forwarding_pointer_p(ptr)) {
  164 + /* Yes, there's a forwarding pointer. */
  165 + *object_ptr = LOW_WORD(forwarding_pointer_value(ptr));
  166 + n_words_scavenged = 1;
  167 + } else {
434 168 /* Scavenge that pointer. */
435   - words_scavenged = (scavtab[type])(start, object);
  169 + n_words_scavenged =
  170 + (scavtab[widetag_of(object)])(object_ptr, object);
436 171 }
437   - }
438   - else {
439   - /* It points somewhere other than oldspace. Leave */
440   - /* it alone. */
441   - words_scavenged = 1;
  172 + } else {
  173 + /* It points somewhere other than oldspace. Leave it
  174 + * alone. */
  175 + n_words_scavenged = 1;
442 176 }
443 177 }
444   - else if (nwords==1) {
  178 +#ifndef LISP_FEATURE_GENCGC
  179 + /* this workaround is probably not necessary for gencgc; at least, the
  180 + * behaviour it describes has never been reported */
  181 + else if (n_words==1) {
445 182 /* there are some situations where an
446 183 other-immediate may end up in a descriptor
447 184 register. I'm not sure whether this is
@@ -450,256 +187,46 @@ scavenge(lispobj *start, u32 nwords)
450 187 data-block, because there isn't one. So, if
451 188 we're checking a single word and it's anything
452 189 other than a pointer, just hush it up */
453   -
454   - words_scavenged=1;
  190 + int type=widetag_of(object);
  191 + n_words_scavenged=1;
  192 +
455 193 if ((scavtab[type]==scav_lose) ||
456 194 (((scavtab[type])(start,object))>1)) {
457   - fprintf(stderr,"warning: attempted to scavenge non-descriptor value %x at %p. If you can\nreproduce this warning, send a test case to sbcl-devel@lists.sourceforge.net\n",
  195 + fprintf(stderr,"warning: attempted to scavenge non-descriptor value %x at %p. If you can\nreproduce this warning, send a bug report (see manual page for details)\n",
458 196 object,start);
459 197 }
460 198 }
461   - else if ((object & 3) == 0) {
462   - /* It's a fixnum. Real easy. */
463   - words_scavenged = 1;
464   - }
465   - else {
466   - /* It's some random header object. */
467   - words_scavenged = (scavtab[type])(start, object);
468   -
469   - }
470   -
471   - start += words_scavenged;
472   - nwords -= words_scavenged;
473   - }
474   - gc_assert(nwords == 0);
475   -}
476   -
477   -static void
478   -scavenge_newspace(void)
479   -{
480   - lispobj *here, *next;
481   -
482   - here = new_space;
483   - while (here < new_space_free_pointer) {
484   - /* printf("here=%lx, new_space_free_pointer=%lx\n",
485   - here,new_space_free_pointer); */
486   - next = new_space_free_pointer;
487   - scavenge(here, next - here);
488   - here = next;
489   - }
490   - /* printf("done with newspace\n"); */
491   -}
492   -
493   -/* scavenging interrupt contexts */
494   -
495   -static int boxed_registers[] = BOXED_REGISTERS;
496   -
497   -static void
498   -scavenge_interrupt_context(os_context_t *context)
499   -{
500   - int i;
501   -#ifdef reg_LIP
502   - unsigned long lip;
503   - unsigned long lip_offset;
504   - int lip_register_pair;
505   -#endif
506   - unsigned long pc_code_offset;
507   -#ifdef ARCH_HAS_LINK_REGISTER
508   - unsigned long lr_code_offset;
509   -#endif
510   -#ifdef ARCH_HAS_NPC_REGISTER
511   - unsigned long npc_code_offset;
512   -#endif
513   -#ifdef DEBUG_SCAVENGE_VERBOSE
514   - fprintf(stderr, "Scavenging interrupt context at 0x%x\n",context);
515   -#endif
516   - /* Find the LIP's register pair and calculate its offset */
517   - /* before we scavenge the context. */
518   -#ifdef reg_LIP
519   - lip = *os_context_register_addr(context, reg_LIP);
520   - /* 0x7FFFFFFF or 0x7FFFFFFFFFFFFFFF ? */
521   - lip_offset = 0x7FFFFFFF;
522   - lip_register_pair = -1;
523   - for (i = 0; i < (sizeof(boxed_registers) / sizeof(int)); i++) {
524   - unsigned long reg;
525   - long offset;
526   - int index;
527   -
528   - index = boxed_registers[i];
529   - reg = *os_context_register_addr(context, index);
530   - /* would be using PTR if not for integer length issues */
531   - if ((reg & ~((1L<<N_LOWTAG_BITS)-1)) <= lip) {
532   - offset = lip - reg;
533   - if (offset < lip_offset) {
534   - lip_offset = offset;
535   - lip_register_pair = index;
536   - }
537   - }
538   - }
539   -#endif /* reg_LIP */
540   -
541   - /* Compute the PC's offset from the start of the CODE */
542   - /* register. */
543   - pc_code_offset =
544   - *os_context_pc_addr(context) -
545   - *os_context_register_addr(context, reg_CODE);