From 67b5e4ee8ec5aef8cdd04cb0377d3e44262c6bb7 Mon Sep 17 00:00:00 2001 From: Justin Ethier Date: Fri, 14 Aug 2020 16:48:59 -0400 Subject: [PATCH] Clean up examples Use code from runtime instead of inline here Added comments as needed, etc --- examples/call-scm-from-c/Makefile | 8 +- examples/call-scm-from-c/basic.c | 102 ++------------------- examples/call-scm-from-c/basic.h | 1 - examples/call-scm-from-c/full-with-gc.scm | 10 ++- examples/call-scm-from-c/full.c | 105 +--------------------- examples/call-scm-from-c/full.h | 1 - 6 files changed, 22 insertions(+), 205 deletions(-) diff --git a/examples/call-scm-from-c/Makefile b/examples/call-scm-from-c/Makefile index 37e0b1eb..dc548e0e 100644 --- a/examples/call-scm-from-c/Makefile +++ b/examples/call-scm-from-c/Makefile @@ -1,16 +1,16 @@ all: basic-no-gc full-with-gc basic.o: basic.c - cc -g -c basic.c + cc -c basic.c basic-no-gc: basic-no-gc.scm basic.o - cyclone -CLNK basic.o basic-no-gc.scm + cyclone -COBJ "basic.o" basic-no-gc.scm full.o: full.c - cc -g -c full.c + cc -c full.c full-with-gc: full-with-gc.scm full.o - cyclone -CLNK full.o full-with-gc.scm + cyclone -COBJ full.o full-with-gc.scm .PHONY: clean clean: diff --git a/examples/call-scm-from-c/basic.c b/examples/call-scm-from-c/basic.c index 95ebc90b..ab21d143 100644 --- a/examples/call-scm-from-c/basic.c +++ b/examples/call-scm-from-c/basic.c @@ -6,6 +6,13 @@ /** * This variable corresponds to the Scheme function in the generated C file * that we wish to call into. + * + * These names are from the compiled C files but can also be + * generated using icyc: + * + * cyclone> (mangle-global 'signal-done) + * "__glo_signal_91done" + * */ extern object __glo_signal_91done; @@ -22,7 +29,7 @@ void *c_thread(void *parent_thd) sleep(1); printf("C calling into SCM\n"); - object obj = scm_call_no_gc(parent_thd, __glo_signal_91done, boolean_t); + object obj = Cyc_scm_call_no_gc(parent_thd, __glo_signal_91done, boolean_t); printf("C received: "); Cyc_write(NULL, obj, stdout); @@ -30,99 +37,6 @@ void *c_thread(void *parent_thd) return NULL; } - -/////////////////////////////////////////////////////////////////////////////// -// -// Should not need to customize below here: -// -/////////////////////////////////////////////////////////////////////////////// - - -/** - * Scheme function calls into this function when it is done. - * We store results and longjmp back to where we started, at the - * bottom of the trampoline (we only jump once). - */ -void after_call_scm(gc_thread_data *thd, int argc, object k, object result) -{ - thd->gc_cont = result; - longjmp(*(thd->jmp_start), 1); -} - -/** - * Call into Scheme function - */ -void call_scm(gc_thread_data *thd, object fnc, object obj) -{ - mclosure0(after, (function_type)after_call_scm); - ((closure)fnc)->fn(thd, 2, fnc, &after, obj); -} - -/** - * Setup a quick-and-dirty thread object and use it to - * make a call into Scheme code. - * - * Note this call is made in a limited way, and is only - * designed for a quick call. There is no support for - * performing any memory allocation by the Scheme code - * other than temporary objects in the nursery. The - * returned object will need to either be an immediate - * or re-allocated (EG: malloc) before returning it - * to the C layer. - */ -object scm_call_no_gc(gc_thread_data *parent_thd, object fnc, object arg) -{ - long stack_size = 100000; - char *stack_base = (char *)&stack_size; - char *stack_traces[MAX_STACK_TRACES]; - gc_thread_data thd = {0}; - jmp_buf jmp; - thd.jmp_start = &jmp; - thd.stack_start = stack_base; -#if STACK_GROWTH_IS_DOWNWARD - thd.stack_limit = stack_base - stack_size; -#else - thd.stack_limit = stack_base + stack_size; -#endif - thd.stack_traces = stack_traces; - - thd.thread_id = pthread_self(); - thd.thread_state = CYC_THREAD_STATE_RUNNABLE; - - // Copy parameter objects from the calling thread - object parent = parent_thd->param_objs; // Unbox parent thread's data - object child = NULL; - while (parent) { - if (thd.param_objs == NULL) { - alloca_pair(p, NULL, NULL); - thd.param_objs = p; - child = thd.param_objs; - } else { - alloca_pair(p, NULL, NULL); - cdr(child) = p; - child = p; - } - alloca_pair(cc, car(car(parent)), cdr(car(parent))); - car(child) = cc; - parent = cdr(parent); - } - - // Setup trampoline and call into Scheme - // - // When the Scheme call is done we return result back to C - // - // It is very important to know that the result, IF ON THE STACK, - // is further up the stack than the caller and will be overwritten - // by subsequent C calls on this thread. Thus the caller will want - // to immediately create a copy of the object... - // - if (!setjmp(*(thd.jmp_start))) { - call_scm(&thd, fnc, arg); - } else { - return(thd.gc_cont); - } -} - /** * Called by Scheme to create the C thread. * This is required by sample app since we start diff --git a/examples/call-scm-from-c/basic.h b/examples/call-scm-from-c/basic.h index 0f47f722..e16ff964 100644 --- a/examples/call-scm-from-c/basic.h +++ b/examples/call-scm-from-c/basic.h @@ -1,4 +1,3 @@ #include "cyclone/types.h" void start_c_thread(gc_thread_data *thd); -object scm_call_no_gc(gc_thread_data *parent_thd, object fnc, object arg); diff --git a/examples/call-scm-from-c/full-with-gc.scm b/examples/call-scm-from-c/full-with-gc.scm index 8c0cab5c..26cbd3ab 100644 --- a/examples/call-scm-from-c/full-with-gc.scm +++ b/examples/call-scm-from-c/full-with-gc.scm @@ -7,9 +7,11 @@ (define lock (make-mutex)) (define *done* #f) -(define *dummy* signal-done) ;; Hack to prevent optimizing out -(define *dummy1* print-result) ;; Hack to prevent optimizing out -(define *dummy2* sum-numbers) ;; Hack to prevent optimizing out +;; Hack to prevent optimizing out functions that are unused in Scheme code +;; This is not required if functions are exported from a library +(define *dummy* signal-done) +(define *dummy1* print-result) +(define *dummy2* sum-numbers) (define-c start-c-thread "(void *data, int argc, closure _, object k)" @@ -31,7 +33,7 @@ (write `(SCM result is ,num)) (newline))) -;; Signal (wait) that it is done, this is called from C +;; Signal (wait) that it is done (define (signal-done obj) (write `(Called from C set *done* to ,obj)) (newline) diff --git a/examples/call-scm-from-c/full.c b/examples/call-scm-from-c/full.c index ea542a04..ec1a99c4 100644 --- a/examples/call-scm-from-c/full.c +++ b/examples/call-scm-from-c/full.c @@ -5,7 +5,7 @@ #include /** - * This variable corresponds to the Scheme function in the generated C file + * These variables correspond to Scheme functions in the generated C file * that we wish to call into. * * These names are from the compiled C files but can also be @@ -19,8 +19,6 @@ extern object __glo_signal_91done; extern object __glo_sum_91numbers; extern object __glo_print_91result; -void *Cyc_init_thread(object thread_and_thunk, int argc, object *args); - /** * Code for the C thread. * @@ -34,21 +32,21 @@ void *c_thread(void *parent_thd) printf("Hello from C thread\n"); printf("C calling into SCM\n"); - fnc = scm_call_with_gc(parent_thd, __glo_sum_91numbers, 0, NULL); + fnc = Cyc_scm_call(parent_thd, __glo_sum_91numbers, 0, NULL); printf("\nC received: "); Cyc_write(NULL, fnc, stdout); printf("\n"); args[0] = fnc; - obj = scm_call_with_gc(parent_thd, __glo_print_91result, 1, args); + obj = Cyc_scm_call(parent_thd, __glo_print_91result, 1, args); printf("\nC received: "); Cyc_write(NULL, obj, stdout); printf("\n"); args[0] = boolean_t; - obj = scm_call_with_gc(parent_thd, __glo_signal_91done, 1, args); + obj = Cyc_scm_call(parent_thd, __glo_signal_91done, 1, args); printf("\nC received: "); Cyc_write(NULL, obj, stdout); @@ -56,101 +54,6 @@ void *c_thread(void *parent_thd) return NULL; } - -/////////////////////////////////////////////////////////////////////////////// -// -// Should not need to customize below here: -// -/////////////////////////////////////////////////////////////////////////////// - -void cleanup_and_return(gc_thread_data *thd, int argc, object k, object result) -{ - // Cleaup thread object per Cyc_exit_thread - gc_remove_mutator(thd); - ck_pr_cas_int((int *)&(thd->thread_state), CYC_THREAD_STATE_RUNNABLE, - CYC_THREAD_STATE_TERMINATED); - - // Return to local C caller - vector vec = thd->scm_thread_obj; - gc_thread_data *local = opaque_ptr(vec->elements[4]); - local->gc_cont = result; - longjmp(*(local->jmp_start), 1); -} - -/** - * Scheme function calls into this function when it is done. - * We store results and longjmp back to where we started, at the - * bottom of the trampoline (we only jump once). - */ -void after_call_scm(gc_thread_data *thd, int argc, object k, object result) -{ - mclosure0(clo, cleanup_and_return); - object buf[1]; buf[0] = result; - GC(thd, &clo, buf, 1); -} - -/** - * Call into Scheme function - */ -//void call_scm(gc_thread_data *thd, object fnc, object obj) -//{ -// mclosure0(after, (function_type)after_call_scm); -// ((closure)fnc)->fn(thd, 2, fnc, &after, obj); -//} -// -//void call_thunk(void *data, int argc, object self, object k) -//{ -// -//} - -/** - * Setup a quick-and-dirty thread object and use it to - * make a call into Scheme code. - * - * Note this call is made in a limited way, and is only - * designed for a quick call. There is no support for - * performing any memory allocation by the Scheme code - * other than temporary objects in the nursery. The - * returned object will need to either be an immediate - * or re-allocated (EG: malloc) before returning it - * to the C layer. - */ -object scm_call_with_gc(gc_thread_data *parent_thd, object fnc, int argc, object *args) -{ - jmp_buf l; - gc_thread_data local; - local.gc_cont = NULL; - local.jmp_start = &l; - - gc_thread_data *td = malloc(sizeof(gc_thread_data)); - gc_add_new_unrunning_mutator(td); /* Register this thread */ - make_c_opaque(co, td); - make_utf8_string(NULL, name_str, ""); - - make_c_opaque(co_parent_thd, parent_thd); - make_c_opaque(co_this_thd, &local); - mclosure0(after, (function_type)after_call_scm); - - make_empty_vector(vec); - vec.num_elements = 7; - vec.elements = alloca(sizeof(object) * 5); - vec.elements[0] = find_or_add_symbol("cyc-thread-obj"); - vec.elements[1] = fnc; - vec.elements[2] = &co; - vec.elements[3] = &name_str; - vec.elements[4] = &co_this_thd; //boolean_f; - vec.elements[5] = &co_parent_thd; - vec.elements[6] = &after; - - make_pair(thread_and_thunk, &vec, fnc); // TODO: OK we are not clearing vec[5]? I think so... - - if (!setjmp(*(local.jmp_start))) { - Cyc_init_thread(&thread_and_thunk, argc, args); - } - - return local.gc_cont; -} - /** * Called by Scheme to create the C thread. * This is required by sample app since we start diff --git a/examples/call-scm-from-c/full.h b/examples/call-scm-from-c/full.h index b0656e20..e16ff964 100644 --- a/examples/call-scm-from-c/full.h +++ b/examples/call-scm-from-c/full.h @@ -1,4 +1,3 @@ #include "cyclone/types.h" void start_c_thread(gc_thread_data *thd); -object scm_call_with_gc(gc_thread_data *parent_thd, object fnc, int argc, object *args);