ref: 6bf5aa0c7267b00628125b0c174c391ca9db5287
parent: 23b728155ffb446ffc4e6ac8041ff8302595b28c
author: JeffBezanson <jeff.bezanson@gmail.com>
date: Mon May 3 01:07:22 EDT 2010
fixes for boehm compatibility
--- a/femtolisp/cvalues.c
+++ b/femtolisp/cvalues.c
@@ -43,12 +43,11 @@
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 @@
#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 @@
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 @@
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 @@
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 @@
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 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);
--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -564,9 +564,7 @@
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",
--- 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))))
--- a/femtolisp/read.c
+++ b/femtolisp/read.c
@@ -426,13 +426,13 @@
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;
@@ -439,7 +439,7 @@
}
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 @@
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 @@
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 @@
}
s = cvalue_string(i);
memcpy(cvalue_data(s), buf, i);
- LLT_FREE(buf);
+ free(buf);
return s;
}
--- 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))
--- 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))
--- a/femtolisp/types.c
+++ b/femtolisp/types.c
@@ -22,7 +22,7 @@
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 @@
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 *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;