Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 06:09:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

merging adjacent free chunks during the sweep phase

Browse source
This commit is contained in:
Alex Shinn 2009-06-10 15:17:15 +09:00
parent 54baeaca36
commit bafd9ebd29
1 changed files with 26 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
gc.c
View file

@ -4,6 +4,7 @@
#include "sexp.h" #include "sexp.h"
/* #define SEXP_INITIAL_HEAP_SIZE (3*1024*1024) */
#define SEXP_INITIAL_HEAP_SIZE 40000 #define SEXP_INITIAL_HEAP_SIZE 40000
#define SEXP_MAXIMUM_HEAP_SIZE 0 #define SEXP_MAXIMUM_HEAP_SIZE 0
#define SEXP_MINIMUM_OBJECT_SIZE (sexp_sizeof(flonum)) #define SEXP_MINIMUM_OBJECT_SIZE (sexp_sizeof(flonum))
@ -452,10 +453,31 @@ sexp sexp_sweep (sexp ctx) {
/* simple_write(p, 1, stderr); */ /* simple_write(p, 1, stderr); */
/* fprintf(stderr, "\x1B[0m\n"); */ /* fprintf(stderr, "\x1B[0m\n"); */
freed += size; freed += size;
sexp_pointer_tag(p) = SEXP_PAIR; if (((((char*)q)+(sexp_uint_t)sexp_car(q)) == (char*)p)
sexp_car(p) = (sexp)size; && (q != sexp_free_list)) {
sexp_cdr(p) = r; /* merge q with p */
sexp_cdr(q) = p; if (r && sexp_pairp(r) && ((((char*)p)+size) == (char*)r)) {
/* ... and with r */
sexp_car(q)
= (sexp)(size+(sexp_uint_t)sexp_car(q)+(sexp_uint_t)sexp_car(r));
sexp_cdr(q) = sexp_cdr(r);
r = sexp_cdr(r);
} else {
sexp_car(q) = (sexp)(size+(sexp_uint_t)sexp_car(q));
}
} else {
sexp_pointer_tag(p) = SEXP_PAIR;
if (r && sexp_pairp(r) && ((((char*)p)+size) == (char*)r)) {
/* merge p with r */
sexp_car(p) = (sexp)(size+(sexp_uint_t)sexp_car(r));
sexp_cdr(p) = sexp_cdr(r);
r = p;
} else {
sexp_car(p) = (sexp)size;
sexp_cdr(p) = r;
}
sexp_cdr(q) = p;
}
} else { } else {
/* fprintf(stderr, "\x1B[32msaving %lu bytes @ %p (%x) ", size, p, sexp_pointer_tag(p)); */ /* fprintf(stderr, "\x1B[32msaving %lu bytes @ %p (%x) ", size, p, sexp_pointer_tag(p)); */
/* simple_write(p, 1, stderr); */ /* simple_write(p, 1, stderr); */