fix oops in new apply()

more cvalues design
This commit is contained in:
JeffBezanson 2008-08-07 05:08:10 +00:00
parent 62e5c359d0
commit 6e515a532e
3 changed files with 31 additions and 14 deletions

View File

@ -300,7 +300,7 @@ static value_t *alloc_words(int n)
{ {
value_t *first; 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 n = ALIGN(n, 2); // only allocate multiples of 2 words
if ((value_t*)curheap > ((value_t*)lim)+2-n) { if ((value_t*)curheap > ((value_t*)lim)+2-n) {
gc(0); gc(0);
@ -487,7 +487,9 @@ value_t apply(value_t f, value_t l)
{ {
PUSH(f); PUSH(f);
PUSH(l); 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, ...) value_t listn(size_t n, ...)

View File

@ -169,10 +169,11 @@ constructors:
(double b3 b2 b1 b0) or (double "3.14") (double b3 b2 b1 b0) or (double "3.14")
(array ctype (val ...)) (array ctype (val ...))
(struct ((name type) ...) (val ...)) (struct ((name type) ...) (val ...))
(pointer ctype) ; null pointer
(pointer cvalue) ; constructs pointer to the given value (pointer cvalue) ; constructs pointer to the given value
(pointer ctype ptr) ; copies/casts a pointer to a different type ; same as (pointer (typeof x) x)
so (pointer 'int8 #int32(0)) doesn't make sense, but (pointer ctype cvalue) ; pointer of given type, to given value
(pointer 'int8 (pointer #int32(0))) does. (pointer ctype cvalue addr) ; (ctype*)((char*)cvalue + addr)
(c-function ret-type (argtype ...) ld-symbol-name) (c-function ret-type (argtype ...) ld-symbol-name)
? struct/enum tag: ? struct/enum tag:
@ -583,6 +584,7 @@ cvalues todo:
- ccall - ccall
- anonymous unions - anonymous unions
* fix princ for cvalues * fix princ for cvalues
- make header size for primitives 8 bytes, even on 64-bit arch
- string constructor/concatenator: - string constructor/concatenator:
(string 'sym #char(65) #wchar(945) "blah" 23) (string 'sym #char(65) #wchar(945) "blah" 23)
@ -591,22 +593,32 @@ cvalues todo:
low-level functions: low-level functions:
; these are type/bounds-checked accesses ; these are type/bounds-checked accesses
- (cref|ccopy cvalue key) ; key is field name or index - (cref cvalue key) ; key is field name or index. access by reference.
- (cset cvalue key cvalue) ; key is field name, index, or struct offset - (aref cvalue key) ; access by value, returns fixnums where possible
- (get-[u]int[8,16,32,64] cvalue addr) - (cset cvalue key value) ; key is field name, index, or struct offset
; n is a lisp number or cvalue of size <= 8 . write&use conv_from_long to put fixnums into typed locations
- (set-[u]int[8,16,32,64] cvalue addr n) . aset is the same
- (c-struct-offset type field) - (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 - (c2lisp cvalue) ; convert to sexpr form
- (autorelease cvalue) ; mark cvalue as free-on-gc
* (typeof cvalue) * (typeof cvalue)
* (sizeof cvalue|type) * (sizeof cvalue|type)
- (deref pointer[, type]) ; convert an unknown pointer to a safe cvalue - (autorelease cvalue) ; mark cvalue as free-on-gc
- (ccopy cv) - (deref pointer[, type]) ; convert an arbitrary pointer to a cvalue
; this is the unsafe operation
; (sizeof '(pointer type)) == sizeof(void*) ; (sizeof '(pointer type)) == sizeof(void*)
; (sizeof '(array type N)) == N * sizeof(type) ; (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: things you can do with cvalues:

View File

@ -62,6 +62,9 @@
(assert (equal (* 2 #int64(0x4000000000000000)) (assert (equal (* 2 #int64(0x4000000000000000))
#uint64(0x8000000000000000))) #uint64(0x8000000000000000)))
(assert (equal (string 'sym #char(65) #wchar(945) "blah") "symA\u03B1blah"))
; ok, a couple end-to-end tests as well ; ok, a couple end-to-end tests as well
(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))) (define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))
(assert (equal (fib 20) 6765)) (assert (equal (fib 20) 6765))