ref: 6e515a532e6cf52317d6cc3d26a30c4d73085395
parent: 62e5c359d0101a763613f294f4847d3f7c8d012b
author: JeffBezanson <jeff.bezanson@gmail.com>
date: Thu Aug 7 01:08:10 EDT 2008
fix oops in new apply() more cvalues design
--- a/femtolisp/flisp.c
+++ b/femtolisp/flisp.c
@@ -300,7 +300,7 @@
{
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 @@
{
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, ...)
--- a/femtolisp/todo
+++ b/femtolisp/todo
@@ -169,10 +169,11 @@
(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 @@
- 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 @@
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:
--- 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))