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

Added thread data argument

Browse source
This commit is contained in:
Justin Ethier 2015-11-02 22:44:32 -05:00
parent 9ebe928f6b
commit 4dd95d718e
4 changed files with 285 additions and 284 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
generate-c.scm
View file

@ -17,7 +17,7 @@
#include \"cyclone/types.h\" #include \"cyclone/types.h\"
#include \"cyclone/runtime.h\" #include \"cyclone/runtime.h\"
void do_dispatch(int argc, function_type func, object clo, object *b) { void do_dispatch(void *data, int argc, function_type func, object clo, object *b) {
switch(argc) {" ) switch(argc) {" )
(define bs "") (define bs "")
@ -25,6 +25,7 @@ void do_dispatch(int argc, function_type func, object clo, object *b) {
(display "case " ) (display "case " )
(display i ) (display i )
(display ":func(" ) (display ":func(" )
(display "data,")
(display i ) (display i )
(display ",clo" ) (display ",clo" )
(display bs ) (display bs )
@ -39,7 +40,7 @@ void do_dispatch(int argc, function_type func, object clo, object *b) {
{ {
char buf[1024]; char buf[1024];
snprintf(buf, 1023, \"Unhandled number of function arguments: %d\\n\", argc); snprintf(buf, 1023, \"Unhandled number of function arguments: %d\\n\", argc);
Cyc_rt_raise_msg(buf); Cyc_rt_raise_msg(data, buf);
} }
} }
}" ))) }" )))

1
include/cyclone/runtime-main.h
View file

