diff --git a/runtime.c b/runtime.c index 978ab1ff..34aa422d 100644 --- a/runtime.c +++ b/runtime.c @@ -1102,7 +1102,7 @@ void _string_91_125list(object cont, object args) { return_funcall1(cont, &lst);} void _make_91vector(object cont, object args) { make_vector(v, car(args), cadr(args)); - return_funcall1(cont, &v);} + return_funcall1(cont, v);} void _list_91_125string(object cont, object args) { string_type s = Cyc_list2string(car(args)); return_funcall1(cont, &s);} diff --git a/runtime.h b/runtime.h index e2d99bf1..0319fcec 100644 --- a/runtime.h +++ b/runtime.h @@ -150,6 +150,7 @@ void dispatch(int argc, function_type func, object clo, object cont, object args void dispatch_va(int argc, function_type_va func, object clo, object cont, object args); void do_dispatch(int argc, function_type func, object clo, object *buffer); +// Note: below is OK since alloca memory is not freed until function exits #define string2list(c,s) object c = nil; { \ char *str = ((string_type *)s)->str; \ int len = strlen(str); \ @@ -161,14 +162,14 @@ void do_dispatch(int argc, function_type func, object clo, object *buffer); } \ } -// v = (object)alloca(sizeof(vector_type)); -#define make_vector(v, len, fill) vector_type v; { \ +#define make_vector(v, len, fill) object v = nil; { \ + v = alloca(sizeof(vector_type)); \ + ((vector)v)->tag = vector_tag; \ + ((vector)v)->num_elt = ((integer_type *)len)->value; \ + ((vector)v)->elts = (((vector)v)->num_elt > 0) ? (object *)alloca(sizeof(object) * ((vector)v)->num_elt): NULL; \ int i; \ - v.tag = vector_tag; \ - v.num_elt = ((integer_type *)len)->value; \ - v.elts = (v.num_elt > 0) ? (object *)alloca(sizeof(object) * v.num_elt): NULL; \ - for (i = 0; i < v.num_elt; i++) { \ - v.elts[i] = fill; \ + for (i = 0; i < ((vector)v)->num_elt; i++) { \ + ((vector)v)->elts[i] = fill; \ } \ } diff --git a/test.scm b/test.scm index 68c89e55..3c31df68 100644 --- a/test.scm +++ b/test.scm @@ -5,3 +5,4 @@ (write `(read ,(list 1 2 3))) (write `(read ,@(list 1 2 3))) ;`(read , +(write (make-vector 4 #t)) diff --git a/trans.scm b/trans.scm index 0230dbfc..cd3e26e4 100644 --- a/trans.scm +++ b/trans.scm @@ -536,6 +536,7 @@ write display)) +;; Constant Folding ;; Is a primitive being applied in such a way that it can be ;; evaluated at compile time? (define (precompute-prim-app? ast) @@ -562,6 +563,7 @@ set-cdr! string->symbol ;; Could be mistaken for an identifier string->list ;; Mistaken for function call (maybe OK if it was quoted, though). same for above? + make-vector ;; I/O must be done at runtime for side effects: current-input-port open-input-file