diff --git a/TODO b/TODO index 82882b02..47e9c11d 100644 --- a/TODO +++ b/TODO @@ -1,17 +1,6 @@ Working TODO list: - - Fixup Cyc_sum to use varargs and call (error) if anything bad happens. then generalize to - * / - can we pass the actual arg(s) to the error function? - - - need an error() function that will call (error) from the C runtime - useful for, EG, type checking - - notes: - can assume presence of *exception-handler-stack* global, at least for now - move Cyc-current-exception-handler to a runtime function, then can - (I think) rewrite raise to be one as well. Then should be able to call - into a common exception function in runtime that will in turn just - call raise (or just call it directly) + - Cyc_sum, etc: can we pass the actual arg(s) to the error function? - make *trace-level* a command-line parameter, and by default do not emit scheme code transformations in comments - Reduction in size of generated code diff --git a/cgen.scm b/cgen.scm index df21a91e..74e9ba4f 100644 --- a/cgen.scm +++ b/cgen.scm @@ -403,9 +403,9 @@ ((eq? p 'Cyc-cvar?) "Cyc_is_cvar") ((eq? p 'Cyc-has-cycle?) "Cyc_has_cycle") ((eq? p '+) "Cyc_sum") - ((eq? p '-) "__sub") - ((eq? p '*) "__mul") - ((eq? p '/) "__div") + ((eq? p '-) "Cyc_sub") + ((eq? p '*) "Cyc_mul") + ((eq? p '/) "Cyc_div") ((eq? p '=) "__num_eq") ((eq? p '>) "__num_gt") ((eq? p '<) "__num_lt") @@ -502,6 +502,9 @@ ((eq? p 'length) "integer_type") ((eq? p 'char->integer) "integer_type") ((eq? p '+) "common_type") + ((eq? p '-) "common_type") + ((eq? p '*) "common_type") + ((eq? p '/) "common_type") ((eq? p 'string->number) "common_type") ((eq? p 'list->string) "string_type") ; ((eq? p 'string->list) "object") @@ -523,7 +526,7 @@ ;; Pass an integer arg count as the function's first parameter? (define (prim:arg-count? exp) (and (prim? exp) - (member exp '(error string-append +)))) + (member exp '(error string-append + - * /)))) ;; Does primitive allocate an object? (define (prim:allocates-object? exp) diff --git a/runtime.h b/runtime.h index 2571a86d..8eb39498 100644 --- a/runtime.h +++ b/runtime.h @@ -96,6 +96,9 @@ static object Cyc_is_procedure(object o); static object Cyc_is_eof_object(object o); static object Cyc_is_cvar(object o); static common_type Cyc_sum_op(object x, object y); +static common_type Cyc_sub_op(object x, object y); +static common_type Cyc_mul_op(object x, object y); +static common_type Cyc_div_op(object x, object y); static common_type Cyc_sum(int argc, object n, ...); static common_type Cyc_num_op_va_list(int argc, common_type (fn_op(object, object)), object n, va_list ns); static int equal(object,object); @@ -778,29 +781,47 @@ static object __halt(object obj) { return nil; } -#define __mul(c,x,y) integer_type c; c.tag = integer_tag; c.value = (((integer_type *)(x))->value * ((integer_type *)(y))->value); -#define __sub(c,x,y) integer_type c; c.tag = integer_tag; c.value = (((integer_type *)(x))->value - ((integer_type *)(y))->value); -#define __div(c,x,y) integer_type c; c.tag = integer_tag; c.value = (((integer_type *)(x))->value / ((integer_type *)(y))->value); - -static common_type Cyc_sum_op(object x, object y) { - common_type s; - int tx = type_of(x), ty = type_of(y); - s.double_t.tag = double_tag; - if (tx == integer_tag && ty == integer_tag) { - s.integer_t.tag = integer_tag; - s.integer_t.value = ((integer_type *)x)->value + ((integer_type *)y)->value; - } else if (tx == double_tag && ty == integer_tag) { - s.double_t.value = ((double_type *)x)->value + ((integer_type *)y)->value; - } else if (tx == integer_tag && ty == double_tag) { - s.double_t.value = ((integer_type *)x)->value + ((double_type *)y)->value; - } else if (tx == double_tag && ty == double_tag) { - s.double_t.value = ((double_type *)x)->value + ((double_type *)y)->value; - } else { - Cyc_rt_raise_msg("Bad argument type\n"); - } - return s; +#define declare_num_op(FUNC, FUNC_OP, FUNC_APPLY, OP) \ +static common_type FUNC_OP(object x, object y) { \ + common_type s; \ + int tx = type_of(x), ty = type_of(y); \ + s.double_t.tag = double_tag; \ + if (tx == integer_tag && ty == integer_tag) { \ + s.integer_t.tag = integer_tag; \ + s.integer_t.value = ((integer_type *)x)->value OP ((integer_type *)y)->value; \ + } else if (tx == double_tag && ty == integer_tag) { \ + s.double_t.value = ((double_type *)x)->value OP ((integer_type *)y)->value; \ + } else if (tx == integer_tag && ty == double_tag) { \ + s.double_t.value = ((integer_type *)x)->value OP ((double_type *)y)->value; \ + } else if (tx == double_tag && ty == double_tag) { \ + s.double_t.value = ((double_type *)x)->value OP ((double_type *)y)->value; \ + } else { \ + Cyc_rt_raise_msg("Bad argument type\n"); \ + } \ + return s; \ +} \ +static common_type FUNC(int argc, object n, ...) { \ + va_list ap; \ + va_start(ap, n); \ + common_type result = Cyc_num_op_va_list(argc, FUNC_OP, n, ap); \ + va_end(ap); \ + return result; \ +} \ +static void FUNC_APPLY(int argc, object clo, object cont, object n, ...) { \ + va_list ap; \ + va_start(ap, n); \ + common_type result = Cyc_num_op_va_list(argc - 1, FUNC_OP, n, ap); \ + va_end(ap); \ + return_funcall1(cont, &result); \ } +declare_num_op(Cyc_sum, Cyc_sum_op, dispatch_sum, +); +declare_num_op(Cyc_sub, Cyc_sub_op, dispatch_sub, -); +declare_num_op(Cyc_mul, Cyc_mul_op, dispatch_mul, *); +// TODO: what about divide-by-zero, and casting to double when +// result contains a decimal component? +declare_num_op(Cyc_div, Cyc_div_op, dispatch_div, /); + static common_type Cyc_num_op_va_list(int argc, common_type (fn_op(object, object)), object n, va_list ns) { common_type sum; int i; @@ -836,23 +857,6 @@ static common_type Cyc_num_op_va_list(int argc, common_type (fn_op(object, objec return sum; } -static common_type Cyc_sum(int argc, object n, ...) { - va_list ap; - va_start(ap, n); - common_type result = Cyc_num_op_va_list(argc, Cyc_sum_op, n, ap); - va_end(ap); - return result; -} - -static void dispatch_sum(int argc, object clo, object cont, object n, ...) { - va_list ap; - va_start(ap, n); - common_type result = Cyc_num_op_va_list(argc - 1, Cyc_sum_op, n, ap); - va_end(ap); - return_funcall1(cont, &result); -} - - /* I/O functions */ static port_type Cyc_io_current_input_port() { @@ -985,21 +989,17 @@ static void _set_91cdr_67(object cont, object args) { static void _Cyc_91has_91cycle_127(object cont, object args) { return_funcall1(cont, Cyc_has_cycle(car(args))); } static void __87(object cont, object args) { -// common_type n = Cyc_sum(car(args), cadr(args)); -// return_funcall1(cont, &n); } -// TODO: re-enable this to get varargs sum in eval: integer_type argc = Cyc_length(args); dispatch(argc.value, (function_type)dispatch_sum, cont, cont, args); } static void __91(object cont, object args) { - __sub(i, car(args), cadr(args)); - return_funcall1(cont, &i); } + integer_type argc = Cyc_length(args); + dispatch(argc.value, (function_type)dispatch_sub, cont, cont, args); } static void __85(object cont, object args) { - __mul(i, car(args), cadr(args)); - return_funcall1(cont, &i); } + integer_type argc = Cyc_length(args); + dispatch(argc.value, (function_type)dispatch_mul, cont, cont, args); } static void __95(object cont, object args) { - // TODO: check for div by 0 - __div(i, car(args), cadr(args)); - return_funcall1(cont, &i); } + integer_type argc = Cyc_length(args); + dispatch(argc.value, (function_type)dispatch_div, cont, cont, args); } static void _Cyc_91cvar_127(object cont, object args) { return_funcall1(cont, Cyc_is_cvar(car(args))); } static void _boolean_127(object cont, object args) {