From 6bf5aa0c7267b00628125b0c174c391ca9db5287 Mon Sep 17 00:00:00 2001 From: JeffBezanson Date: Mon, 3 May 2010 05:07:22 +0000 Subject: [PATCH] fixes for boehm compatibility --- femtolisp/cvalues.c | 19 ++++++------------- femtolisp/flisp.c | 2 -- femtolisp/perf.lsp | 2 +- femtolisp/read.c | 14 +++++++------- femtolisp/system.lsp | 28 ++++++++++++++-------------- femtolisp/test.lsp | 8 -------- femtolisp/types.c | 6 +++--- 7 files changed, 31 insertions(+), 48 deletions(-) diff --git a/femtolisp/cvalues.c b/femtolisp/cvalues.c index 0da9dd0..fb2e92e 100644 --- a/femtolisp/cvalues.c +++ b/femtolisp/cvalues.c @@ -43,12 +43,11 @@ static size_t nfinalizers=0; static size_t maxfinalizers=0; static size_t malloc_pressure = 0; -#ifndef BOEHM_GC void add_finalizer(cvalue_t *cv) { if (nfinalizers == maxfinalizers) { 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) lerror(MemoryError, "out of memory"); Finalizers = temp; @@ -82,7 +81,7 @@ static void sweep_finalizers() #ifndef NDEBUG memset(cv_data(tmp), 0xbb, cv_len(tmp)); #endif - LLT_FREE(cv_data(tmp)); + free(cv_data(tmp)); } ndel++; } @@ -96,12 +95,6 @@ static void sweep_finalizers() 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 static size_t cv_nwords(cvalue_t *cv) @@ -160,7 +153,7 @@ value_t cvalue(fltype_t *type, size_t sz) gc(0); pcv = (cvalue_t*)alloc_words(CVALUE_NWORDS); pcv->type = type; - pcv->data = LLT_ALLOC(sz); + pcv->data = malloc(sz); autorelease(pcv); malloc_pressure += sz; } @@ -239,7 +232,7 @@ void cv_pin(cvalue_t *cv) return; size_t sz = cv_len(cv); if (cv_isstr(cv)) sz++; - void *data = LLT_ALLOC(sz); + void *data = malloc(sz); memcpy(data, cv_data(cv), sz); cv->data = data; autorelease(cv); @@ -686,7 +679,7 @@ value_t cvalue_copy(value_t v) if (!isinlined(cv)) { size_t len = cv_len(cv); if (cv_isstr(cv)) len++; - ncv->data = LLT_ALLOC(len); + ncv->data = malloc(len); memcpy(ncv->data, cv_data(cv), len); autorelease(ncv); 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) { - 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->data = &cv->_space[0]; cv->len = sizeof(value_t); diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c index 4162090..4adfa0a 100644 --- a/femtolisp/flisp.c +++ b/femtolisp/flisp.c @@ -564,9 +564,7 @@ void gc(int mustgrow) memory_exception_value = relocate(memory_exception_value); the_empty_vector = relocate(the_empty_vector); -#ifndef BOEHM_GC sweep_finalizers(); -#endif #ifdef VERBOSEGC printf("GC: found %d/%d live conses\n", diff --git a/femtolisp/perf.lsp b/femtolisp/perf.lsp index fbe8d9d..b7aec74 100644 --- a/femtolisp/perf.lsp +++ b/femtolisp/perf.lsp @@ -10,7 +10,7 @@ (princ "sort: ") (set! r (map-int (lambda (x) (mod (+ (* x 9421) 12345) 1024)) 1000)) -(time (sort r)) +(time (simple-sort r)) (princ "expand: ") (time (dotimes (n 5000) (expand '(dotimes (i 100) body1 body2)))) diff --git a/femtolisp/read.c b/femtolisp/read.c index 9fa412a..3fa4a63 100644 --- a/femtolisp/read.c +++ b/femtolisp/read.c @@ -426,20 +426,20 @@ static value_t read_string() value_t s; u_int32_t wc; - buf = LLT_ALLOC(sz); + buf = malloc(sz); while (1) { if (i >= sz-4) { // -4: leaves room for longest utf8 sequence sz *= 2; - temp = LLT_REALLOC(buf, sz); + temp = realloc(buf, sz); if (temp == NULL) { - LLT_FREE(buf); + free(buf); lerror(ParseError, "read: out of memory reading string"); } buf = temp; } c = ios_getc(F); if (c == IOS_EOF) { - LLT_FREE(buf); + free(buf); lerror(ParseError, "read: unexpected end of input in string"); } if (c == '"') @@ -447,7 +447,7 @@ static value_t read_string() else if (c == '\\') { c = ios_getc(F); if (c == IOS_EOF) { - LLT_FREE(buf); + free(buf); lerror(ParseError, "read: end of input in escape sequence"); } j=0; @@ -474,7 +474,7 @@ static value_t read_string() eseq[j] = '\0'; if (j) wc = strtol(eseq, NULL, 16); else { - LLT_FREE(buf); + free(buf); lerror(ParseError, "read: invalid escape sequence"); } if (ndig == 2) @@ -492,7 +492,7 @@ static value_t read_string() } s = cvalue_string(i); memcpy(cvalue_data(s), buf, i); - LLT_FREE(buf); + free(buf); return s; } diff --git a/femtolisp/system.lsp b/femtolisp/system.lsp index 0f2006c..1e8c9df 100644 --- a/femtolisp/system.lsp +++ b/femtolisp/system.lsp @@ -263,15 +263,14 @@ (set! lst (cdr lst))))))) (filter- pred lst (list ()))) -(define separate - (letrec ((separate- - (lambda (pred lst yes no) - (cond ((null? lst) (cons yes no)) - ((pred (car lst)) - (separate- pred (cdr lst) (cons (car lst) yes) no)) - (#t - (separate- pred (cdr lst) yes (cons (car lst) no))))))) - (lambda (pred lst) (separate- pred lst () ())))) +(define (separate pred lst) + (define (separate- pred lst yes no) + (cond ((null? lst) (values yes no)) + ((pred (car lst)) + (separate- pred (cdr lst) (cons (car lst) yes) no)) + (else + (separate- pred (cdr lst) yes (cons (car lst) no))))) + (separate- pred lst () ())) (define (count f l) (define (count- f l n) @@ -958,11 +957,12 @@ (define (simple-sort l) (if (or (null? l) (null? (cdr l))) l - (let* ((piv (car l)) - (halves (separate (lambda (x) (< x piv)) (cdr l)))) - (nconc (simple-sort (car halves)) - (list piv) - (simple-sort (cdr halves)))))) + (let ((piv (car l))) + (receive (less grtr) + (separate (lambda (x) (< x piv)) (cdr l)) + (nconc (simple-sort less) + (list piv) + (simple-sort grtr)))))) (define (make-system-image fname) (let ((f (file fname :write :create :truncate)) diff --git a/femtolisp/test.lsp b/femtolisp/test.lsp index deed96b..8d5d15b 100644 --- a/femtolisp/test.lsp +++ b/femtolisp/test.lsp @@ -35,14 +35,6 @@ ;(set! a (map-int identity 10000)) ;(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) (let ((v (car var)) diff --git a/femtolisp/types.c b/femtolisp/types.c index 7287e4c..fffd887 100644 --- a/femtolisp/types.c +++ b/femtolisp/types.c @@ -22,7 +22,7 @@ fltype_t *get_type(value_t t) sz = ctype_sizeof(t, &align); } - ft = (fltype_t*)LLT_ALLOC(sizeof(fltype_t)); + ft = (fltype_t*)malloc(sizeof(fltype_t)); ft->type = t; if (issymbol(t)) { ft->numtype = sym_to_numtype(t); @@ -42,7 +42,7 @@ fltype_t *get_type(value_t t) if (isarray) { fltype_t *eltype = get_type(car_(cdr_(t))); if (eltype->size == 0) { - LLT_FREE(ft); + free(ft); lerror(ArgError, "invalid array element type"); } 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, 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->size = sz; ft->numtype = N_NUMTYPES;