fixes for boehm compatibility

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);

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",

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))))

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;
 }
 

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))

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))

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;