shithub: femtolisp

Info  •  Files  •  Log  •  Branches

porting over some small changes from julia's flisp

--- a/femtolisp/cvalues.c

+++ b/femtolisp/cvalues.c

@@ -38,16 +38,17 @@

 // trigger unconditional GC after this many bytes are allocated

 #define ALLOC_LIMIT_TRIGGER 67108864

+static size_t malloc_pressure = 0;

+

 static cvalue_t **Finalizers = NULL;

 static size_t nfinalizers=0;

 static size_t maxfinalizers=0;

-static size_t malloc_pressure = 0;

 void add_finalizer(cvalue_t *cv)

 {

     if (nfinalizers == maxfinalizers) {

         size_t nn = (maxfinalizers==0 ? 256 : maxfinalizers*2);

-        cvalue_t **temp = (cvalue_t**)LLT_REALLOC(Finalizers, nn*sizeof(value_t));

+        cvalue_t **temp = (cvalue_t**)realloc(Finalizers, nn*sizeof(value_t));

         if (temp == NULL)

             lerror(MemoryError, "out of memory");

         Finalizers = temp;

--- a/femtolisp/flisp.boot

+++ b/femtolisp/flisp.boot

@@ -338,7 +338,8 @@

 	  #fn("9000r1e0c1_|43;" [foldl #.cons] reverse) reverse! #fn("7000r1c0q_41;" [#fn("9000r1]~F6C02~N~|~m02P2o005\x1c/2|;" [])] reverse!)

 	  self-evaluating? #fn("8000r1|?16602|C@17K02e0|3116A02|C16:02|e1|31<;" [constant?

   top-level-value] self-evaluating?)

-	  separate #fn("7000r2c0q]41;" [#fn(":000r1c0qm02|~\x7f__44;" [#fn(";000r4}\x85;0e0g2g342;|}M316@0~|}N}Mg2Kg344;~|}Ng2}Mg3K44;" [values] separate-)])] separate)

+	  separate #fn("7000r2c0q]41;" [#fn(":000r1c0qm02|~\x7f__44;" [#fn(";000r4}\x85C0e0e1g231e1g33142;|}M316@0~|}N}Mg2Kg344;~|}Ng2}Mg3K44;" [values

+  reverse] separate-)])] separate)

 	  set-syntax! #fn("9000r2e0e1|}43;" [put! *syntax-environment*] set-syntax!)

 	  simple-sort #fn("7000r1|A17602|NA640|;c0q|M41;" [#fn("8000r1e0c1qc2q42;" [call-with-values

   #fn("8000r0e0c1qi10N42;" [separate #fn("7000r1|~X;" [])])

--- a/femtolisp/flisp.c

+++ b/femtolisp/flisp.c

@@ -289,13 +289,6 @@

     return tagptr(*pnode, TAG_SYM);

 }

-typedef struct {

-    value_t isconst;

-    value_t binding;   // global value binding

-    fltype_t *type;

-    uint32_t id;

-} gensym_t;

-

 static uint32_t _gensym_ctr=0;

 // two static buffers for gensym printing so there can be two

 // gensym names available at a time, mostly for compare()

@@ -313,6 +306,11 @@

     return tagptr(gs, TAG_SYM);

 }

+int fl_isgensym(value_t v)

+{

+    return isgensym(v);

+}

+

 static value_t fl_gensymp(value_t *args, u_int32_t nargs)

 {

     argcount("gensym?", nargs, 1);

@@ -557,12 +555,12 @@

         value_t ent;

         for(i=0; i < rs->backrefs.size; i++) {

             ent = (value_t)rs->backrefs.table[i];

-            if (ent != HT_NOTFOUND)

+            if (ent != (value_t)HT_NOTFOUND)

                 rs->backrefs.table[i] = (void*)relocate(ent);

         }

         for(i=0; i < rs->gensyms.size; i++) {

             ent = (value_t)rs->gensyms.table[i];

-            if (ent != HT_NOTFOUND)

+            if (ent != (value_t)HT_NOTFOUND)

                 rs->gensyms.table[i] = (void*)relocate(ent);

         }

         rs->source = relocate(rs->source);

--- a/femtolisp/flisp.h

+++ b/femtolisp/flisp.h

@@ -29,6 +29,13 @@

     };

 } symbol_t;

+typedef struct {

+    value_t isconst;

+    value_t binding;   // global value binding

+    struct _fltype_t *type;

+    uint32_t id;

+} gensym_t;

+

 #define TAG_NUM      0x0

 #define TAG_CPRIM    0x1

 #define TAG_FUNCTION 0x2

@@ -323,6 +330,7 @@

 value_t string_from_cstrn(char *str, size_t n);

 int fl_isstring(value_t v);

 int fl_isnumber(value_t v);

+int fl_isgensym(value_t v);

 int fl_isiostream(value_t v);

 value_t cvalue_compare(value_t a, value_t b);

 int numeric_compare(value_t a, value_t b, int eq, int eqnans, char *fname);

--- a/femtolisp/system.lsp

+++ b/femtolisp/system.lsp

@@ -265,7 +265,7 @@

 (define (separate pred lst)

   (define (separate- pred lst yes no)

-    (cond ((null? lst) (values yes no))

+    (cond ((null? lst) (values (reverse yes) (reverse no)))

 	  ((pred (car lst))

 	   (separate- pred (cdr lst) (cons (car lst) yes) no))

 	  (else