shithub: femtolisp

Download patch

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