From 98fc7fa6420be7faae2dfaff2c1b157c22da39ae Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Tue, 14 Apr 2015 13:52:14 -0400 Subject: [PATCH] Added varargs sum, but working through issues with segfaults --- cgen.scm | 4 ++-- runtime.h | 55 ++++++++++++++++++++++++++++++++++++++++++++----------- test.scm | 4 ++++ 3 files changed, 50 insertions(+), 13 deletions(-) diff --git a/cgen.scm b/cgen.scm index 2561e59c..046de06c 100644 --- a/cgen.scm +++ b/cgen.scm @@ -402,7 +402,7 @@ ((eq? p 'Cyc-set-cvar!) "Cyc_set_cvar") ((eq? p 'Cyc-cvar?) "Cyc_is_cvar") ((eq? p 'Cyc-has-cycle?) "Cyc_has_cycle") - ((eq? p '+) "Cyc_sum") + ((eq? p '+) "Cyc_sum_va") ((eq? p '-) "__sub") ((eq? p '*) "__mul") ((eq? p '/) "__div") @@ -522,7 +522,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 d1e9fda5..b3cf85be 100644 --- a/runtime.h +++ b/runtime.h @@ -96,8 +96,8 @@ 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(object x, object y); -//static common_type Cyc_sum_va(int argc, object n, ...); -//static common_type Cyc_sum_va_list(int argc, object n, va_list ns); +static common_type Cyc_sum_va(int argc, object n, ...); +static common_type Cyc_sum_va_list(int argc, object n, va_list ns); static int equal(object,object); static list assq(object,list); static object get(object,object); @@ -810,8 +810,7 @@ static object __halt(object obj) { #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); -/* Brainstorming how this could work */ -static common_type Cyc_sum(object x, object y) { // TODO: varargs +static common_type Cyc_sum(object x, object y) { common_type s; int tx = type_of(x), ty = type_of(y); s.double_t.tag = double_tag; @@ -826,14 +825,14 @@ static common_type Cyc_sum(object x, object y) { // TODO: varargs s.double_t.value = ((double_type *)x)->value + ((double_type *)y)->value; } else { // TODO: error + printf("TODO: invalid tag in Cyc_sum\n"); + exit(1); } return s; } -/* + static common_type Cyc_sum_va_list(int argc, object n, va_list ns) { - common_type acc; common_type sum; - object tmp; int i; if (argc == 0) { sum.integer_t.tag = integer_tag; @@ -844,16 +843,31 @@ static common_type Cyc_sum_va_list(int argc, object n, va_list ns) { if (type_of(n) == integer_tag) { sum.integer_t.tag = integer_tag; sum.integer_t.value = ((integer_type *)n)->value; - } else { + } else if (type_of(n) == double_tag) { sum.double_t.tag = double_tag; sum.double_t.value = ((double_type *)n)->value; + } else { + printf("Invalid tag in n\n"); + exit(1); } for (i = 1; i < argc; i++) { - tmp = va_arg(ns, object); - sum = Cyc_sum(&sum, tmp); + common_type result = Cyc_sum(&sum, va_arg(ns, object)); + if (type_of(&result) == integer_tag) { + sum.integer_t.tag = integer_tag; + sum.integer_t.value = ((integer_type *) &result)->value; + } else if (type_of(&result) == double_tag) { + sum.double_t.tag = double_tag; + sum.double_t.value = ((double_type *) &result)->value; + } else { + printf("Invalid tag in Cyc_sum_va_list\n"); + exit(1); + } } + printf("sum = "); + Cyc_display(&sum); + printf("\n"); return sum; } @@ -862,9 +876,23 @@ static common_type Cyc_sum_va(int argc, object n, ...) { va_start(ap, n); common_type result = Cyc_sum_va_list(argc, n, ap); va_end(ap); + printf("cyc_sum_va, argc = %d\n", argc); return result; } -*/ + +// TODO: (+ 1 2 3 4 1 34 2 5 2 -2 2 -10) +static void dispatch_sum(int argc, object clo, object cont, object n, ...) { + va_list ap; + va_start(ap, n); + common_type result = Cyc_sum_va_list(argc - 1, n, ap); + va_end(ap); + + printf("argc = %d, sum result = ", argc); + Cyc_display(&result); + printf("\n"); + return_funcall1(cont, &result); +} + /* I/O functions */ @@ -1000,6 +1028,8 @@ static void _Cyc_91has_91cycle_127(object cont, object args) { static void __87(object cont, object args) { common_type n = Cyc_sum(car(args), cadr(args)); return_funcall1(cont, &n); } +// 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); } @@ -1701,6 +1731,9 @@ static void main_main (stack_size,heap_size,stack_base) /* Tank, load the jump program... */ setjmp(jmp_main); +#if DEBUG_GC + printf("Done with GC\n"); +#endif do_dispatch(gc_num_ans, ((closure)gc_cont)->fn, gc_cont, gc_ans); /* */ diff --git a/test.scm b/test.scm index 7e16791f..ce6998ac 100644 --- a/test.scm +++ b/test.scm @@ -6,7 +6,11 @@ ; 1) ;((lambda (x y z) (+ x y)) 1 2 3) +(define x 1) +(define y 2) +(write (+ x y 3.3)) ((lambda () (+ 1 2))) +(+ x 2 3 4 1 34 2 5 2 -2 2 -10) ;;; Temporary testing, delete this once it works ; Need to rewrite the code to use this, and preserve the global def