From 6e515a532e6cf52317d6cc3d26a30c4d73085395 Mon Sep 17 00:00:00 2001
From: JeffBezanson <jeff.bezanson@gmail.com>
Date: Thu, 7 Aug 2008 05:08:10 +0000
Subject: [PATCH] fix oops in new apply()

more cvalues design
---
 femtolisp/flisp.c      |  6 ++++--
 femtolisp/todo         | 36 ++++++++++++++++++++++++------------
 femtolisp/unittest.lsp |  3 +++
 3 files changed, 31 insertions(+), 14 deletions(-)

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