porting over some small changes from julia's flisp
This commit is contained in:
		
							parent
							
								
									3bac64cbd7
								
							
						
					
					
						commit
						caf7f15f44
					
				| 
						 | 
					@ -38,16 +38,17 @@ value_t cvalue_typeof(value_t *args, u_int32_t nargs);
 | 
				
			||||||
// trigger unconditional GC after this many bytes are allocated
 | 
					// trigger unconditional GC after this many bytes are allocated
 | 
				
			||||||
#define ALLOC_LIMIT_TRIGGER 67108864
 | 
					#define ALLOC_LIMIT_TRIGGER 67108864
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					static size_t malloc_pressure = 0;
 | 
				
			||||||
 | 
					
 | 
				
			||||||
static cvalue_t **Finalizers = NULL;
 | 
					static cvalue_t **Finalizers = NULL;
 | 
				
			||||||
static size_t nfinalizers=0;
 | 
					static size_t nfinalizers=0;
 | 
				
			||||||
static size_t maxfinalizers=0;
 | 
					static size_t maxfinalizers=0;
 | 
				
			||||||
static size_t malloc_pressure = 0;
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
void add_finalizer(cvalue_t *cv)
 | 
					void add_finalizer(cvalue_t *cv)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
    if (nfinalizers == maxfinalizers) {
 | 
					    if (nfinalizers == maxfinalizers) {
 | 
				
			||||||
        size_t nn = (maxfinalizers==0 ? 256 : maxfinalizers*2);
 | 
					        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)
 | 
					        if (temp == NULL)
 | 
				
			||||||
            lerror(MemoryError, "out of memory");
 | 
					            lerror(MemoryError, "out of memory");
 | 
				
			||||||
        Finalizers = temp;
 | 
					        Finalizers = temp;
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -338,7 +338,8 @@
 | 
				
			||||||
	  #fn("9000r1e0c1_|43;" [foldl #.cons] reverse) reverse! #fn("7000r1c0q_41;" [#fn("9000r1]~F6C02~N~|~m02P2o005\x1c/2|;" [])] reverse!)
 | 
						  #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?
 | 
						  self-evaluating? #fn("8000r1|?16602|C@17K02e0|3116A02|C16:02|e1|31<;" [constant?
 | 
				
			||||||
  top-level-value] self-evaluating?)
 | 
					  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!)
 | 
						  set-syntax! #fn("9000r2e0e1|}43;" [put! *syntax-environment*] set-syntax!)
 | 
				
			||||||
	  simple-sort #fn("7000r1|A17602|NA640|;c0q|M41;" [#fn("8000r1e0c1qc2q42;" [call-with-values
 | 
						  simple-sort #fn("7000r1|A17602|NA640|;c0q|M41;" [#fn("8000r1e0c1qc2q42;" [call-with-values
 | 
				
			||||||
  #fn("8000r0e0c1qi10N42;" [separate #fn("7000r1|~X;" [])])
 | 
					  #fn("8000r0e0c1qi10N42;" [separate #fn("7000r1|~X;" [])])
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -289,13 +289,6 @@ value_t symbol(char *str)
 | 
				
			||||||
    return tagptr(*pnode, TAG_SYM);
 | 
					    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;
 | 
					static uint32_t _gensym_ctr=0;
 | 
				
			||||||
// two static buffers for gensym printing so there can be two
 | 
					// two static buffers for gensym printing so there can be two
 | 
				
			||||||
// gensym names available at a time, mostly for compare()
 | 
					// gensym names available at a time, mostly for compare()
 | 
				
			||||||
| 
						 | 
					@ -313,6 +306,11 @@ value_t fl_gensym(value_t *args, uint32_t nargs)
 | 
				
			||||||
    return tagptr(gs, TAG_SYM);
 | 
					    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)
 | 
					static value_t fl_gensymp(value_t *args, u_int32_t nargs)
 | 
				
			||||||
{
 | 
					{
 | 
				
			||||||
    argcount("gensym?", nargs, 1);
 | 
					    argcount("gensym?", nargs, 1);
 | 
				
			||||||
| 
						 | 
					@ -557,12 +555,12 @@ void gc(int mustgrow)
 | 
				
			||||||
        value_t ent;
 | 
					        value_t ent;
 | 
				
			||||||
        for(i=0; i < rs->backrefs.size; i++) {
 | 
					        for(i=0; i < rs->backrefs.size; i++) {
 | 
				
			||||||
            ent = (value_t)rs->backrefs.table[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);
 | 
					                rs->backrefs.table[i] = (void*)relocate(ent);
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
        for(i=0; i < rs->gensyms.size; i++) {
 | 
					        for(i=0; i < rs->gensyms.size; i++) {
 | 
				
			||||||
            ent = (value_t)rs->gensyms.table[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->gensyms.table[i] = (void*)relocate(ent);
 | 
				
			||||||
        }
 | 
					        }
 | 
				
			||||||
        rs->source = relocate(rs->source);
 | 
					        rs->source = relocate(rs->source);
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -29,6 +29,13 @@ typedef struct _symbol_t {
 | 
				
			||||||
    };
 | 
					    };
 | 
				
			||||||
} symbol_t;
 | 
					} 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_NUM      0x0
 | 
				
			||||||
#define TAG_CPRIM    0x1
 | 
					#define TAG_CPRIM    0x1
 | 
				
			||||||
#define TAG_FUNCTION 0x2
 | 
					#define TAG_FUNCTION 0x2
 | 
				
			||||||
| 
						 | 
					@ -323,6 +330,7 @@ value_t string_from_cstr(char *str);
 | 
				
			||||||
value_t string_from_cstrn(char *str, size_t n);
 | 
					value_t string_from_cstrn(char *str, size_t n);
 | 
				
			||||||
int fl_isstring(value_t v);
 | 
					int fl_isstring(value_t v);
 | 
				
			||||||
int fl_isnumber(value_t v);
 | 
					int fl_isnumber(value_t v);
 | 
				
			||||||
 | 
					int fl_isgensym(value_t v);
 | 
				
			||||||
int fl_isiostream(value_t v);
 | 
					int fl_isiostream(value_t v);
 | 
				
			||||||
value_t cvalue_compare(value_t a, value_t b);
 | 
					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);
 | 
					int numeric_compare(value_t a, value_t b, int eq, int eqnans, char *fname);
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -265,7 +265,7 @@
 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define (separate pred lst)
 | 
					(define (separate pred lst)
 | 
				
			||||||
  (define (separate- pred lst yes no)
 | 
					  (define (separate- pred lst yes no)
 | 
				
			||||||
    (cond ((null? lst) (values yes no))
 | 
					    (cond ((null? lst) (values (reverse yes) (reverse no)))
 | 
				
			||||||
	  ((pred (car lst))
 | 
						  ((pred (car lst))
 | 
				
			||||||
	   (separate- pred (cdr lst) (cons (car lst) yes) no))
 | 
						   (separate- pred (cdr lst) (cons (car lst) yes) no))
 | 
				
			||||||
	  (else
 | 
						  (else
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
		Reference in New Issue