@ -85,6 +85,7 @@ static void Cyc_main (stack_size,heap_size,stack_base)
printf("Done with GC\n"); printf("Done with GC\n");
#endif #endif
// JAE - note for the general case, setjmp will return the data pointer's addy
if (type_of(gc_cont) == cons_tag || prim(gc_cont)) { if (type_of(gc_cont) == cons_tag || prim(gc_cont)) {
Cyc_apply_from_buf(gc_num_ans, gc_cont, gc_ans); Cyc_apply_from_buf(gc_num_ans, gc_cont, gc_ans);
} else { } else {

54
include/cyclone/runtime.h
View file

@ -10,30 +10,30 @@
#define CYCLONE_RUNTIME_H #define CYCLONE_RUNTIME_H
/* Error checking definitions */ /* Error checking definitions */
#define Cyc_check_num_args(fnc_name, num_args, args) { \ #define Cyc_check_num_args(data, fnc_name, num_args, args) { \
integer_type l = Cyc_length(args); \ integer_type l = Cyc_length(data, args); \
if (num_args > l.value) { \ if (num_args > l.value) { \
char buf[128]; \ char buf[128]; \
snprintf(buf, 127, "Expected %d arguments but received %d.", num_args, l.value); \ snprintf(buf, 127, "Expected %d arguments but received %d.", num_args, l.value); \
Cyc_rt_raise_msg(buf); \ Cyc_rt_raise_msg(data, buf); \
} \ } \
} }
#define Cyc_check_type(fnc_test, tag, obj) { \ #define Cyc_check_type(data, fnc_test, tag, obj) { \
if (eq(boolean_f, fnc_test(obj))) Cyc_invalid_type_error(tag, obj); } if (eq(boolean_f, fnc_test(obj))) Cyc_invalid_type_error(data, tag, obj); }
#define Cyc_check_cons_or_nil(obj) { if (!nullp(obj)) { Cyc_check_cons(obj); }} #define Cyc_check_cons_or_nil(d,obj) { if (!nullp(obj)) { Cyc_check_cons(d,obj); }}
#define Cyc_check_cons(obj) Cyc_check_type(Cyc_is_cons, cons_tag, obj); #define Cyc_check_cons(d,obj) Cyc_check_type(d,Cyc_is_cons, cons_tag, obj);
#define Cyc_check_num(obj) Cyc_check_type(Cyc_is_number, integer_tag, obj); #define Cyc_check_num(d,obj) Cyc_check_type(d,Cyc_is_number, integer_tag, obj);
#define Cyc_check_int(obj) Cyc_check_type(Cyc_is_integer, integer_tag, obj); #define Cyc_check_int(d,obj) Cyc_check_type(d,Cyc_is_integer, integer_tag, obj);
#define Cyc_check_str(obj) Cyc_check_type(Cyc_is_string, string_tag, obj); #define Cyc_check_str(d,obj) Cyc_check_type(d,Cyc_is_string, string_tag, obj);
#define Cyc_check_sym(obj) Cyc_check_type(Cyc_is_symbol, symbol_tag, obj); #define Cyc_check_sym(d,obj) Cyc_check_type(d,Cyc_is_symbol, symbol_tag, obj);
#define Cyc_check_vec(obj) Cyc_check_type(Cyc_is_vector, vector_tag, obj); #define Cyc_check_vec(d,obj) Cyc_check_type(d,Cyc_is_vector, vector_tag, obj);
#define Cyc_check_port(obj) Cyc_check_type(Cyc_is_port, port_tag, obj); #define Cyc_check_port(d,obj) Cyc_check_type(d,Cyc_is_port, port_tag, obj);
#define Cyc_check_fnc(obj) Cyc_check_type(Cyc_is_procedure, closure2_tag, obj); #define Cyc_check_fnc(d,obj) Cyc_check_type(d,Cyc_is_procedure, closure2_tag, obj);
void Cyc_invalid_type_error(int tag, object found); void Cyc_invalid_type_error(void *data, int tag, object found);
void Cyc_check_obj(int tag, object obj); void Cyc_check_obj(void *data, int tag, object obj);
void Cyc_check_bounds(const char *label, int len, int index); void Cyc_check_bounds(void *data, const char *label, int len, int index);
/* END error checking */ /* END error checking */
extern long global_stack_size; extern long global_stack_size;
@ -80,7 +80,7 @@ object cell_get(object cell);
} \ } \
} }
/* Prototypes for Lisp built-in functions. */ /* Prototypes for primitive functions. */
extern object Cyc_global_variables; extern object Cyc_global_variables;
int _cyc_argc; int _cyc_argc;
@ -88,8 +88,8 @@ char **_cyc_argv;
object Cyc_get_global_variables(); object Cyc_get_global_variables();
object Cyc_get_cvar(object var); object Cyc_get_cvar(object var);
object Cyc_set_cvar(object var, object value); object Cyc_set_cvar(object var, object value);
object apply(object cont, object func, object args); object apply(void *data, object cont, object func, object args);
void Cyc_apply(int argc, closure cont, object prim, ...); void Cyc_apply(void *data, int argc, closure cont, object prim, ...);
integer_type Cyc_string_cmp(object str1, object str2); integer_type Cyc_string_cmp(object str1, object str2);
void dispatch_string_91append(int argc, object clo, object cont, object str1, ...); void dispatch_string_91append(int argc, object clo, object cont, object str1, ...);
list mcons(object,object); list mcons(object,object);
@ -204,9 +204,9 @@ void add_mutation(object var, object value);
void clear_mutations(); void clear_mutations();
extern list mutation_table; extern list mutation_table;
void dispatch(int argc, function_type func, object clo, object cont, object args); void dispatch(void *data, 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(void *data, 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(void *data, int argc, function_type func, object clo, object *buffer);
/* Global variables. */ /* Global variables. */
extern gc_heap *Cyc_heap; extern gc_heap *Cyc_heap;
@ -372,11 +372,11 @@ extern object Cyc_exception_handler_stack;
// behavior portable? If not, will have to modify cgen to not emit the var. // behavior portable? If not, will have to modify cgen to not emit the var.
#define __glo__85exception_91handler_91stack_85 Cyc_exception_handler_stack #define __glo__85exception_91handler_91stack_85 Cyc_exception_handler_stack
object Cyc_default_exception_handler(int argc, closure _, object err); object Cyc_default_exception_handler(void *data, int argc, closure _, object err);
object Cyc_current_exception_handler(); object Cyc_current_exception_handler();
void Cyc_rt_raise(object err); void Cyc_rt_raise(void *data, object err);
void Cyc_rt_raise2(const char *msg, object err); void Cyc_rt_raise2(void *data, const char *msg, object err);
void Cyc_rt_raise_msg(const char *err); void Cyc_rt_raise_msg(void *data, const char *err);
/* END exception handler */ /* END exception handler */
#endif /* CYCLONE_RUNTIME_H */ #endif /* CYCLONE_RUNTIME_H */

509
runtime.c
View file

@ -37,23 +37,23 @@ const char *tag_names[21] = { \
, "Reserved for future use" \ , "Reserved for future use" \
, "Reserved for future use" }; , "Reserved for future use" };
void Cyc_invalid_type_error(int tag, object found) { void Cyc_invalid_type_error(void *data, int tag, object found) {
char buf[256]; char buf[256];
snprintf(buf, 255, "Invalid type: expected %s, found", tag_names[tag]); snprintf(buf, 255, "Invalid type: expected %s, found", tag_names[tag]);
Cyc_rt_raise2(buf, found); Cyc_rt_raise2(data, buf, found);
} }
void Cyc_check_obj(int tag, object obj) { void Cyc_check_obj(void *data, int tag, object obj) {
if (!is_object_type(obj)) { if (!is_object_type(obj)) {
Cyc_invalid_type_error(tag, obj); Cyc_invalid_type_error(data, tag, obj);
} }
} }
void Cyc_check_bounds(const char *label, int len, int index) { void Cyc_check_bounds(void *data, const char *label, int len, int index) {
if (index < 0 || index >= len) { if (index < 0 || index >= len) {
char buf[128]; char buf[128];
snprintf(buf, 127, "%s - invalid index %d", label, index); snprintf(buf, 127, "%s - invalid index %d", label, index);
Cyc_rt_raise_msg(buf); Cyc_rt_raise_msg(data, buf);
} }
} }
@ -590,7 +590,7 @@ object Cyc_write_char(void *data, object c, object port)
if (obj_is_char(c)) { if (obj_is_char(c)) {
fprintf(((port_type *)port)->fp, "%c", obj_obj2char(c)); fprintf(((port_type *)port)->fp, "%c", obj_obj2char(c));
} else { } else {
Cyc_rt_raise2("Argument is not a character", c); Cyc_rt_raise2(data, "Argument is not a character", c);
} }
return quote_void; return quote_void;
} }
@ -1433,412 +1433,410 @@ cvar_type *mcvar(object *var) {
c->pvar = var; c->pvar = var;
return c;} return c;}
JAE TODO: left off thread data changes here void _Cyc_91global_91vars(void *data, object cont, object args){
return_closcall1(data, cont, Cyc_global_variables); }
void _Cyc_91global_91vars(object cont, object args){ void _car(void *data, object cont, object args) {
return_closcall1(cont, Cyc_global_variables); }
void _car(object cont, object args) {
Cyc_check_num_args("car", 1, args); Cyc_check_num_args("car", 1, args);
{ object var = car(args); { object var = car(args);
Cyc_check_cons(var); Cyc_check_cons(var);
return_closcall1(cont, car(var)); }} return_closcall1(data, cont, car(var)); }}
void _cdr(object cont, object args) { void _cdr(void *data, object cont, object args) {
Cyc_check_num_args("cdr", 1, args); Cyc_check_num_args("cdr", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cdr(car(args))); } return_closcall1(data, cont, cdr(car(args))); }
void _caar(object cont, object args) { void _caar(void *data, object cont, object args) {
Cyc_check_num_args("caar", 1, args); Cyc_check_num_args("caar", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, caar(car(args))); } return_closcall1(data, cont, caar(car(args))); }
void _cadr(object cont, object args) { void _cadr(void *data, object cont, object args) {
Cyc_check_num_args("cadr", 1, args); Cyc_check_num_args("cadr", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cadr(car(args))); } return_closcall1(data, cont, cadr(car(args))); }
void _cdar(object cont, object args) { void _cdar(void *data, object cont, object args) {
Cyc_check_num_args("cdar", 1, args); Cyc_check_num_args("cdar", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cdar(car(args))); } return_closcall1(data, cont, cdar(car(args))); }
void _cddr(object cont, object args) { void _cddr(void *data, object cont, object args) {
Cyc_check_num_args("cddr", 1, args); Cyc_check_num_args("cddr", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cddr(car(args))); } return_closcall1(data, cont, cddr(car(args))); }
void _caaar(object cont, object args) { void _caaar(void *data, object cont, object args) {
Cyc_check_num_args("caaar", 1, args); Cyc_check_num_args("caaar", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, caaar(car(args))); } return_closcall1(data, cont, caaar(car(args))); }
void _caadr(object cont, object args) { void _caadr(void *data, object cont, object args) {
Cyc_check_num_args("caadr", 1, args); Cyc_check_num_args("caadr", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, caadr(car(args))); } return_closcall1(data, cont, caadr(car(args))); }
void _cadar(object cont, object args) { void _cadar(void *data, object cont, object args) {
Cyc_check_num_args("cadar", 1, args); Cyc_check_num_args("cadar", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cadar(car(args))); } return_closcall1(data, cont, cadar(car(args))); }
void _caddr(object cont, object args) { void _caddr(void *data, object cont, object args) {
Cyc_check_num_args("caddr", 1, args); Cyc_check_num_args("caddr", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, caddr(car(args))); } return_closcall1(data, cont, caddr(car(args))); }
void _cdaar(object cont, object args) { void _cdaar(void *data, object cont, object args) {
Cyc_check_num_args("cdaar", 1, args); Cyc_check_num_args("cdaar", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cdaar(car(args))); } return_closcall1(data, cont, cdaar(car(args))); }
void _cdadr(object cont, object args) { void _cdadr(void *data, object cont, object args) {
Cyc_check_num_args("cdadr", 1, args); Cyc_check_num_args("cdadr", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cdadr(car(args))); } return_closcall1(data, cont, cdadr(car(args))); }
void _cddar(object cont, object args) { void _cddar(void *data, object cont, object args) {
Cyc_check_num_args("cddar", 1, args); Cyc_check_num_args("cddar", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cddar(car(args))); } return_closcall1(data, cont, cddar(car(args))); }
void _cdddr(object cont, object args) { void _cdddr(void *data, object cont, object args) {
Cyc_check_num_args("cdddr", 1, args); Cyc_check_num_args("cdddr", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cdddr(car(args))); } return_closcall1(data, cont, cdddr(car(args))); }
void _caaaar(object cont, object args) { void _caaaar(void *data, object cont, object args) {
Cyc_check_num_args("caaaar", 1, args); Cyc_check_num_args("caaaar", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, caaaar(car(args))); } return_closcall1(data, cont, caaaar(car(args))); }
void _caaadr(object cont, object args) { void _caaadr(void *data, object cont, object args) {
Cyc_check_num_args("caaadr", 1, args); Cyc_check_num_args("caaadr", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, caaadr(car(args))); } return_closcall1(data, cont, caaadr(car(args))); }
void _caadar(object cont, object args) { void _caadar(void *data, object cont, object args) {
Cyc_check_num_args("caadar", 1, args); Cyc_check_num_args("caadar", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, caadar(car(args))); } return_closcall1(data, cont, caadar(car(args))); }
void _caaddr(object cont, object args) { void _caaddr(void *data, object cont, object args) {
Cyc_check_num_args("caaddr", 1, args); Cyc_check_num_args("caaddr", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, caaddr(car(args))); } return_closcall1(data, cont, caaddr(car(args))); }
void _cadaar(object cont, object args) { void _cadaar(void *data, object cont, object args) {
Cyc_check_num_args("cadaar", 1, args); Cyc_check_num_args("cadaar", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cadaar(car(args))); } return_closcall1(data, cont, cadaar(car(args))); }
void _cadadr(object cont, object args) { void _cadadr(void *data, object cont, object args) {
Cyc_check_num_args("cadadr", 1, args); Cyc_check_num_args("cadadr", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cadadr(car(args))); } return_closcall1(data, cont, cadadr(car(args))); }
void _caddar(object cont, object args) { void _caddar(void *data, object cont, object args) {
Cyc_check_num_args("caddar", 1, args); Cyc_check_num_args("caddar", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, caddar(car(args))); } return_closcall1(data, cont, caddar(car(args))); }
void _cadddr(object cont, object args) { void _cadddr(void *data, object cont, object args) {
Cyc_check_num_args("cadddr", 1, args); Cyc_check_num_args("cadddr", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cadddr(car(args))); } return_closcall1(data, cont, cadddr(car(args))); }
void _cdaaar(object cont, object args) { void _cdaaar(void *data, object cont, object args) {
Cyc_check_num_args("cdaaar", 1, args); Cyc_check_num_args("cdaaar", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cdaaar(car(args))); } return_closcall1(data, cont, cdaaar(car(args))); }
void _cdaadr(object cont, object args) { void _cdaadr(void *data, object cont, object args) {
Cyc_check_num_args("cdaadr", 1, args); Cyc_check_num_args("cdaadr", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cdaadr(car(args))); } return_closcall1(data, cont, cdaadr(car(args))); }
void _cdadar(object cont, object args) { void _cdadar(void *data, object cont, object args) {
Cyc_check_num_args("cdadar", 1, args); Cyc_check_num_args("cdadar", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cdadar(car(args))); } return_closcall1(data, cont, cdadar(car(args))); }
void _cdaddr(object cont, object args) { void _cdaddr(void *data, object cont, object args) {
Cyc_check_num_args("cdaddr", 1, args); Cyc_check_num_args("cdaddr", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cdaddr(car(args))); } return_closcall1(data, cont, cdaddr(car(args))); }
void _cddaar(object cont, object args) { void _cddaar(void *data, object cont, object args) {
Cyc_check_num_args("cddaar", 1, args); Cyc_check_num_args("cddaar", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cddaar(car(args))); } return_closcall1(data, cont, cddaar(car(args))); }
void _cddadr(object cont, object args) { void _cddadr(void *data, object cont, object args) {
Cyc_check_num_args("cddadr", 1, args); Cyc_check_num_args("cddadr", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cddadr(car(args))); } return_closcall1(data, cont, cddadr(car(args))); }
void _cdddar(object cont, object args) { void _cdddar(void *data, object cont, object args) {
Cyc_check_num_args("cdddar", 1, args); Cyc_check_num_args("cdddar", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cdddar(car(args))); } return_closcall1(data, cont, cdddar(car(args))); }
void _cddddr(object cont, object args) { void _cddddr(void *data, object cont, object args) {
Cyc_check_num_args("cddddr", 1, args); Cyc_check_num_args("cddddr", 1, args);
Cyc_check_cons(car(args)); Cyc_check_cons(car(args));
return_closcall1(cont, cddddr(car(args))); } return_closcall1(data, cont, cddddr(car(args))); }
void _cons(object cont, object args) { void _cons(void *data, object cont, object args) {
Cyc_check_num_args("cons", 2, args); Cyc_check_num_args("cons", 2, args);
{ make_cons(c, car(args), cadr(args)); { make_cons(c, car(args), cadr(args));
return_closcall1(cont, &c); }} return_closcall1(data, cont, &c); }}
void _eq_127(object cont, object args){ void _eq_127(void *data, object cont, object args){
Cyc_check_num_args("eq?", 2, args); Cyc_check_num_args("eq?", 2, args);
return_closcall1(cont, Cyc_eq(car(args), cadr(args))); } return_closcall1(data, cont, Cyc_eq(car(args), cadr(args))); }
void _eqv_127(object cont, object args){ void _eqv_127(void *data, object cont, object args){
Cyc_check_num_args("eqv?", 2, args); Cyc_check_num_args("eqv?", 2, args);
_eq_127(cont, args); } _eq_127(data, cont, args); }
void _equal_127(object cont, object args){ void _equal_127(void *data, object cont, object args){
Cyc_check_num_args("equal?", 2, args); Cyc_check_num_args("equal?", 2, args);
return_closcall1(cont, equalp(car(args), cadr(args))); } return_closcall1(data, cont, equalp(car(args), cadr(args))); }
void _length(object cont, object args){ void _length(void *data, object cont, object args){
Cyc_check_num_args("length", 1, args); Cyc_check_num_args("length", 1, args);
{ integer_type i = Cyc_length(car(args)); { integer_type i = Cyc_length(car(args));
return_closcall1(cont, &i); }} return_closcall1(data, cont, &i); }}
void _vector_91length(object cont, object args){ void _vector_91length(void *data, object cont, object args){
Cyc_check_num_args("vector_91length", 1, args); Cyc_check_num_args("vector_91length", 1, args);
{ integer_type i = Cyc_vector_length(car(args)); { integer_type i = Cyc_vector_length(car(args));
return_closcall1(cont, &i); }} return_closcall1(data, cont, &i); }}
void _null_127(object cont, object args) { void _null_127(void *data, object cont, object args) {
Cyc_check_num_args("null?", 1, args); Cyc_check_num_args("null?", 1, args);
return_closcall1(cont, Cyc_is_null(car(args))); } return_closcall1(data, cont, Cyc_is_null(car(args))); }
void _set_91car_67(object cont, object args) { void _set_91car_67(void *data, object cont, object args) {
Cyc_check_num_args("set-car!", 2, args); Cyc_check_num_args("set-car!", 2, args);
return_closcall1(cont, Cyc_set_car(car(args), cadr(args))); } return_closcall1(data, cont, Cyc_set_car(car(args), cadr(args))); }
void _set_91cdr_67(object cont, object args) { void _set_91cdr_67(void *data, object cont, object args) {
Cyc_check_num_args("set-cdr!", 2, args); Cyc_check_num_args("set-cdr!", 2, args);
return_closcall1(cont, Cyc_set_cdr(car(args), cadr(args))); } return_closcall1(data, cont, Cyc_set_cdr(car(args), cadr(args))); }
void _Cyc_91has_91cycle_127(object cont, object args) { void _Cyc_91has_91cycle_127(void *data, object cont, object args) {
Cyc_check_num_args("Cyc-has-cycle?", 1, args); Cyc_check_num_args("Cyc-has-cycle?", 1, args);
return_closcall1(cont, Cyc_has_cycle(car(args))); } return_closcall1(data, cont, Cyc_has_cycle(car(args))); }
void __87(object cont, object args) { void __87(void *data, object cont, object args) {
integer_type argc = Cyc_length(args); integer_type argc = Cyc_length(args);
dispatch(argc.value, (function_type)dispatch_sum, cont, cont, args); } dispatch(data, argc.value, (function_type)dispatch_sum, cont, cont, args); }
void __91(object cont, object args) { void __91(void *data, object cont, object args) {
Cyc_check_num_args("-", 1, args); Cyc_check_num_args("-", 1, args);
{ integer_type argc = Cyc_length(args); { integer_type argc = Cyc_length(args);
dispatch(argc.value, (function_type)dispatch_sub, cont, cont, args); }} dispatch(data, argc.value, (function_type)dispatch_sub, cont, cont, args); }}
void __85(object cont, object args) { void __85(void *data, object cont, object args) {
integer_type argc = Cyc_length(args); integer_type argc = Cyc_length(args);
dispatch(argc.value, (function_type)dispatch_mul, cont, cont, args); } dispatch(data, argc.value, (function_type)dispatch_mul, cont, cont, args); }
void __95(object cont, object args) { void __95(void *data, object cont, object args) {
Cyc_check_num_args("/", 1, args); Cyc_check_num_args("/", 1, args);
{ integer_type argc = Cyc_length(args); { integer_type argc = Cyc_length(args);
dispatch(argc.value, (function_type)dispatch_div, cont, cont, args); }} dispatch(data, argc.value, (function_type)dispatch_div, cont, cont, args); }}
void _Cyc_91cvar_127(object cont, object args) { void _Cyc_91cvar_127(void *data, object cont, object args) {
Cyc_check_num_args("Cyc-cvar?", 1, args); Cyc_check_num_args("Cyc-cvar?", 1, args);
return_closcall1(cont, Cyc_is_cvar(car(args))); } return_closcall1(data, cont, Cyc_is_cvar(car(args))); }
void _boolean_127(object cont, object args) { void _boolean_127(void *data, object cont, object args) {
Cyc_check_num_args("boolean?", 1, args); Cyc_check_num_args("boolean?", 1, args);
return_closcall1(cont, Cyc_is_boolean(car(args))); } return_closcall1(data, cont, Cyc_is_boolean(car(args))); }
void _char_127(object cont, object args) { void _char_127(void *data, object cont, object args) {
Cyc_check_num_args("char?", 1, args); Cyc_check_num_args("char?", 1, args);
return_closcall1(cont, Cyc_is_char(car(args))); } return_closcall1(data, cont, Cyc_is_char(car(args))); }
void _eof_91object_127(object cont, object args) { void _eof_91object_127(void *data, object cont, object args) {
Cyc_check_num_args("eof_91object?", 1, args); Cyc_check_num_args("eof_91object?", 1, args);
return_closcall1(cont, Cyc_is_eof_object(car(args))); } return_closcall1(data, cont, Cyc_is_eof_object(car(args))); }
void _number_127(object cont, object args) { void _number_127(void *data, object cont, object args) {
Cyc_check_num_args("number?", 1, args); Cyc_check_num_args("number?", 1, args);
return_closcall1(cont, Cyc_is_number(car(args))); } return_closcall1(data, cont, Cyc_is_number(car(args))); }
void _real_127(object cont, object args) { void _real_127(void *data, object cont, object args) {
Cyc_check_num_args("real?", 1, args); Cyc_check_num_args("real?", 1, args);
return_closcall1(cont, Cyc_is_real(car(args))); } return_closcall1(data, cont, Cyc_is_real(car(args))); }
void _integer_127(object cont, object args) { void _integer_127(void *data, object cont, object args) {
Cyc_check_num_args("integer?", 1, args); Cyc_check_num_args("integer?", 1, args);
return_closcall1(cont, Cyc_is_integer(car(args))); } return_closcall1(data, cont, Cyc_is_integer(car(args))); }
void _pair_127(object cont, object args) { void _pair_127(void *data, object cont, object args) {
Cyc_check_num_args("pair?", 1, args); Cyc_check_num_args("pair?", 1, args);
return_closcall1(cont, Cyc_is_cons(car(args))); } return_closcall1(data, cont, Cyc_is_cons(car(args))); }
void _procedure_127(object cont, object args) { void _procedure_127(void *data, object cont, object args) {
Cyc_check_num_args("procedure?", 1, args); Cyc_check_num_args("procedure?", 1, args);
return_closcall1(cont, Cyc_is_procedure(car(args))); } return_closcall1(data, cont, Cyc_is_procedure(car(args))); }
void _macro_127(object cont, object args) { void _macro_127(void *data, object cont, object args) {
Cyc_check_num_args("macro?", 1, args); Cyc_check_num_args("macro?", 1, args);
return_closcall1(cont, Cyc_is_macro(car(args))); } return_closcall1(data, cont, Cyc_is_macro(car(args))); }
void _port_127(object cont, object args) { void _port_127(void *data, object cont, object args) {
Cyc_check_num_args("port?", 1, args); Cyc_check_num_args("port?", 1, args);
return_closcall1(cont, Cyc_is_port(car(args))); } return_closcall1(data, cont, Cyc_is_port(car(args))); }
void _vector_127(object cont, object args) { void _vector_127(void *data, object cont, object args) {
Cyc_check_num_args("vector?", 1, args); Cyc_check_num_args("vector?", 1, args);
return_closcall1(cont, Cyc_is_vector(car(args))); } return_closcall1(data, cont, Cyc_is_vector(car(args))); }
void _string_127(object cont, object args) { void _string_127(void *data, object cont, object args) {
Cyc_check_num_args("string?", 1, args); Cyc_check_num_args("string?", 1, args);
return_closcall1(cont, Cyc_is_string(car(args))); } return_closcall1(data, cont, Cyc_is_string(car(args))); }
void _symbol_127(object cont, object args) { void _symbol_127(void *data, object cont, object args) {
Cyc_check_num_args("symbol?", 1, args); Cyc_check_num_args("symbol?", 1, args);
return_closcall1(cont, Cyc_is_symbol(car(args))); } return_closcall1(data, cont, Cyc_is_symbol(car(args))); }
void _Cyc_91get_91cvar(object cont, object args) { void _Cyc_91get_91cvar(void *data, object cont, object args) {
printf("not implemented\n"); exit(1); } printf("not implemented\n"); exit(1); }
void _Cyc_91set_91cvar_67(object cont, object args) { void _Cyc_91set_91cvar_67(void *data, object cont, object args) {
printf("not implemented\n"); exit(1); } printf("not implemented\n"); exit(1); }
/* Note we cannot use _exit (per convention) because it is reserved by C */ /* Note we cannot use _exit (per convention) because it is reserved by C */
void _cyc_exit(object cont, object args) { void _cyc_exit(void *data, object cont, object args) {
if(nullp(args)) if(nullp(args))
__halt(nil); __halt(nil);
__halt(car(args)); __halt(car(args));
} }
void __75halt(object cont, object args) { void __75halt(void *data, object cont, object args) {
exit(0); } exit(0); }
void _cell_91get(object cont, object args) { void _cell_91get(void *data, object cont, object args) {
printf("not implemented\n"); exit(1); } printf("not implemented\n"); exit(1); }
void _set_91global_67(object cont, object args) { void _set_91global_67(void *data, object cont, object args) {
printf("not implemented\n"); exit(1); } printf("not implemented\n"); exit(1); }
void _set_91cell_67(object cont, object args) { void _set_91cell_67(void *data, object cont, object args) {
printf("not implemented\n"); exit(1); } printf("not implemented\n"); exit(1); }
void _cell(object cont, object args) { void _cell(void *data, object cont, object args) {
printf("not implemented\n"); exit(1); } printf("not implemented\n"); exit(1); }
void __123(object cont, object args) { void __123(void *data, object cont, object args) {
Cyc_check_num_args("=", 2, args); Cyc_check_num_args("=", 2, args);
return_closcall1(cont, __num_eq(car(args), cadr(args)));} return_closcall1(data, cont, __num_eq(car(args), cadr(args)));}
void __125(object cont, object args) { void __125(void *data, object cont, object args) {
Cyc_check_num_args(">", 2, args); Cyc_check_num_args(">", 2, args);
return_closcall1(cont, __num_gt(car(args), cadr(args)));} return_closcall1(data, cont, __num_gt(car(args), cadr(args)));}
void __121(object cont, object args) { void __121(void *data, object cont, object args) {
Cyc_check_num_args("<", 2, args); Cyc_check_num_args("<", 2, args);
return_closcall1(cont, __num_lt(car(args), cadr(args)));} return_closcall1(data, cont, __num_lt(car(args), cadr(args)));}
void __125_123(object cont, object args) { void __125_123(void *data, object cont, object args) {
Cyc_check_num_args(">=", 2, args); Cyc_check_num_args(">=", 2, args);
return_closcall1(cont, __num_gte(car(args), cadr(args)));} return_closcall1(data, cont, __num_gte(car(args), cadr(args)));}
void __121_123(object cont, object args) { void __121_123(void *data, object cont, object args) {
Cyc_check_num_args("<=", 2, args); Cyc_check_num_args("<=", 2, args);
return_closcall1(cont, __num_lte(car(args), cadr(args)));} return_closcall1(data, cont, __num_lte(car(args), cadr(args)));}
void _apply(object cont, object args) { void _apply(void *data, object cont, object args) {
Cyc_check_num_args("apply", 2, args); Cyc_check_num_args("apply", 2, args);
apply(cont, car(args), cadr(args)); } apply(data, cont, car(args), cadr(args)); }
void _assoc (object cont, object args) { void _assoc (void *data, object cont, object args) {
Cyc_check_num_args("assoc ", 2, args); Cyc_check_num_args("assoc ", 2, args);
return_closcall1(cont, assoc(car(args), cadr(args)));} return_closcall1(data, cont, assoc(car(args), cadr(args)));}
void _assq (object cont, object args) { void _assq (void *data, object cont, object args) {
Cyc_check_num_args("assq ", 2, args); Cyc_check_num_args("assq ", 2, args);
return_closcall1(cont, assq(car(args), cadr(args)));} return_closcall1(data, cont, assq(car(args), cadr(args)));}
void _assv (object cont, object args) { void _assv (void *data, object cont, object args) {
Cyc_check_num_args("assv ", 2, args); Cyc_check_num_args("assv ", 2, args);
return_closcall1(cont, assq(car(args), cadr(args)));} return_closcall1(data, cont, assq(car(args), cadr(args)));}
void _member(object cont, object args) { void _member(void *data, object cont, object args) {
Cyc_check_num_args("member", 2, args); Cyc_check_num_args("member", 2, args);
return_closcall1(cont, memberp(car(args), cadr(args)));} return_closcall1(data, cont, memberp(car(args), cadr(args)));}
void _memq(object cont, object args) { void _memq(void *data, object cont, object args) {
Cyc_check_num_args("memq", 2, args); Cyc_check_num_args("memq", 2, args);
return_closcall1(cont, memqp(car(args), cadr(args)));} return_closcall1(data, cont, memqp(car(args), cadr(args)));}
void _memv(object cont, object args) { void _memv(void *data, object cont, object args) {
Cyc_check_num_args("memv", 2, args); Cyc_check_num_args("memv", 2, args);
return_closcall1(cont, memqp(car(args), cadr(args)));} return_closcall1(data, cont, memqp(car(args), cadr(args)));}
void _char_91_125integer(object cont, object args) { void _char_91_125integer(void *data, object cont, object args) {
Cyc_check_num_args("char->integer", 1, args); Cyc_check_num_args("char->integer", 1, args);
{ integer_type i = Cyc_char2integer(car(args)); { integer_type i = Cyc_char2integer(car(args));
return_closcall1(cont, &i);}} return_closcall1(data, cont, &i);}}
void _integer_91_125char(object cont, object args) { void _integer_91_125char(void *data, object cont, object args) {
Cyc_check_num_args("integer->char", 1, args); Cyc_check_num_args("integer->char", 1, args);
return_closcall1(cont, Cyc_integer2char(car(args)));} return_closcall1(data, cont, Cyc_integer2char(car(args)));}
void _string_91_125number(object cont, object args) { void _string_91_125number(void *data, object cont, object args) {
Cyc_check_num_args("string->number", 1, args); Cyc_check_num_args("string->number", 1, args);
{ common_type i = Cyc_string2number(car(args)); { common_type i = Cyc_string2number(car(args));
return_closcall1(cont, &i);}} return_closcall1(data, cont, &i);}}
void _string_91length(object cont, object args) { void _string_91length(void *data, object cont, object args) {
Cyc_check_num_args("string-length", 1, args); Cyc_check_num_args("string-length", 1, args);
{ integer_type i = Cyc_string_length(car(args)); { integer_type i = Cyc_string_length(car(args));
return_closcall1(cont, &i);}} return_closcall1(data, cont, &i);}}
void _cyc_substring(object cont, object args) { void _cyc_substring(void *data, object cont, object args) {
Cyc_check_num_args("substring", 3, args); Cyc_check_num_args("substring", 3, args);
Cyc_substring(cont, car(args), cadr(args), caddr(args));} Cyc_substring(data, cont, car(args), cadr(args), caddr(args));}
void _cyc_string_91set_67(object cont, object args) { void _cyc_string_91set_67(void *data, object cont, object args) {
Cyc_check_num_args("string-set!", 3, args); Cyc_check_num_args("string-set!", 3, args);
{ object s = Cyc_string_set(car(args), cadr(args), caddr(args)); { object s = Cyc_string_set(car(args), cadr(args), caddr(args));
return_closcall1(cont, s); }} return_closcall1(data, cont, s); }}
void _cyc_string_91ref(object cont, object args) { void _cyc_string_91ref(void *data, object cont, object args) {
Cyc_check_num_args("string-ref", 2, args); Cyc_check_num_args("string-ref", 2, args);
{ object c = Cyc_string_ref(car(args), cadr(args)); { object c = Cyc_string_ref(car(args), cadr(args));
return_closcall1(cont, c); }} return_closcall1(data, cont, c); }}
void _Cyc_91installation_91dir(object cont, object args) { void _Cyc_91installation_91dir(void *data, object cont, object args) {
Cyc_check_num_args("Cyc-installation-dir", 1, args); Cyc_check_num_args("Cyc-installation-dir", 1, args);
Cyc_installation_dir(cont, car(args));} Cyc_installation_dir(data, cont, car(args));}
void _command_91line_91arguments(object cont, object args) { void _command_91line_91arguments(void *data, object cont, object args) {
object cmdline = Cyc_command_line_arguments(cont); object cmdline = Cyc_command_line_arguments(cont);
return_closcall1(cont, cmdline); } return_closcall1(data, cont, cmdline); }
void _cyc_system(object cont, object args) { void _cyc_system(void *data, object cont, object args) {
Cyc_check_num_args("system", 1, args); Cyc_check_num_args("system", 1, args);
{ integer_type i = Cyc_system(car(args)); { integer_type i = Cyc_system(car(args));
return_closcall1(cont, &i);}} return_closcall1(data, cont, &i);}}
//void _error(object cont, object args) { //void _error(void *data, object cont, object args) {
// integer_type argc = Cyc_length(args); // integer_type argc = Cyc_length(args);
// dispatch_va(argc.value, dispatch_error, cont, cont, args); } // dispatch_va(data, argc.value, dispatch_error, cont, cont, args); }
void _Cyc_91current_91exception_91handler(object cont, object args) { void _Cyc_91current_91exception_91handler(void *data, object cont, object args) {
object handler = Cyc_current_exception_handler(); object handler = Cyc_current_exception_handler();
return_closcall1(cont, handler); } return_closcall1(data, cont, handler); }
void _Cyc_91default_91exception_91handler(object cont, object args) { void _Cyc_91default_91exception_91handler(void *data, object cont, object args) {
// TODO: this is a quick-and-dirty implementation, may be a better way to write this // TODO: this is a quick-and-dirty implementation, may be a better way to write this
Cyc_default_exception_handler(1, args, car(args)); Cyc_default_exception_handler(data, 1, args, car(args));
} }
void _string_91cmp(object cont, object args) { void _string_91cmp(void *data, object cont, object args) {
Cyc_check_num_args("string-cmp", 2, args); Cyc_check_num_args("string-cmp", 2, args);
{ integer_type cmp = Cyc_string_cmp(car(args), cadr(args)); { integer_type cmp = Cyc_string_cmp(car(args), cadr(args));
return_closcall1(cont, &cmp);}} return_closcall1(data, cont, &cmp);}}
void _string_91append(object cont, object args) { void _string_91append(void *data, object cont, object args) {
integer_type argc = Cyc_length(args); integer_type argc = Cyc_length(args);
dispatch(argc.value, (function_type)dispatch_string_91append, cont, cont, args); } dispatch(data, argc.value, (function_type)dispatch_string_91append, cont, cont, args); }
void _make_91vector(object cont, object args) { void _make_91vector(void *data, object cont, object args) {
Cyc_check_num_args("make-vector", 1, args); Cyc_check_num_args("make-vector", 1, args);
{ integer_type argc = Cyc_length(args); { integer_type argc = Cyc_length(args);
if (argc.value >= 2) { if (argc.value >= 2) {
Cyc_make_vector(cont, car(args), cadr(args));} Cyc_make_vector(data, cont, car(args), cadr(args));}
else { else {
Cyc_make_vector(cont, car(args), boolean_f);}}} Cyc_make_vector(data, cont, car(args), boolean_f);}}}
void _vector_91ref(object cont, object args) { void _vector_91ref(void *data, object cont, object args) {
Cyc_check_num_args("vector-ref", 2, args); Cyc_check_num_args("vector-ref", 2, args);
{ object ref = Cyc_vector_ref(car(args), cadr(args)); { object ref = Cyc_vector_ref(car(args), cadr(args));
return_closcall1(cont, ref);}} return_closcall1(data, cont, ref);}}
void _vector_91set_67(object cont, object args) { void _vector_91set_67(void *data, object cont, object args) {
Cyc_check_num_args("vector-set!", 3, args); Cyc_check_num_args("vector-set!", 3, args);
{ object ref = Cyc_vector_set(car(args), cadr(args), caddr(args)); { object ref = Cyc_vector_set(car(args), cadr(args), caddr(args));
return_closcall1(cont, ref);}} return_closcall1(data, cont, ref);}}
void _list_91_125vector(object cont, object args) { void _list_91_125vector(void *data, object cont, object args) {
Cyc_check_num_args("list->vector", 1, args); Cyc_check_num_args("list->vector", 1, args);
Cyc_list2vector(cont, car(args));} Cyc_list2vector(data, cont, car(args));}
void _list_91_125string(object cont, object args) { void _list_91_125string(void *data, object cont, object args) {
Cyc_check_num_args("list->string", 1, args); Cyc_check_num_args("list->string", 1, args);
Cyc_list2string(cont, car(args));} Cyc_list2string(data, cont, car(args));}
void _string_91_125symbol(object cont, object args) { void _string_91_125symbol(void *data, object cont, object args) {
Cyc_check_num_args("string->symbol", 1, args); Cyc_check_num_args("string->symbol", 1, args);
return_closcall1(cont, Cyc_string2symbol(car(args)));} return_closcall1(data, cont, Cyc_string2symbol(car(args)));}
void _symbol_91_125string(object cont, object args) { void _symbol_91_125string(void *data, object cont, object args) {
Cyc_check_num_args("symbol->string", 1, args); Cyc_check_num_args("symbol->string", 1, args);
Cyc_symbol2string(cont, car(args));} Cyc_symbol2string(data, cont, car(args));}
void _number_91_125string(object cont, object args) { void _number_91_125string(void *data, object cont, object args) {
Cyc_check_num_args("number->string", 1, args); Cyc_check_num_args("number->string", 1, args);
Cyc_number2string(cont, car(args));} Cyc_number2string(data, cont, car(args));}
void _open_91input_91file(object cont, object args) { void _open_91input_91file(void *data, object cont, object args) {
Cyc_check_num_args("open-input-file", 1, args); Cyc_check_num_args("open-input-file", 1, args);
{ port_type p = Cyc_io_open_input_file(car(args)); { port_type p = Cyc_io_open_input_file(car(args));
return_closcall1(cont, &p);}} return_closcall1(data, cont, &p);}}
void _open_91output_91file(object cont, object args) { void _open_91output_91file(void *data, object cont, object args) {
Cyc_check_num_args("open-output-file", 1, args); Cyc_check_num_args("open-output-file", 1, args);
{ port_type p = Cyc_io_open_output_file(car(args)); { port_type p = Cyc_io_open_output_file(car(args));
return_closcall1(cont, &p);}} return_closcall1(data, cont, &p);}}
void _close_91port(object cont, object args) { void _close_91port(void *data, object cont, object args) {
Cyc_check_num_args("close-port", 1, args); Cyc_check_num_args("close-port", 1, args);
return_closcall1(cont, Cyc_io_close_port(car(args)));} return_closcall1(data, cont, Cyc_io_close_port(car(args)));}
void _close_91input_91port(object cont, object args) { void _close_91input_91port(void *data, object cont, object args) {
Cyc_check_num_args("close-input-port", 1, args); Cyc_check_num_args("close-input-port", 1, args);
return_closcall1(cont, Cyc_io_close_input_port(car(args)));} return_closcall1(data, cont, Cyc_io_close_input_port(car(args)));}
void _close_91output_91port(object cont, object args) { void _close_91output_91port(void *data, object cont, object args) {
Cyc_check_num_args("close-output-port", 1, args); Cyc_check_num_args("close-output-port", 1, args);
return_closcall1(cont, Cyc_io_close_output_port(car(args)));} return_closcall1(data, cont, Cyc_io_close_output_port(car(args)));}
void _Cyc_91flush_91output_91port(object cont, object args) { void _Cyc_91flush_91output_91port(void *data, object cont, object args) {
Cyc_check_num_args("Cyc-flush-output-port", 1, args); Cyc_check_num_args("Cyc-flush-output-port", 1, args);
return_closcall1(cont, Cyc_io_flush_output_port(car(args)));} return_closcall1(data, cont, Cyc_io_flush_output_port(car(args)));}
void _file_91exists_127(object cont, object args) { void _file_91exists_127(void *data, object cont, object args) {
Cyc_check_num_args("file-exists?", 1, args); Cyc_check_num_args("file-exists?", 1, args);
return_closcall1(cont, Cyc_io_file_exists(car(args)));} return_closcall1(data, cont, Cyc_io_file_exists(car(args)));}
void _delete_91file(object cont, object args) { void _delete_91file(void *data, object cont, object args) {
Cyc_check_num_args("delete-file", 1, args); Cyc_check_num_args("delete-file", 1, args);
return_closcall1(cont, Cyc_io_delete_file(car(args)));} return_closcall1(data, cont, Cyc_io_delete_file(car(args)));}
void _read_91char(object cont, object args) { void _read_91char(void *data, object cont, object args) {
Cyc_check_num_args("read-char", 1, args); Cyc_check_num_args("read-char", 1, args);
return_closcall1(cont, Cyc_io_read_char(car(args)));} return_closcall1(data, cont, Cyc_io_read_char(car(args)));}
void _peek_91char(object cont, object args) { void _peek_91char(void *data, object cont, object args) {
Cyc_check_num_args("peek-char", 1, args); Cyc_check_num_args("peek-char", 1, args);
return_closcall1(cont, Cyc_io_peek_char(car(args)));} return_closcall1(data, cont, Cyc_io_peek_char(car(args)));}
void _Cyc_91read_91line(object cont, object args) { void _Cyc_91read_91line(void *data, object cont, object args) {
Cyc_check_num_args("Cyc-read-line", 1, args); Cyc_check_num_args("Cyc-read-line", 1, args);
Cyc_io_read_line(cont, car(args));} Cyc_io_read_line(data, cont, car(args));}
void _Cyc_91write_91char(object cont, object args) { void _Cyc_91write_91char(void *data, object cont, object args) {
Cyc_check_num_args("write-char", 2, args); Cyc_check_num_args("write-char", 2, args);
return_closcall1(cont, Cyc_write_char(data, car(args), cadr(args)));} return_closcall1(data, cont, Cyc_write_char(data, car(args), cadr(args)));}
void _Cyc_91write(object cont, object args) { void _Cyc_91write(void *data, object cont, object args) {
Cyc_check_num_args("write", 1, args); Cyc_check_num_args("write", 1, args);
{ integer_type argc = Cyc_length(args); { integer_type argc = Cyc_length(args);
dispatch(argc.value, (function_type)dispatch_write_va, cont, cont, args); }} dispatch(data, argc.value, (function_type)dispatch_write_va, cont, cont, args); }}
void _display(object cont, object args) { void _display(void *data, object cont, object args) {
Cyc_check_num_args("display", 1, args); Cyc_check_num_args("display", 1, args);
{ integer_type argc = Cyc_length(args); { integer_type argc = Cyc_length(args);
dispatch(argc.value, (function_type)dispatch_display_va, cont, cont, args); }} dispatch(data, argc.value, (function_type)dispatch_display_va, cont, cont, args); }}
void _call_95cc(object cont, object args){ void _call_95cc(void *data, object cont, object args){
Cyc_check_num_args("call/cc", 1, args); Cyc_check_num_args("call/cc", 1, args);
Cyc_check_fnc(car(args)); Cyc_check_fnc(car(args));
return_closcall2(__glo_call_95cc, cont, car(args)); return_closcall2(data, __glo_call_95cc, cont, car(args));
} }
/* /*
@ -1846,14 +1844,14 @@ void _call_95cc(object cont, object args){
* @param func - Function to execute * @param func - Function to execute
* @param args - A list of arguments to the function * @param args - A list of arguments to the function
*/ */
object apply(object cont, object func, object args){ object apply(void *data, object cont, object func, object args){
common_type buf; common_type buf;
//printf("DEBUG apply: "); //printf("DEBUG apply: ");
//Cyc_display(args); //Cyc_display(args);
//printf("\n"); //printf("\n");
if (!is_object_type(func)) { if (!is_object_type(func)) {
Cyc_rt_raise2("Call of non-procedure: ", func); Cyc_rt_raise2(data, "Call of non-procedure: ", func);
} }
// Causes problems... // Causes problems...
@ -1862,7 +1860,7 @@ object apply(object cont, object func, object args){
switch(type_of(func)) { switch(type_of(func)) {
case primitive_tag: case primitive_tag:
// TODO: should probably check arg counts and error out if needed // TODO: should probably check arg counts and error out if needed
((primitive_type *)func)->fn(cont, args); ((primitive_type *)func)->fn(data, cont, args);
break; break;
case macro_tag: case macro_tag:
case closure0_tag: case closure0_tag:
@ -1871,10 +1869,10 @@ object apply(object cont, object func, object args){
case closure3_tag: case closure3_tag:
case closure4_tag: case closure4_tag:
case closureN_tag: case closureN_tag:
buf.integer_t = Cyc_length(args); buf.integer_t = Cyc_length(data, args);
// TODO: validate number of args provided: // TODO: validate number of args provided:
Cyc_check_num_args("<procedure>", ((closure)func)->num_args, args); // TODO: could be more efficient, eg: cyc_length(args) is called twice. Cyc_check_num_args("<procedure>", ((closure)func)->num_args, args); // TODO: could be more efficient, eg: cyc_length(args) is called twice.
dispatch(buf.integer_t.value, ((closure)func)->fn, func, cont, args); dispatch(data, buf.integer_t.value, ((closure)func)->fn, func, cont, args);
break; break;
case cons_tag: case cons_tag:
@ -1883,25 +1881,25 @@ object apply(object cont, object func, object args){
object fobj = car(func); object fobj = car(func);
if (!is_object_type(fobj) || type_of(fobj) != symbol_tag) { if (!is_object_type(fobj) || type_of(fobj) != symbol_tag) {
Cyc_rt_raise2("Call of non-procedure: ", func); Cyc_rt_raise2(data, "Call of non-procedure: ", func);
} else if (strncmp(((symbol)fobj)->pname, "lambda", 7) == 0) { } else if (strncmp(((symbol)fobj)->pname, "lambda", 7) == 0) {
make_cons(c, func, args); make_cons(c, func, args);
//printf("JAE DEBUG, sending to eval: "); //printf("JAE DEBUG, sending to eval: ");
//Cyc_display(&c, stderr); //Cyc_display(&c, stderr);
((closure)__glo_eval)->fn(2, __glo_eval, cont, &c, nil); ((closure)__glo_eval)->fn(data, 2, __glo_eval, cont, &c, nil);
// TODO: would be better to compare directly against symbols here, // TODO: would be better to compare directly against symbols here,
// but need a way of looking them up ahead of time. // but need a way of looking them up ahead of time.
// maybe a libinit() or such is required. // maybe a libinit() or such is required.
} else if (strncmp(((symbol)fobj)->pname, "primitive", 10) == 0) { } else if (strncmp(((symbol)fobj)->pname, "primitive", 10) == 0) {
make_cons(c, cadr(func), args); make_cons(c, cadr(func), args);
((closure)__glo_eval)->fn(3, __glo_eval, cont, &c, nil); ((closure)__glo_eval)->fn(data, 3, __glo_eval, cont, &c, nil);
} else if (strncmp(((symbol)fobj)->pname, "procedure", 10) == 0) { } else if (strncmp(((symbol)fobj)->pname, "procedure", 10) == 0) {
make_cons(c, func, args); make_cons(c, func, args);
((closure)__glo_eval)->fn(3, __glo_eval, cont, &c, nil); ((closure)__glo_eval)->fn(data, 3, __glo_eval, cont, &c, nil);
} else { } else {
make_cons(c, func, args); make_cons(c, func, args);
Cyc_rt_raise2("Unable to evaluate: ", &c); Cyc_rt_raise2(data, "Unable to evaluate: ", &c);
} }
} }
@ -1913,7 +1911,7 @@ object apply(object cont, object func, object args){
} }
// Version of apply meant to be called from within compiled code // Version of apply meant to be called from within compiled code
void Cyc_apply(int argc, closure cont, object prim, ...){ void Cyc_apply(void *data, int argc, closure cont, object prim, ...){
va_list ap; va_list ap;
object tmp; object tmp;
int i; int i;
@ -1933,12 +1931,12 @@ void Cyc_apply(int argc, closure cont, object prim, ...){
//printf("\n"); //printf("\n");
va_end(ap); va_end(ap);
apply(cont, prim, (object)&args[0]); apply(data, cont, prim, (object)&args[0]);
} }
// END apply // END apply
/* Extract args from given array, assuming cont is the first arg in buf */ /* Extract args from given array, assuming cont is the first arg in buf */
void Cyc_apply_from_buf(int argc, object prim, object *buf) { void Cyc_apply_from_buf(data, int argc, object prim, object *buf) {
list args; list args;
object cont; object cont;
int i; int i;
@ -1958,7 +1956,7 @@ void Cyc_apply_from_buf(int argc, object prim, object *buf) {
args[i - 1].cons_cdr = (i == (argc-1)) ? nil : &args[i]; args[i - 1].cons_cdr = (i == (argc-1)) ? nil : &args[i];
} }
apply(cont, prim, (object)&args[0]); apply(data, cont, prim, (object)&args[0]);
} }
///** ///**
@ -2744,9 +2742,10 @@ void GC(cont, args, num_args) closure cont; object *args; int num_args;
} }
//fprintf(stdout, "DEBUG, finished minor GC\n"); // JAE DEBUG //fprintf(stdout, "DEBUG, finished minor GC\n"); // JAE DEBUG
longjmp(jmp_main,1); // Return globals gc_cont, gc_ans longjmp(jmp_main, &data); // Return globals gc_cont, gc_ans
} }
/* Overall GC notes: /* Overall GC notes:
note fwd pointers are only ever placed on the stack, never the heap note fwd pointers are only ever placed on the stack, never the heap
@ -2838,7 +2837,7 @@ to handle this detail yet. and it is very important to get right
/** /**
* Receive a list of arguments and apply them to the given function * Receive a list of arguments and apply them to the given function
*/ */
void dispatch(int argc, function_type func, object clo, object cont, object args) { void dispatch(void *data, int argc, function_type func, object clo, object cont, object args) {
object b[argc + 1]; // OK to do this? Is this portable? object b[argc + 1]; // OK to do this? Is this portable?
int i; int i;
@ -2849,13 +2848,13 @@ void dispatch(int argc, function_type func, object clo, object cont, object args
args = cdr(args); args = cdr(args);
} }
do_dispatch(argc, func, clo, b); do_dispatch(data, argc, func, clo, b);
} }
/** /**
* Same as above but for a varargs C function * Same as above but for a varargs C function
*/ */
void dispatch_va(int argc, function_type_va func, object clo, object cont, object args) { void dispatch_va(void *data, int argc, function_type_va func, object clo, object cont, object args) {
object b[argc + 1]; // OK to do this? Is this portable? object b[argc + 1]; // OK to do this? Is this portable?
int i; int i;
@ -2866,7 +2865,7 @@ void dispatch_va(int argc, function_type_va func, object clo, object cont, objec
args = cdr(args); args = cdr(args);
} }
do_dispatch(argc, (function_type)func, clo, b); do_dispatch(data, argc, (function_type)func, clo, b);
} }
static primitive_type Cyc_91global_91vars_primitive = {{0}, primitive_tag, "Cyc-global-vars", &_Cyc_91global_91vars}; static primitive_type Cyc_91global_91vars_primitive = {{0}, primitive_tag, "Cyc-global-vars", &_Cyc_91global_91vars};