diff --git a/femtolisp/flisp.c b/femtolisp/flisp.c index 8eef772..b2de19a 100644 --- a/femtolisp/flisp.c +++ b/femtolisp/flisp.c @@ -300,7 +300,7 @@ static value_t *alloc_words(int n) { value_t *first; - if (n < 2) n = 2; // the minimum allocation is a 2-word block + assert(n > 0); n = ALIGN(n, 2); // only allocate multiples of 2 words if ((value_t*)curheap > ((value_t*)lim)+2-n) { gc(0); @@ -487,7 +487,9 @@ value_t apply(value_t f, value_t l) { PUSH(f); PUSH(l); - return toplevel_eval(special_apply_form); + value_t v = toplevel_eval(special_apply_form); + POPN(2); + return v; } value_t listn(size_t n, ...) diff --git a/femtolisp/todo b/femtolisp/todo index 5c69fd0..95f9058 100644 --- a/femtolisp/todo +++ b/femtolisp/todo @@ -169,10 +169,11 @@ constructors: (double b3 b2 b1 b0) or (double "3.14") (array ctype (val ...)) (struct ((name type) ...) (val ...)) +(pointer ctype) ; null pointer (pointer cvalue) ; constructs pointer to the given value -(pointer ctype ptr) ; copies/casts a pointer to a different type -so (pointer 'int8 #int32(0)) doesn't make sense, but - (pointer 'int8 (pointer #int32(0))) does. + ; same as (pointer (typeof x) x) +(pointer ctype cvalue) ; pointer of given type, to given value +(pointer ctype cvalue addr) ; (ctype*)((char*)cvalue + addr) (c-function ret-type (argtype ...) ld-symbol-name) ? struct/enum tag: @@ -583,6 +584,7 @@ cvalues todo: - ccall - anonymous unions * fix princ for cvalues +- make header size for primitives 8 bytes, even on 64-bit arch - string constructor/concatenator: (string 'sym #char(65) #wchar(945) "blah" 23) @@ -591,22 +593,32 @@ cvalues todo: low-level functions: ; these are type/bounds-checked accesses -- (cref|ccopy cvalue key) ; key is field name or index -- (cset cvalue key cvalue) ; key is field name, index, or struct offset -- (get-[u]int[8,16,32,64] cvalue addr) - ; n is a lisp number or cvalue of size <= 8 -- (set-[u]int[8,16,32,64] cvalue addr n) -- (c-struct-offset type field) +- (cref cvalue key) ; key is field name or index. access by reference. +- (aref cvalue key) ; access by value, returns fixnums where possible +- (cset cvalue key value) ; key is field name, index, or struct offset + . write&use conv_from_long to put fixnums into typed locations + . aset is the same +- (copy cv) +- (offset type|cvalue field [field ...]) +- (eltype type field [field ...]) +- (memcpy dest-cv src-cv) +- (memcpy dest doffs src soffs nbytes) - (c2lisp cvalue) ; convert to sexpr form -- (autorelease cvalue) ; mark cvalue as free-on-gc * (typeof cvalue) * (sizeof cvalue|type) -- (deref pointer[, type]) ; convert an unknown pointer to a safe cvalue -- (ccopy cv) +- (autorelease cvalue) ; mark cvalue as free-on-gc +- (deref pointer[, type]) ; convert an arbitrary pointer to a cvalue + ; this is the unsafe operation ; (sizeof '(pointer type)) == sizeof(void*) ; (sizeof '(array type N)) == N * sizeof(type) +(define (reinterpret-cast cv type) + (if (= (sizeof cv) (sizeof type)) + (deref (pointer 'void cv) type) + (error "Invalid cast"))) + +a[n].x looks like (cref (cref a n) 'x), (reduce cref head subs) things you can do with cvalues: diff --git a/femtolisp/unittest.lsp b/femtolisp/unittest.lsp index 24d483f..ca2bc1d 100644 --- a/femtolisp/unittest.lsp +++ b/femtolisp/unittest.lsp @@ -62,6 +62,9 @@ (assert (equal (* 2 #int64(0x4000000000000000)) #uint64(0x8000000000000000))) +(assert (equal (string 'sym #char(65) #wchar(945) "blah") "symA\u03B1blah")) + + ; ok, a couple end-to-end tests as well (define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (assert (equal (fib 20) 6765))