shithub: femtolisp

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