diff --git a/gc-notes.txt b/gc-notes.txt index b2a36193..b94def8c 100644 --- a/gc-notes.txt +++ b/gc-notes.txt @@ -1,3 +1,29 @@ Phase 1 (gc-dev) - Add gc.h, make sure it compiles. Phase 2 (gc-dev2) - Change how strings are allocated, to clean up the code and be compatible with a new GC algorithm. Phase 3 (gc-dev3) - Change from using a Cheney-style copying collector to a naive mark&sweep algorithm. + + +Notes for adding new thread data param +- primitives that will now need to accept the param: + ((eq? p 'Cyc-write-char) "Cyc_write_char") + Cyc_vector_set + Cyc_vector_ref + Cyc_vector_length(void *data, object v) { + Cyc_length + Cyc_number2string(void *data, object cont, object n) { +object Cyc_symbol2string(object cont, object sym) { +object Cyc_list2string(void *data, object cont, object lst){ +#define Cyc_string_append_va_list(data, argc) { \ +object Cyc_string_set(object str, object k, object chr) { +object Cyc_string_ref(void *data, object str, object k) { +object Cyc_substring(void *data, object cont, object str, object start, object end) { +object Cyc_installation_dir(object cont, object type) { +object Cyc_command_line_arguments(object cont) { +object Cyc_make_vector(object cont, object len, object fill) { +object Cyc_list2vector(void *data, object cont, object l) { + +- plan: + - update runtime, get it to compile + - update any associated tools (dispatch.c, etc) + - update cgen + - integration diff --git a/runtime.c b/runtime.c index 89b71148..de7e5b0f 100644 --- a/runtime.c +++ b/runtime.c @@ -60,22 +60,22 @@ void Cyc_check_bounds(const char *label, int len, int index) { /* END error checking */ /* These macros are hardcoded here to support functions in this module. */ -#define closcall1(cfn,a1) if (type_of(cfn) == cons_tag || prim(cfn)) { Cyc_apply(0, (closure)a1, cfn); } else { ((cfn)->fn)(1,cfn,a1);} +#define closcall1(td,cfn,a1) if (type_of(cfn) == cons_tag || prim(cfn)) { Cyc_apply(td,0, (closure)a1, cfn); } else { ((cfn)->fn)(td,1,cfn,a1);} /* Return to continuation after checking for stack overflow. */ -#define return_closcall1(cfn,a1) \ +#define return_closcall1(td,cfn,a1) \ {char stack; \ if (check_overflow(&stack,stack_limit1)) { \ object buf[1]; buf[0] = a1;\ - GC(cfn,buf,1); return; \ - } else {closcall1((closure) (cfn),a1); return;}} -#define closcall2(cfn,a1,a2) if (type_of(cfn) == cons_tag || prim(cfn)) { Cyc_apply(1, (closure)a1, cfn,a2); } else { ((cfn)->fn)(2,cfn,a1,a2);} + GC(td,cfn,buf,1); return; \ + } else {closcall1(td,(closure) (cfn),a1); return;}} +#define closcall2(td,cfn,a1,a2) if (type_of(cfn) == cons_tag || prim(cfn)) { Cyc_apply(td,1, (closure)a1, cfn,a2); } else { ((cfn)->fn)(td,2,cfn,a1,a2);} /* Return to continuation after checking for stack overflow. */ -#define return_closcall2(cfn,a1,a2) \ +#define return_closcall2(td,cfn,a1,a2) \ {char stack; \ if (check_overflow(&stack,stack_limit1)) { \ object buf[2]; buf[0] = a1;buf[1] = a2;\ - GC(cfn,buf,2); return; \ - } else {closcall2((closure) (cfn),a1,a2); return;}} + GC(td,cfn,buf,2); return; \ + } else {closcall2(td,(closure) (cfn),a1,a2); return;}} /*END closcall section */ /* Global variables. */ @@ -251,7 +251,7 @@ object Cyc_glo_eval = nil; /* Exception handler */ object Cyc_exception_handler_stack = nil; -object Cyc_default_exception_handler(int argc, closure _, object err) { +object Cyc_default_exception_handler(void *data, int argc, closure _, object err) { fprintf(stderr, "Error: "); if (nullp(err) || is_value_type(err) || type_of(err) != cons_tag) { @@ -281,29 +281,29 @@ object Cyc_current_exception_handler() { } /* Raise an exception from the runtime code */ -void Cyc_rt_raise(object err) { +void Cyc_rt_raise(void *data, object err) { make_cons(c2, err, nil); make_cons(c1, boolean_f, &c2); make_cons(c0, &c1, nil); - apply(nil, Cyc_current_exception_handler(), &c0); + apply(data, nil, Cyc_current_exception_handler(), &c0); // Should never get here fprintf(stderr, "Internal error in Cyc_rt_raise\n"); exit(1); } -void Cyc_rt_raise2(const char *msg, object err) { +void Cyc_rt_raise2(void *data, const char *msg, object err) { make_string(s, msg); make_cons(c3, err, nil); make_cons(c2, &s, &c3); make_cons(c1, boolean_f, &c2); make_cons(c0, &c1, nil); - apply(nil, Cyc_current_exception_handler(), &c0); + apply(data, nil, Cyc_current_exception_handler(), &c0); // Should never get here fprintf(stderr, "Internal error in Cyc_rt_raise2\n"); exit(1); } -void Cyc_rt_raise_msg(const char *err) { +void Cyc_rt_raise_msg(void *data, const char *err) { make_string(s, err); - Cyc_rt_raise(&s); + Cyc_rt_raise(data, &s); } /* END exception handler */ @@ -389,13 +389,13 @@ object Cyc_has_cycle(object lst) { // to the value returned by (current-output-port). It is an // error to attempt an output operation on a closed port // -object dispatch_display_va(int argc, object clo, object cont, object x, ...) { +object dispatch_display_va(void *data, int argc, object clo, object cont, object x, ...) { object result; va_list ap; va_start(ap, x); result = Cyc_display_va_list(argc - 1, x, ap); va_end(ap); - return_closcall1(cont, result); + return_closcall1(data, cont, result); } object Cyc_display_va(int argc, object x, ...) { @@ -506,13 +506,13 @@ object Cyc_display(object x, FILE *port) fprintf(port, "Cyc_display: bad tag x=%ld\n", ((closure)x)->tag); getchar(); exit(0);} return quote_void;} -object dispatch_write_va(int argc, object clo, object cont, object x, ...) { +object dispatch_write_va(void *data, int argc, object clo, object cont, object x, ...) { object result; va_list ap; va_start(ap, x); result = Cyc_write_va_list(argc - 1, x, ap); va_end(ap); - return_closcall1(cont, result); + return_closcall1(data, cont, result); } object Cyc_write_va(int argc, object x, ...) { @@ -585,7 +585,7 @@ object Cyc_write(object x, FILE *port) fprintf(port, "\n"); return y;} -object Cyc_write_char(object c, object port) +object Cyc_write_char(void *data, object c, object port) { if (obj_is_char(c)) { fprintf(((port_type *)port)->fp, "%c", obj_obj2char(c)); @@ -801,14 +801,14 @@ object Cyc_set_cdr(object l, object val) { return l; } -object Cyc_vector_set(object v, object k, object obj) { +object Cyc_vector_set(void *data, object v, object k, object obj) { 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); + Cyc_rt_raise2(data, "vector-set! - invalid index", k); } ((vector)v)->elts[idx] = obj; @@ -818,32 +818,32 @@ object Cyc_vector_set(object v, object k, object obj) { return v; } -object Cyc_vector_ref(object v, object k) { +object Cyc_vector_ref(void *data, 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"); + Cyc_rt_raise_msg(data, "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"); + Cyc_rt_raise_msg(data, "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); + Cyc_rt_raise2(data, "vector-ref - invalid index", k); } return ((vector)v)->elts[((integer_type *)k)->value]; } -integer_type Cyc_vector_length(object v) { +integer_type Cyc_vector_length(void *data, object v) { if (!nullp(v) && !is_value_type(v) && ((list)v)->tag == vector_tag) { make_int(len, ((vector)v)->num_elt); return len; } - Cyc_rt_raise_msg("vector-length - invalid parameter, expected vector\n"); } + Cyc_rt_raise_msg(data, "vector-length - invalid parameter, expected vector\n"); } -integer_type Cyc_length(object l){ +integer_type Cyc_length(void *data, object l){ make_int(len, 0); while(!nullp(l)){ if (is_value_type(l) || ((list)l)->tag != cons_tag){ - Cyc_rt_raise_msg("length - invalid parameter, expected list\n"); + Cyc_rt_raise_msg(data, "length - invalid parameter, expected list\n"); } l = cdr(l); len.value++; @@ -851,7 +851,7 @@ integer_type Cyc_length(object l){ return len; } -object Cyc_number2string(object cont, object n) { +object Cyc_number2string(void *data, object cont, object n) { char buffer[1024]; Cyc_check_num(n); if (type_of(n) == integer_tag) { @@ -859,18 +859,18 @@ object Cyc_number2string(object cont, object n) { } else if (type_of(n) == double_tag) { snprintf(buffer, 1024, "%lf", ((double_type *)n)->value); } else { - Cyc_rt_raise2("number->string - Unexpected object", n); + Cyc_rt_raise2(data, "number->string - Unexpected object", n); } //make_string_noalloc(str, buffer, strlen(buffer)); make_string(str, buffer); - return_closcall1(cont, &str); + return_closcall1(data, cont, &str); } -object Cyc_symbol2string(object cont, object sym) { +object Cyc_symbol2string(void *data, object cont, object sym) { Cyc_check_sym(sym); { const char *pname = symbol_pname(sym); make_string(str, pname); - return_closcall1(cont, &str); }} + return_closcall1(data, cont, &str); }} object Cyc_string2symbol(object str) { object sym; @@ -882,14 +882,14 @@ object Cyc_string2symbol(object str) { return sym; } -object Cyc_list2string(object cont, object lst){ +object Cyc_list2string(void *data, object cont, object lst){ char *buf; int i = 0; integer_type len; Cyc_check_cons_or_nil(lst); - len = Cyc_length(lst); // Inefficient, walks whole list + len = Cyc_length(data, lst); // Inefficient, walks whole list buf = alloca(sizeof(char) * (len.value + 1)); while(!nullp(lst)){ buf[i++] = obj_obj2char(car(lst)); @@ -899,7 +899,7 @@ object Cyc_list2string(object cont, object lst){ //{ make_string_noalloc(str, buf, i); { make_string(str, buf); - return_closcall1(cont, &str);} + return_closcall1(data, cont, &str);} } common_type Cyc_string2number(object str){ @@ -937,7 +937,7 @@ integer_type Cyc_string_cmp(object str1, object str2) { } } -#define Cyc_string_append_va_list(argc) { \ +#define Cyc_string_append_va_list(data, argc) { \ int i = 0, total_len = 1; \ int *len = alloca(sizeof(int) * argc); \ char *buffer, *bufferp, **str = alloca(sizeof(char *) * argc); \ @@ -963,19 +963,19 @@ integer_type Cyc_string_cmp(object str1, object str2) { *bufferp = '\0'; \ make_string(result, buffer); \ va_end(ap); \ - return_closcall1(cont, &result); \ + return_closcall1(data, cont, &result); \ } -void dispatch_string_91append(int _argc, object clo, object cont, object str1, ...) { +void dispatch_string_91append(void *data, int _argc, object clo, object cont, object str1, ...) { va_list ap; va_start(ap, str1); - Cyc_string_append_va_list(_argc - 1); + Cyc_string_append_va_list(data, _argc - 1); } -object Cyc_string_append(object cont, int _argc, object str1, ...) { +object Cyc_string_append(void *data, object cont, int _argc, object str1, ...) { va_list ap; va_start(ap, str1); - Cyc_string_append_va_list(_argc); + Cyc_string_append_va_list(data, _argc); } integer_type Cyc_string_length(object str) { @@ -984,7 +984,7 @@ integer_type Cyc_string_length(object str) { { make_int(len, strlen(string_str(str))); return len; }} -object Cyc_string_set(object str, object k, object chr) { +object Cyc_string_set(void *data, object str, object k, object chr) { char *raw; int idx, len; @@ -992,7 +992,7 @@ object Cyc_string_set(object str, object k, object chr) { Cyc_check_int(k); if (!eq(boolean_t, Cyc_is_char(chr))) { - Cyc_rt_raise2("Expected char but received", chr); + Cyc_rt_raise2(data, "Expected char but received", chr); } raw = string_str(str); @@ -1004,7 +1004,7 @@ object Cyc_string_set(object str, object k, object chr) { return str; } -object Cyc_string_ref(object str, object k) { +object Cyc_string_ref(void *data, object str, object k) { const char *raw; int idx, len; @@ -1016,13 +1016,13 @@ object Cyc_string_ref(object str, object k) { len = strlen(raw); if (idx < 0 || idx >= len) { - Cyc_rt_raise2("string-ref - invalid index", k); + Cyc_rt_raise2(data, "string-ref - invalid index", k); } return obj_char2obj(raw[idx]); } -object Cyc_substring(object cont, object str, object start, object end) { +object Cyc_substring(void *data, object cont, object str, object start, object end) { const char *raw; int s, e, len; @@ -1036,10 +1036,10 @@ object Cyc_substring(object cont, object str, object start, object end) { len = strlen(raw); if (s > e) { - Cyc_rt_raise2("substring - start cannot be greater than end", start); + Cyc_rt_raise2(data, "substring - start cannot be greater than end", start); } if (s > len) { - Cyc_rt_raise2("substring - start cannot be greater than string length", start); + Cyc_rt_raise2(data, "substring - start cannot be greater than string length", start); } if (e > len) { e = len; @@ -1047,13 +1047,7 @@ object Cyc_substring(object cont, object str, object start, object end) { { make_string_with_len(sub, raw + s, e - s); -//string_type sub; -//{ int len = e - s; -// sub.tag = string_tag; sub.len = len; -// sub.str = alloca(sizeof(char) * (len + 1)); -// memcpy(sub.str, raw + s, len); -// sub.str[len + 1] = '\0';} - return_closcall1(cont, &sub); + return_closcall1(data, cont, &sub); } } @@ -1061,28 +1055,28 @@ object Cyc_substring(object cont, object str, object start, object end) { * Return directory where cyclone is installed. * This is configured via the makefile during a build. */ -object Cyc_installation_dir(object cont, object type) { +object Cyc_installation_dir(void *data, object cont, object type) { if (Cyc_is_symbol(type) == boolean_t && strncmp(((symbol)type)->pname, "sld", 5) == 0) { char buf[1024]; snprintf(buf, sizeof(buf), "%s", CYC_INSTALL_SLD); make_string(str, buf); - return_closcall1(cont, &str); + return_closcall1(data, cont, &str); } else if (Cyc_is_symbol(type) == boolean_t && strncmp(((symbol)type)->pname, "lib", 5) == 0) { char buf[1024]; snprintf(buf, sizeof(buf), "%s", CYC_INSTALL_LIB); make_string(str, buf); - return_closcall1(cont, &str); + return_closcall1(data, cont, &str); } else if (Cyc_is_symbol(type) == boolean_t && strncmp(((symbol)type)->pname, "inc", 5) == 0) { char buf[1024]; snprintf(buf, sizeof(buf), "%s", CYC_INSTALL_INC); make_string(str, buf); - return_closcall1(cont, &str); + return_closcall1(data, cont, &str); } else { make_string(str, CYC_INSTALL_DIR); - return_closcall1(cont, &str); + return_closcall1(data, cont, &str); } } @@ -1095,7 +1089,7 @@ object Cyc_installation_dir(object cont, object type) { * * For now, runtime options are not removed. */ -object Cyc_command_line_arguments(object cont) { +object Cyc_command_line_arguments(void *data, object cont) { int i; object lis = nil; for (i = _cyc_argc; i > 1; i--) { // skip program name @@ -1109,10 +1103,10 @@ object Cyc_command_line_arguments(object cont) { ((list)pl)->cons_cdr = lis; lis = pl; } - return_closcall1(cont, lis); + return_closcall1(data, cont, lis); } -object Cyc_make_vector(object cont, object len, object fill) { +object Cyc_make_vector(void *data, object cont, object len, object fill) { object v = nil; int i; Cyc_check_int(len); @@ -1127,10 +1121,10 @@ object Cyc_make_vector(object cont, object len, object fill) { for (i = 0; i < ((vector)v)->num_elt; i++) { ((vector)v)->elts[i] = fill; } - return_closcall1(cont, v); + return_closcall1(data, cont, v); } -object Cyc_list2vector(object cont, object l) { +object Cyc_list2vector(void *data, object cont, object l) { object v = nil; integer_type len; object lst = l; @@ -1150,7 +1144,7 @@ object Cyc_list2vector(object cont, object l) { ((vector)v)->elts[i++] = car(lst); lst = cdr(lst); } - return_closcall1(cont, v); + return_closcall1(data, cont, v); } integer_type Cyc_system(object cmd) { @@ -1193,6 +1187,8 @@ object __halt(object obj) { return nil; } +JAE TODO: left off here + #define declare_num_op(FUNC, FUNC_OP, FUNC_APPLY, OP, DIV) \ common_type FUNC_OP(object x, object y) { \ common_type s; \ @@ -1823,7 +1819,7 @@ void _Cyc_91read_91line(object cont, object args) { Cyc_io_read_line(cont, car(args));} void _Cyc_91write_91char(object cont, object args) { Cyc_check_num_args("write-char", 2, args); - return_closcall1(cont, Cyc_write_char(car(args), cadr(args)));} + return_closcall1(cont, Cyc_write_char(data, car(args), cadr(args)));} void _Cyc_91write(object cont, object args) { Cyc_check_num_args("write", 1, args); { integer_type argc = Cyc_length(args);