fixes for boehm compatibility

This commit is contained in:
JeffBezanson 2010-05-03 05:07:22 +00:00
parent 23b728155f
commit 6bf5aa0c72
7 changed files with 31 additions and 48 deletions

View File

@ -43,12 +43,11 @@ static size_t nfinalizers=0;
static size_t maxfinalizers=0; static size_t maxfinalizers=0;
static size_t malloc_pressure = 0; static size_t malloc_pressure = 0;
#ifndef BOEHM_GC
void add_finalizer(cvalue_t *cv) void add_finalizer(cvalue_t *cv)
{ {
if (nfinalizers == maxfinalizers) { if (nfinalizers == maxfinalizers) {
size_t nn = (maxfinalizers==0 ? 256 : maxfinalizers*2); size_t nn = (maxfinalizers==0 ? 256 : maxfinalizers*2);
cvalue_t **temp = (cvalue_t**)realloc(Finalizers, nn*sizeof(value_t)); cvalue_t **temp = (cvalue_t**)LLT_REALLOC(Finalizers, nn*sizeof(value_t));
if (temp == NULL) if (temp == NULL)
lerror(MemoryError, "out of memory"); lerror(MemoryError, "out of memory");
Finalizers = temp; Finalizers = temp;
@ -82,7 +81,7 @@ static void sweep_finalizers()
#ifndef NDEBUG #ifndef NDEBUG
memset(cv_data(tmp), 0xbb, cv_len(tmp)); memset(cv_data(tmp), 0xbb, cv_len(tmp));
#endif #endif
LLT_FREE(cv_data(tmp)); free(cv_data(tmp));
} }
ndel++; ndel++;
} }
@ -96,12 +95,6 @@ static void sweep_finalizers()
malloc_pressure = 0; malloc_pressure = 0;
} }
#else // BOEHM_GC
void add_finalizer(cvalue_t *cv)
{
(void)cv;
}
#endif // BOEHM_GC
// compute the size of the metadata object for a cvalue // compute the size of the metadata object for a cvalue
static size_t cv_nwords(cvalue_t *cv) static size_t cv_nwords(cvalue_t *cv)
@ -160,7 +153,7 @@ value_t cvalue(fltype_t *type, size_t sz)
gc(0); gc(0);
pcv = (cvalue_t*)alloc_words(CVALUE_NWORDS); pcv = (cvalue_t*)alloc_words(CVALUE_NWORDS);
pcv->type = type; pcv->type = type;
pcv->data = LLT_ALLOC(sz); pcv->data = malloc(sz);
autorelease(pcv); autorelease(pcv);
malloc_pressure += sz; malloc_pressure += sz;
} }
@ -239,7 +232,7 @@ void cv_pin(cvalue_t *cv)
return; return;
size_t sz = cv_len(cv); size_t sz = cv_len(cv);
if (cv_isstr(cv)) sz++; if (cv_isstr(cv)) sz++;
void *data = LLT_ALLOC(sz); void *data = malloc(sz);
memcpy(data, cv_data(cv), sz); memcpy(data, cv_data(cv), sz);
cv->data = data; cv->data = data;
autorelease(cv); autorelease(cv);
@ -686,7 +679,7 @@ value_t cvalue_copy(value_t v)
if (!isinlined(cv)) { if (!isinlined(cv)) {
size_t len = cv_len(cv); size_t len = cv_len(cv);
if (cv_isstr(cv)) len++; if (cv_isstr(cv)) len++;
ncv->data = LLT_ALLOC(len); ncv->data = malloc(len);
memcpy(ncv->data, cv_data(cv), len); memcpy(ncv->data, cv_data(cv), len);
autorelease(ncv); autorelease(ncv);
if (hasparent(cv)) { if (hasparent(cv)) {
@ -895,7 +888,7 @@ value_t fl_builtin(value_t *args, u_int32_t nargs)
value_t cbuiltin(char *name, builtin_t f) value_t cbuiltin(char *name, builtin_t f)
{ {
cvalue_t *cv = (cvalue_t*)LLT_ALLOC(CVALUE_NWORDS * sizeof(value_t)); cvalue_t *cv = (cvalue_t*)malloc(CVALUE_NWORDS * sizeof(value_t));
cv->type = builtintype; cv->type = builtintype;
cv->data = &cv->_space[0]; cv->data = &cv->_space[0];
cv->len = sizeof(value_t); cv->len = sizeof(value_t);

View File

@ -564,9 +564,7 @@ void gc(int mustgrow)
memory_exception_value = relocate(memory_exception_value); memory_exception_value = relocate(memory_exception_value);
the_empty_vector = relocate(the_empty_vector); the_empty_vector = relocate(the_empty_vector);
#ifndef BOEHM_GC
sweep_finalizers(); sweep_finalizers();
#endif
#ifdef VERBOSEGC #ifdef VERBOSEGC
printf("GC: found %d/%d live conses\n", printf("GC: found %d/%d live conses\n",

View File

@ -10,7 +10,7 @@
(princ "sort: ") (princ "sort: ")
(set! r (map-int (lambda (x) (mod (+ (* x 9421) 12345) 1024)) 1000)) (set! r (map-int (lambda (x) (mod (+ (* x 9421) 12345) 1024)) 1000))
(time (sort r)) (time (simple-sort r))
(princ "expand: ") (princ "expand: ")
(time (dotimes (n 5000) (expand '(dotimes (i 100) body1 body2)))) (time (dotimes (n 5000) (expand '(dotimes (i 100) body1 body2))))

View File

@ -426,20 +426,20 @@ static value_t read_string()
value_t s; value_t s;
u_int32_t wc; u_int32_t wc;
buf = LLT_ALLOC(sz); buf = malloc(sz);
while (1) { while (1) {
if (i >= sz-4) { // -4: leaves room for longest utf8 sequence if (i >= sz-4) { // -4: leaves room for longest utf8 sequence
sz *= 2; sz *= 2;
temp = LLT_REALLOC(buf, sz); temp = realloc(buf, sz);
if (temp == NULL) { if (temp == NULL) {
LLT_FREE(buf); free(buf);
lerror(ParseError, "read: out of memory reading string"); lerror(ParseError, "read: out of memory reading string");
} }
buf = temp; buf = temp;
} }
c = ios_getc(F); c = ios_getc(F);
if (c == IOS_EOF) { if (c == IOS_EOF) {
LLT_FREE(buf); free(buf);
lerror(ParseError, "read: unexpected end of input in string"); lerror(ParseError, "read: unexpected end of input in string");
} }
if (c == '"') if (c == '"')
@ -447,7 +447,7 @@ static value_t read_string()
else if (c == '\\') { else if (c == '\\') {
c = ios_getc(F); c = ios_getc(F);
if (c == IOS_EOF) { if (c == IOS_EOF) {
LLT_FREE(buf); free(buf);
lerror(ParseError, "read: end of input in escape sequence"); lerror(ParseError, "read: end of input in escape sequence");
} }
j=0; j=0;
@ -474,7 +474,7 @@ static value_t read_string()
eseq[j] = '\0'; eseq[j] = '\0';
if (j) wc = strtol(eseq, NULL, 16); if (j) wc = strtol(eseq, NULL, 16);
else { else {
LLT_FREE(buf); free(buf);
lerror(ParseError, "read: invalid escape sequence"); lerror(ParseError, "read: invalid escape sequence");
} }
if (ndig == 2) if (ndig == 2)
@ -492,7 +492,7 @@ static value_t read_string()
} }
s = cvalue_string(i); s = cvalue_string(i);
memcpy(cvalue_data(s), buf, i); memcpy(cvalue_data(s), buf, i);
LLT_FREE(buf); free(buf);
return s; return s;
} }

View File

@ -263,15 +263,14 @@
(set! lst (cdr lst))))))) (set! lst (cdr lst)))))))
(filter- pred lst (list ()))) (filter- pred lst (list ())))
(define separate (define (separate pred lst)
(letrec ((separate- (define (separate- pred lst yes no)
(lambda (pred lst yes no) (cond ((null? lst) (values yes no))
(cond ((null? lst) (cons yes no)) ((pred (car lst))
((pred (car lst)) (separate- pred (cdr lst) (cons (car lst) yes) no))
(separate- pred (cdr lst) (cons (car lst) yes) no)) (else
(#t (separate- pred (cdr lst) yes (cons (car lst) no)))))
(separate- pred (cdr lst) yes (cons (car lst) no))))))) (separate- pred lst () ()))
(lambda (pred lst) (separate- pred lst () ()))))
(define (count f l) (define (count f l)
(define (count- f l n) (define (count- f l n)
@ -958,11 +957,12 @@
(define (simple-sort l) (define (simple-sort l)
(if (or (null? l) (null? (cdr l))) l (if (or (null? l) (null? (cdr l))) l
(let* ((piv (car l)) (let ((piv (car l)))
(halves (separate (lambda (x) (< x piv)) (cdr l)))) (receive (less grtr)
(nconc (simple-sort (car halves)) (separate (lambda (x) (< x piv)) (cdr l))
(list piv) (nconc (simple-sort less)
(simple-sort (cdr halves)))))) (list piv)
(simple-sort grtr))))))
(define (make-system-image fname) (define (make-system-image fname)
(let ((f (file fname :write :create :truncate)) (let ((f (file fname :write :create :truncate))

View File

@ -35,14 +35,6 @@
;(set! a (map-int identity 10000)) ;(set! a (map-int identity 10000))
;(dotimes (i 200) (rfoldl cons () a)) ;(dotimes (i 200) (rfoldl cons () a))
(define (sort l)
(if (or (null? l) (null? (cdr l))) l
(let* ((piv (car l))
(halves (separate (lambda (x) (< x piv)) (cdr l))))
(nconc (sort (car halves))
(list piv)
(sort (cdr halves))))))
#| #|
(define-macro (dotimes var . body) (define-macro (dotimes var . body)
(let ((v (car var)) (let ((v (car var))

View File

@ -22,7 +22,7 @@ fltype_t *get_type(value_t t)
sz = ctype_sizeof(t, &align); sz = ctype_sizeof(t, &align);
} }
ft = (fltype_t*)LLT_ALLOC(sizeof(fltype_t)); ft = (fltype_t*)malloc(sizeof(fltype_t));
ft->type = t; ft->type = t;
if (issymbol(t)) { if (issymbol(t)) {
ft->numtype = sym_to_numtype(t); ft->numtype = sym_to_numtype(t);
@ -42,7 +42,7 @@ fltype_t *get_type(value_t t)
if (isarray) { if (isarray) {
fltype_t *eltype = get_type(car_(cdr_(t))); fltype_t *eltype = get_type(car_(cdr_(t)));
if (eltype->size == 0) { if (eltype->size == 0) {
LLT_FREE(ft); free(ft);
lerror(ArgError, "invalid array element type"); lerror(ArgError, "invalid array element type");
} }
ft->elsz = eltype->size; ft->elsz = eltype->size;
@ -70,7 +70,7 @@ fltype_t *get_array_type(value_t eltype)
fltype_t *define_opaque_type(value_t sym, size_t sz, cvtable_t *vtab, fltype_t *define_opaque_type(value_t sym, size_t sz, cvtable_t *vtab,
cvinitfunc_t init) cvinitfunc_t init)
{ {
fltype_t *ft = (fltype_t*)LLT_ALLOC(sizeof(fltype_t)); fltype_t *ft = (fltype_t*)malloc(sizeof(fltype_t));
ft->type = sym; ft->type = sym;
ft->size = sz; ft->size = sz;
ft->numtype = N_NUMTYPES; ft->numtype = N_NUMTYPES;