diff --git a/TODO b/TODO index f5c12c20..f2e68168 100644 --- a/TODO +++ b/TODO @@ -1,7 +1,7 @@ Roadmap: - Add macro support (instead of current kludge) - Target r7rs support (coordinate with feature list) - - User manual (or at least API docs) + - User manual (or at least API docs, features page may be a good 1st step) Working TODO list. should start creating issues for these to get them out of here: @@ -12,14 +12,14 @@ Working TODO list. should start creating issues for these to get them out of her is what we have now robust enough to prevent segfaults? - type checking - ideally want to do this in a way that minimizes performance impacts. - will probaby require extensive checks within apply() though, since that - all happens at runtime. - - without these, it will be impossible (or at least time-consuming) to debug issues going forward + done for now, check performance compiling transforms.sld 2) Need to either allow code to read an import after macro expansion, or have another main module for self-hosting + - what's going on here: + cyclone> (call/cc (lambda (k) (k 1))) + Error: Expected 2 arguments but received 1. + - Documentation improvements - create a getting started page to go into more detail (build section could move to a that page, could go over build options, rlwrap, etc) - create a 'how this was built' page to go into more detail about which references were used where diff --git a/include/cyclone/runtime.h b/include/cyclone/runtime.h index 2cf50744..94cdf024 100644 --- a/include/cyclone/runtime.h +++ b/include/cyclone/runtime.h @@ -181,8 +181,11 @@ 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); \ + char *str; \ + int len; \ + Cyc_check_str(s); \ + str = ((string_type *)s)->str; \ + len = strlen(str); \ cons_type *buf; \ if (len > 0) { \ buf = alloca(sizeof(cons_type) * len); \ @@ -192,7 +195,9 @@ void do_dispatch(int argc, function_type func, object clo, object *buffer); } #define list2vector(v, l) object v = nil; { \ - integer_type len = Cyc_length(l); \ + integer_type len; \ + Cyc_check_cons_or_nil(l); \ + len = Cyc_length(l); \ v = alloca(sizeof(vector_type)); \ ((vector)v)->tag = vector_tag; \ ((vector)v)->num_elt = len.value; \ @@ -206,6 +211,7 @@ void do_dispatch(int argc, function_type func, object clo, object *buffer); } #define make_vector(v, len, fill) object v = nil; { \ + Cyc_check_int(len); \ v = alloca(sizeof(vector_type)); \ ((vector)v)->tag = vector_tag; \ ((vector)v)->num_elt = ((integer_type *)len)->value; \ diff --git a/runtime.c b/runtime.c index 2cf384a0..15c428ab 100644 --- a/runtime.c +++ b/runtime.c @@ -9,17 +9,18 @@ #include "cyclone/types.h" #include "cyclone/runtime.h" +/* Error checking section - type mismatch, num args, etc */ /* Type names to use for error messages */ const char *tag_names[20] = { \ "pair" \ , "symbol" \ , "" \ - , "closure" \ - , "closure" \ - , "closure" \ - , "closure" \ - , "closure" \ - , "closure" \ + , "procedure" \ + , "procedure" \ + , "procedure" \ + , "procedure" \ + , "procedure" \ + , "procedure" \ , "number" \ , "number" \ , "string" \ @@ -50,6 +51,10 @@ const char *tag_names[20] = { \ #define Cyc_check_num(obj) Cyc_check_type(Cyc_is_number, integer_tag, obj); #define Cyc_check_int(obj) Cyc_check_type(Cyc_is_integer, integer_tag, obj); #define Cyc_check_str(obj) Cyc_check_type(Cyc_is_string, string_tag, obj); +#define Cyc_check_sym(obj) Cyc_check_type(Cyc_is_symbol, symbol_tag, obj); +#define Cyc_check_vec(obj) Cyc_check_type(Cyc_is_vector, vector_tag, obj); +#define Cyc_check_port(obj) Cyc_check_type(Cyc_is_port, port_tag, obj); +#define Cyc_check_fnc(obj) Cyc_check_type(Cyc_is_procedure, closure2_tag, obj); void Cyc_invalid_type_error(int tag, object found) { char buf[256]; @@ -63,6 +68,16 @@ void Cyc_check_obj(int tag, object obj) { } } +void Cyc_check_bounds(const char *label, int len, int index) { + if (index < 0 || index >= len) { + char buf[128]; + snprintf(buf, 127, "%s - invalid index %d", label, index); + Cyc_rt_raise_msg(buf); + } +} + +/* END error checking */ + /* Funcall section, these are hardcoded here to support functions in this module. */ #define funcall1(cfn,a1) if (type_of(cfn) == cons_tag || prim(cfn)) { Cyc_apply(0, (closure)a1, cfn); } else { ((cfn)->fn)(1,cfn,a1);} @@ -783,8 +798,15 @@ object Cyc_set_cdr(object l, object val) { } object Cyc_vector_set(object v, object k, object obj) { - // TODO: bounds checking? do eventually need to figure out where that should go - int idx = ((integer_type *)k)->value; + int idx; + Cyc_check_vec(v); + Cyc_check_int(k); + idx = ((integer_type *)k)->value; + + if (idx < 0 || idx >= ((vector)v)->num_elt) { + Cyc_rt_raise2("vector-set! - invalid index", k); + } + ((vector)v)->elts[idx] = obj; // TODO: probably could be more efficient here and also pass // index, so only that one entry needs GC. @@ -793,14 +815,17 @@ object Cyc_vector_set(object v, object k, object obj) { } object Cyc_vector_ref(object v, object k) { - if (nullp(v) || is_value_type(v) || ((list)v)->tag != vector_tag) { - Cyc_rt_raise_msg("vector-ref - invalid parameter, expected vector\n"); - } - if (nullp(k) || is_value_type(k) || ((list)k)->tag != integer_tag) { - Cyc_rt_raise_msg("vector-ref - invalid parameter, expected integer\n"); - } + if (nullp(v) || is_value_type(v) || ((list)v)->tag != vector_tag) { + Cyc_rt_raise_msg("vector-ref - invalid parameter, expected vector\n"); + } + if (nullp(k) || is_value_type(k) || ((list)k)->tag != integer_tag) { + Cyc_rt_raise_msg("vector-ref - invalid parameter, expected integer\n"); + } + if (integer_value(k) < 0 || integer_value(k) >= ((vector)v)->num_elt) { + Cyc_rt_raise2("vector-ref - invalid index", k); + } - return ((vector)v)->elts[((integer_type *)k)->value]; + return ((vector)v)->elts[((integer_type *)k)->value]; } integer_type Cyc_vector_length(object v) { @@ -824,24 +849,27 @@ integer_type Cyc_length(object l){ string_type Cyc_number2string(object n) { char buffer[1024]; + Cyc_check_num(n); if (type_of(n) == integer_tag) { snprintf(buffer, 1024, "%d", ((integer_type *)n)->value); } else if (type_of(n) == double_tag) { snprintf(buffer, 1024, "%lf", ((double_type *)n)->value); } else { - buffer[0] = '\0'; // TODO: throw error instead + Cyc_rt_raise2("number->string - Unexpected object", n); } make_string(str, buffer); return str; } string_type Cyc_symbol2string(object sym) { - make_string(str, symbol_pname(sym)); - return str; -} + Cyc_check_sym(sym); + { make_string(str, symbol_pname(sym)); + return str; }} object Cyc_string2symbol(object str) { - object sym = find_symbol_by_name(symbol_pname(str)); + object sym; + Cyc_check_str(str); + sym = find_symbol_by_name(symbol_pname(str)); if (!sym) { sym = add_symbol_by_name(symbol_pname(str)); } @@ -851,9 +879,12 @@ object Cyc_string2symbol(object str) { string_type Cyc_list2string(object lst){ char *buf; int i = 0; - integer_type len = Cyc_length(lst); // Inefficient, walks whole list - buf = alloca(sizeof(char) * (len.value + 1)); + integer_type len; + Cyc_check_cons_or_nil(lst); + + len = Cyc_length(lst); // Inefficient, walks whole list + buf = alloca(sizeof(char) * (len.value + 1)); while(!nullp(lst)){ buf[i++] = obj_obj2char(car(lst)); lst = cdr(lst); @@ -900,10 +931,13 @@ common_type Cyc_string2number(object str){ } integer_type Cyc_string_cmp(object str1, object str2) { - // TODO: check types of str1, str2 - make_int(cmp, strcmp(((string_type *)str1)->str, - ((string_type *)str2)->str)); - return cmp; + Cyc_check_str(str1); + Cyc_check_str(str2); + { + make_int(cmp, strcmp(((string_type *)str1)->str, + ((string_type *)str2)->str)); + return cmp; + } } void dispatch_string_91append(int argc, object clo, object cont, object str1, ...) { @@ -937,16 +971,18 @@ string_type Cyc_string_append_va_list(int argc, object str1, va_list ap) { object tmp; if (argc > 0) { + Cyc_check_str(str1); str[i] = ((string_type *)str1)->str; len[i] = strlen(str[i]); total_len += len[i]; } for (i = 1; i < argc; i++) { - tmp = va_arg(ap, object); - str[i] = ((string_type *)tmp)->str; - len[i] = strlen(str[i]); - total_len += len[i]; + tmp = va_arg(ap, object); + Cyc_check_str(tmp); + str[i] = ((string_type *)tmp)->str; + len[i] = strlen(str[i]); + total_len += len[i]; } buffer = bufferp = alloca(sizeof(char) * total_len); @@ -966,9 +1002,15 @@ integer_type Cyc_string_length(object str) { return len; }} object Cyc_string_ref(object str, object k) { - const char *raw = string_str(str); - int idx = integer_value(k), - len = strlen(raw); + const char *raw; + int idx, len; + + Cyc_check_str(str); + Cyc_check_int(k); + + raw = string_str(str); + idx = integer_value(k), + len = strlen(raw); if (idx < 0 || idx >= len) { Cyc_rt_raise2("string-ref - invalid index", k); @@ -978,10 +1020,17 @@ object Cyc_string_ref(object str, object k) { } string_type Cyc_substring(object str, object start, object end) { - const char *raw = string_str(str); - int s = integer_value(start), - e = integer_value(end), - len = strlen(raw); + const char *raw; + int s, e, len; + + Cyc_check_str(str); + Cyc_check_int(start); + Cyc_check_int(end); + + raw = string_str(str); + s = integer_value(start), + e = integer_value(end), + len = strlen(raw); if (s > e) { Cyc_rt_raise2("substring - start cannot be greater than end", start); @@ -1206,7 +1255,9 @@ port_type Cyc_stderr() { } port_type Cyc_io_open_input_file(object str) { - const char *fname = ((string_type *)str)->str; + const char *fname; + Cyc_check_str(str); + fname = ((string_type *)str)->str; make_port(p, NULL, 1); p.fp = fopen(fname, "r"); if (p.fp == NULL) { Cyc_rt_raise2("Unable to open file", str); } @@ -1214,7 +1265,9 @@ port_type Cyc_io_open_input_file(object str) { } port_type Cyc_io_open_output_file(object str) { - const char *fname = ((string_type *)str)->str; + const char *fname; + Cyc_check_str(str); + fname = ((string_type *)str)->str; make_port(p, NULL, 0); p.fp = fopen(fname, "w"); if (p.fp == NULL) { Cyc_rt_raise2("Unable to open file", str); } @@ -1228,7 +1281,8 @@ object Cyc_io_close_output_port(object port) { return Cyc_io_close_port(port); } object Cyc_io_close_port(object port) { - if (port && type_of(port) == port_tag) { + Cyc_check_port(port); + { FILE *stream = ((port_type *)port)->fp; if (stream) fclose(stream); ((port_type *)port)->fp = NULL; @@ -1237,14 +1291,18 @@ object Cyc_io_close_port(object port) { } object Cyc_io_delete_file(object filename) { - const char *fname = ((string_type *)filename)->str; + const char *fname; + Cyc_check_str(filename); + fname = ((string_type *)filename)->str; if (remove(fname) == 0) return boolean_t; // Success return boolean_f; } object Cyc_io_file_exists(object filename) { - const char *fname = ((string_type *)filename)->str; + const char *fname; + Cyc_check_str(filename); + fname = ((string_type *)filename)->str; FILE *file; // Possibly overkill, but portable if (file = fopen(fname, "r")) { @@ -1256,7 +1314,8 @@ object Cyc_io_file_exists(object filename) { // TODO: port arg is optional! (maybe handle that in expansion section??) object Cyc_io_read_char(object port) { - if (type_of(port) == port_tag) { + Cyc_check_port(port); + { int c = fgetc(((port_type *) port)->fp); if (c != EOF) { return obj_char2obj(c); @@ -1269,7 +1328,8 @@ object Cyc_io_peek_char(object port) { FILE *stream; int c; - if (type_of(port) == port_tag) { + Cyc_check_port(port); + { stream = ((port_type *) port)->fp; c = fgetc(stream); ungetc(c, stream); @@ -1693,6 +1753,7 @@ void _display(object cont, object args) { dispatch(argc.value, (function_type)dispatch_display_va, cont, cont, args); }} void _call_95cc(object cont, object args){ Cyc_check_num_args("call/cc", 1, args); + Cyc_check_fnc(car(args)); return_funcall2(__glo_call_95cc, cont, car(args)); }