Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-24 04:25:06 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Fixes for compiling make-vector

Browse source
This commit is contained in:
Justin Ethier 2015-06-01 20:54:09 -04:00
parent fc2c84e731
commit e5e22d8277
4 changed files with 12 additions and 8 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
runtime.c
View file

@ -1102,7 +1102,7 @@ void _string_91_125list(object cont, object args) {
return_funcall1(cont, &lst);} return_funcall1(cont, &lst);}
void _make_91vector(object cont, object args) { void _make_91vector(object cont, object args) {
make_vector(v, car(args), cadr(args)); make_vector(v, car(args), cadr(args));
return_funcall1(cont, &v);} return_funcall1(cont, v);}
void _list_91_125string(object cont, object args) { void _list_91_125string(object cont, object args) {
string_type s = Cyc_list2string(car(args)); string_type s = Cyc_list2string(car(args));
return_funcall1(cont, &s);} return_funcall1(cont, &s);}

15
runtime.h
View file

@ -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 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); 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; { \ #define string2list(c,s) object c = nil; { \
char *str = ((string_type *)s)->str; \ char *str = ((string_type *)s)->str; \
int len = strlen(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) object v = nil; { \
#define make_vector(v, len, fill) vector_type v; { \ 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; \ int i; \
v.tag = vector_tag; \ for (i = 0; i < ((vector)v)->num_elt; i++) { \
v.num_elt = ((integer_type *)len)->value; \ ((vector)v)->elts[i] = fill; \
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; \
} \ } \
} }

1
test.scm
View file

@ -5,3 +5,4 @@
(write `(read ,(list 1 2 3))) (write `(read ,(list 1 2 3)))
(write `(read ,@(list 1 2 3))) (write `(read ,@(list 1 2 3)))
;`(read , ;`(read ,
(write (make-vector 4 #t))

2
trans.scm
View file

@ -536,6 +536,7 @@
write write
display)) display))
;; Constant Folding
;; Is a primitive being applied in such a way that it can be ;; Is a primitive being applied in such a way that it can be
;; evaluated at compile time? ;; evaluated at compile time?
(define (precompute-prim-app? ast) (define (precompute-prim-app? ast)
@ -562,6 +563,7 @@
set-cdr! set-cdr!
string->symbol ;; Could be mistaken for an identifier string->symbol ;; Could be mistaken for an identifier
string->list ;; Mistaken for function call (maybe OK if it was quoted, though). same for above? 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: ;; I/O must be done at runtime for side effects:
current-input-port current-input-port
open-input-file open-input-file